curly quantifier

brag/codegen/codegen.rkt

@@ -301,7 +301,7 @@
                   [explicit explicit])
                  ([v (in-list (syntax->list #'(vals ...)))])
          (loop v implicit explicit))]
-      [(repeat min val)
+      [(repeat min max val)
        (loop #'val implicit explicit)]
       [(maybe val)
        (loop #'val implicit explicit)]
@@ -379,7 +379,7 @@
        (for/fold ([acc acc])
                  ([v (in-list (syntax->list #'(vals ...)))])
          (loop v acc))]
-      [(repeat min val)
+      [(repeat min max val)
        (loop #'val acc)]
       [(maybe val)
        (loop #'val acc)]
@@ -425,7 +425,7 @@
            (define a-child (process-pattern v))
            (sat:add-child! an-or-node a-child))
          an-or-node)]
-      [(repeat min val)
+      [(repeat min max val)
        (syntax-case #'min ()
          [0
           (make-leaf)]

brag/codegen/flatten.rkt

@@ -2,7 +2,6 @@
 (require brag/rules/stx-types
          racket/list
          (for-syntax racket/base))
-(require (except-in sugar/debug repeat))
 (provide flatten-rule
          flatten-rules
          prim-rule)
@@ -69,78 +68,73 @@
       (values (apply append (reverse rules))
               (apply append (reverse patterns))))
           
-    (with-syntax ([head (if inferred? #'inferred-prim-rule #'prim-rule)]
-                  [origin (syntax-case a-rule (rule) [(rule name (pat-head rest ...)) #'pat-head])])
+    (with-syntax ([HEAD (if inferred? #'inferred-prim-rule #'prim-rule)]
+                  [ORIGIN (syntax-case a-rule (rule) [(rule name (pat-head rest ...)) #'pat-head])])
       (syntax-case a-rule (rule)
-        [(rule name pat)
-         (syntax-case #'pat (id inferred-id lit token choice repeat maybe seq)
+        [(rule NAME PAT)
+         (syntax-case #'PAT (id inferred-id lit token choice repeat maybe seq)
 
            ;; The primitive types stay as they are:
            [(id val)
-            (list #'(head origin name [pat]))]
+            (list #'(HEAD ORIGIN NAME [PAT]))]
            [(inferred-id val reason)
-            (list #'(head origin name [pat]))]
+            (list #'(HEAD ORIGIN NAME [PAT]))]
            [(lit val)
-            (list #'(head origin name [pat]))]
+            (list #'(HEAD ORIGIN NAME [PAT]))]
            [(token val)
-            (list #'(head origin name [pat]))]
+            (list #'(HEAD ORIGIN NAME [PAT]))]
 
            
            ;; Everything else might need lifting:
-           [(choice sub-pat ...)
+           [(choice SUB-PAT ...)
             (begin
               (define-values (inferred-ruless/rev new-sub-patss/rev)
                 (for/fold ([rs '()] [ps '()])
-                          ([p (syntax->list #'(sub-pat ...))])
+                          ([p (syntax->list #'(SUB-PAT ...))])
                   (let-values ([(new-r new-p)
                                 (lift-nonprimitive-pattern p)])
                     (values (cons new-r rs) (cons new-p ps)))))
-              (with-syntax ([((sub-pat ...) ...) (reverse new-sub-patss/rev)])
-                (append (list #'(head origin name [sub-pat ...] ...))
+              (with-syntax ([((SUB-PAT ...) ...) (reverse new-sub-patss/rev)])
+                (append (list #'(HEAD ORIGIN NAME [SUB-PAT ...] ...))
                         (apply append (reverse inferred-ruless/rev)))))]
 
-           [(repeat min sub-pat)
+           [(repeat MIN #f SUB-PAT)
+            ;; indefinite repeat
             (begin
               (define-values (inferred-rules new-sub-pats)
-                (lift-nonprimitive-pattern #'sub-pat))
-              (report/file (syntax-e #'min))
-              (with-syntax ([(sub-pat ...) new-sub-pats]
-                            [MIN-REPEAT-SUB-PATS (apply append (make-list (syntax-e #'min) new-sub-pats))])
-                (cons (cond [(= (syntax-e #'min) 0)
-                               #`(head origin name
-                                       [(inferred-id name repeat) sub-pat ...]
-                                       [])]
-                              [(= (syntax-e #'min) 1)
-                               #`(head origin name
-                                       [(inferred-id name repeat) sub-pat ...]
-                                       [sub-pat ...])]
-                              [(= (syntax-e #'min) 2)
-                               #`(head origin name
-                                       [(inferred-id name repeat) sub-pat ...]
-                                       [sub-pat ... sub-pat ...])])
-                        inferred-rules)
-                #;(cons (report/file #`(head origin name
-                              [(inferred-id name repeat) sub-pat ...]
-                              MIN-REPEAT-SUB-PATS))
+                (lift-nonprimitive-pattern #'SUB-PAT))
+              (with-syntax ([(SUB-PAT ...) new-sub-pats]
+                            [MIN-REPEAT-SUB-PATS (apply append (make-list (syntax-e #'MIN) new-sub-pats))])
+                (cons #`(HEAD ORIGIN NAME
+                              [(inferred-id NAME repeat) SUB-PAT ...]
+                              MIN-REPEAT-SUB-PATS)
                       inferred-rules)))]
-
-           [(maybe sub-pat)
+           [(repeat MIN MAX SUB-PAT)
+            ;; finite repeat
+            (let ([min (syntax-e #'MIN)]
+                  [max (syntax-e #'MAX)])
+              (recur
+                  (with-syntax ([(MIN-SUBPAT ...) (make-list min #'SUB-PAT)]
+                                [(EXTRA-SUBPAT ...) (make-list (- max min) #'SUB-PAT)])
+                    #'(rule NAME (seq MIN-SUBPAT ... (maybe EXTRA-SUBPAT) ...)))
+                #f))]
+
+           [(maybe SUB-PAT)
             (begin
               (define-values (inferred-rules new-sub-pats)
-                (lift-nonprimitive-pattern #'sub-pat))
-              (report*/file #'pat #'sub-pat)
-              (with-syntax ([(sub-pat ...) new-sub-pats])
-                (cons #'(head origin name
-                              [sub-pat ...]
+                (lift-nonprimitive-pattern #'SUB-PAT))
+              (with-syntax ([(SUB-PAT ...) new-sub-pats])
+                (cons #'(HEAD ORIGIN NAME
+                              [SUB-PAT ...]
                               [])
                       inferred-rules)))]
 
-           [(seq sub-pat ...)
+           [(seq SUB-PAT ...)
             (begin
               (define-values (inferred-rules new-sub-pats)
-                (lift-nonprimitive-patterns (syntax->list #'(sub-pat ...))))
-              (with-syntax ([(sub-pat ...) new-sub-pats])
-                (cons #'(head origin name [sub-pat ...])
+                (lift-nonprimitive-patterns (syntax->list #'(SUB-PAT ...))))
+              (with-syntax ([(SUB-PAT ...) new-sub-pats])
+                (cons #'(HEAD ORIGIN NAME [SUB-PAT ...])
                       inferred-rules)))])]))))
 
 
@@ -174,7 +168,7 @@
      #t]
     [(choice sub-pat ...)
      #f]
-    [(repeat min val)
+    [(repeat min max val)
      #f]
     [(maybe sub-pat)
      #f]

brag/rules/parser.rkt

@@ -4,7 +4,6 @@
          racket/list
          racket/match
          "rule-structs.rkt")
-(require sugar/debug)
 
 ;; A parser for grammars.
 
@@ -158,21 +157,20 @@
       (cond [(string=? $2 "*")
              (pattern-repeat (position->pos $1-start-pos)
                              (position->pos $2-end-pos)
-                             0 $1)]
+                             0 #f $1)]
             [(string=? $2 "+")
              (pattern-repeat (position->pos $1-start-pos)
                              (position->pos $2-end-pos)
-                             1 $1)]
+                             1 #f $1)]
             [(regexp-match #px"^\\{(\\d+)?,?(\\d+)?\\}$" $2) ; "{min,max}" with both min & max optional
              => (λ (m)
                   (match-define (cons min-repeat max-repeat)
                     (match m
                       [(list _ min max) (cons (if min (string->number min) 0)
                                               (and max (string->number max)))]))
-                  (report/file min-repeat)
                   (pattern-repeat (position->pos $1-start-pos)
                                   (position->pos $2-end-pos)
-                                  min-repeat $1))]
+                                  min-repeat max-repeat $1))]
             [else
              (error 'grammar-parse "unknown repetition operator ~e" $2)])]
      [(atomic-pattern)
@@ -233,8 +231,8 @@
      (pattern-lit start-pos end-pos v (or hide? h))]
     [(pattern-choice _ _ vs)
      (pattern-choice start-pos end-pos vs)]
-    [(pattern-repeat _ _ m v)
-     (pattern-repeat start-pos end-pos m v)]
+    [(pattern-repeat _ _ min max v)
+     (pattern-repeat start-pos end-pos min max v)]
     [(pattern-maybe _ _ v)
      (pattern-maybe start-pos end-pos v)]
     [(pattern-seq _ _ vs)

brag/rules/rule-structs.rkt

@@ -31,7 +31,8 @@
 (struct pattern-choice pattern (vals)
         #:transparent)
 
-(struct pattern-repeat pattern (min ;; either 0 or 1
+(struct pattern-repeat pattern (min
+                                max
                                 val)
         #:transparent)
 

brag/rules/stx.rkt

@@ -80,8 +80,8 @@
       'hide hide)]
     [(struct pattern-choice (start end vals))
      (datum->syntax #f`(choice ,@(map recur vals)) source-location)]
-    [(struct pattern-repeat (start end min val))
-     (datum->syntax #f`(repeat ,min ,(recur val)) source-location)]
+    [(struct pattern-repeat (start end min max val))
+     (datum->syntax #f`(repeat ,min ,max ,(recur val)) source-location)]
     [(struct pattern-maybe (start end val))
      (datum->syntax #f`(maybe ,(recur val)) source-location)]
     [(struct pattern-seq (start end vals))