<commit_before>(module simplify-patterns mzscheme
  
  (require syntax/stx)
  
  (require scheme/list)
  
  (require "match-error.ss"
           "match-helper.ss"
           "test-structure.scm"
           "coupling-and-binding.scm"
           "update-counts.scm"
           "update-binding-counts.scm"
           "reorder-tests.scm"
           "match-expander-struct.ss"
           "render-helpers.ss"
           "observe-step.ss")
  
  (require "render-sigs.ss")
  
  (require-for-syntax "match-helper.ss"
                      "match-expander-struct.ss"
                      "test-no-order.ss")
  
  (require-for-template mzscheme
			"match-error.ss"
			"test-no-order.ss"
                        "match-helper.ss")
  


  (provide simplify match-...-nesting)
  
  (define match-...-nesting (make-parameter 0))
  
  
  ;; simplifies patterns by removing syntactic sugar and expanding match-expanders
  ;; simplify : syntax certifier-> syntax
  (define (simplify stx cert)    

    
    ;; convert and check sub patterns for hash-table patterns
    (define (convert-hash-table-pat pat)
      (syntax-case pat ()
        [(p1 p2) #`(#,(simplify/i #'p1) #,(simplify/i #'p2))]
        [i (and (identifier? #'i) (not (stx-dot-dot-k? #'i))) #'(var i)]
        [_ (match:syntax-err pat "hash table subpattern must contain either two patterns or an identifier")]))

    ;; simple one-arg version, just passes the cert along
    (define (simplify/i stx) (simplify stx cert))
    
    (syntax-case*
        stx
      (_ list quote quasiquote vector box ? app and or not struct set! var
         list-rest get! ... ___ unquote unquote-splicing cons
         list-no-order hash-table regexp pregexp cons) stx-equal?

      ;; expand match-expanders
      ;; this doesn't work because we need to keep the certifier around
      [(expander args ...)
       (and (identifier? #'expander) 
            (match-expander? (syntax-local-value (cert #'expander) (lambda () #f))))
       (let* ([expander (syntax-local-value (cert #'expander))]
              [transformer (match-expander-plt-match-xform expander)])
         (unless transformer
           (match:syntax-err #'expander
                             "This expander only works with the match.ss library."))
         (let* ([introducer (make-syntax-introducer)]
                [certifier (match-expander-certifier expander)]
                [mstx (introducer stx)]
                [mresult (transformer mstx)]
                [result (introducer mresult)]
                [cert* (lambda (id) (certifier (cert id) #f introducer))])
           (observe-step stx mstx mresult result)
           (simplify result cert*)))]
      
      ;; label variable patterns
      [id
       (and (pattern-var? #'id) (not (stx-dot-dot-k? #'id)))<commit_msg>workaround limitation in syntax system related to nested marks<commit_after>(module simplify-patterns mzscheme
  
  (require syntax/stx)
  
  (require scheme/list)
  
  (require "match-error.ss"
           "match-helper.ss"
           "test-structure.scm"
           "coupling-and-binding.scm"
           "update-counts.scm"
           "update-binding-counts.scm"
           "reorder-tests.scm"
           "match-expander-struct.ss"
           "render-helpers.ss"
           "observe-step.ss")
  
  (require "render-sigs.ss")
  
  (require-for-syntax "match-helper.ss"
                      "match-expander-struct.ss"
                      "test-no-order.ss")
  
  (require-for-template mzscheme
			"match-error.ss"
			"test-no-order.ss"
                        "match-helper.ss")
  


  (provide simplify match-...-nesting)
  
  (define match-...-nesting (make-parameter 0))
  
  
  ;; simplifies patterns by removing syntactic sugar and expanding match-expanders
  ;; simplify : syntax certifier-> syntax
  (define (simplify stx cert)    

    
    ;; convert and check sub patterns for hash-table patterns
    (define (convert-hash-table-pat pat)
      (syntax-case pat ()
        [(p1 p2) #`(#,(simplify/i #'p1) #,(simplify/i #'p2))]
        [i (and (identifier? #'i) (not (stx-dot-dot-k? #'i))) #'(var i)]
        [_ (match:syntax-err pat "hash table subpattern must contain either two patterns or an identifier")]))

    ;; simple one-arg version, just passes the cert along
    (define (simplify/i stx) (simplify stx cert))
    
    (syntax-case*
        stx
      (_ list quote quasiquote vector box ? app and or not struct set! var
         list-rest get! ... ___ unquote unquote-splicing cons
         list-no-order hash-table regexp pregexp cons) stx-equal?

      ;; expand match-expanders
      ;; this doesn't work because we need to keep the certifier around
      [(expander args ...)
       (and (identifier? #'expander) 
            (match-expander? (syntax-local-value (cert #'expander) (lambda () #f))))
       (let* ([expander (syntax-local-value (cert #'expander))]
              [transformer (match-expander-plt-match-xform expander)])
         (unless transformer
           (match:syntax-err #'expander
                             "This expander only works with the match.ss library."))
         (let* ([introducer (make-syntax-introducer)]
                [certifier (match-expander-certifier expander)]
                [mstx (introducer (syntax-local-introduce stx))]
                [mresult (transformer mstx)]
                [result (syntax-local-introduce (introducer mresult))]
                [cert* (lambda (id) (certifier (cert id) #f introducer))])
           (observe-step stx mstx mresult result)
           (simplify result cert*)))]
      
      ;; label variable patterns
      [id
       (and (pattern-var? #'id) (not (stx-dot-dot-k? #'id)))
{'fraction_non_alphanumeric': 0.12907776406277552, 'fraction_numerical': 0.0017633574325515782, 'mean_word_length': 2.084284937466014, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3826834', 'n_tokens_mistral': 1866, 'n_tokens_neox': 1737, 'n_words': 445}