adjust flattening of zero-or-more rule (fixes #18)

brag/codegen/flatten.rkt

@@ -6,38 +6,33 @@
          flatten-rules
          prim-rule)
 
-
-
 (define (make-fresh-name)
   (let ([n 0])
-    (lambda ()
+    (λ ()
       (set! n (add1 n))
       (string->symbol (format "%rule~a" n)))))
 
-(define default-fresh-name
+(define default-fresh-name (make-fresh-name))
-  (make-fresh-name))
 
 
 ;; Translates rules to lists of primitive rules.
 
 
 (define (flatten-rules rules #:fresh-name [fresh-name default-fresh-name])
-  (define ht (make-hash))
+  (define ht (make-hasheq))
-  (apply append (map (lambda (a-rule) (flatten-rule a-rule
+  (apply append (for/list ([a-rule (in-list rules)])
+                  (flatten-rule a-rule
                                 #:ht ht
-                                                    #:fresh-name fresh-name))
+                                #:fresh-name fresh-name))))
-                     rules)))
 
 
 ;; flatten-rule: rule -> (listof primitive-rule)
 (define (flatten-rule a-rule
                       #:fresh-name [fresh-name default-fresh-name]
-
                       ;; ht: (hashtableof pattern-hash-key pat)
-                      #:ht [ht (make-hash)])
+                      #:ht [ht (make-hasheq)])
 
-  (let recur ([a-rule a-rule]
+  (let recur ([a-rule a-rule] [inferred? #f])
-              [inferred? #f])
 
     ;; lift-nonprimitive-pattern: pattern -> (values (listof primitive-rule) pattern)
     ;; Turns non-primitive patterns into primitive patterns, and produces a set of
@@ -98,6 +93,14 @@
                 (append (list #'(HEAD ORIGIN NAME [SUB-PAT ...] ...))
                         (apply append (reverse inferred-ruless/rev)))))]
 
+           [(repeat 0 0 SUB-PAT)
+            ;; repeat from 0 to 0 (is a no-op)
+            (recur #'(rule NAME (seq)) #f)]
+
+           [(repeat 0 MAYBE-MAX SUB-PAT)
+            ;; repeat from 0 (as a maybe rule)
+            (recur #'(rule NAME (maybe (repeat 1 MAYBE-MAX SUB-PAT))) #f)]
+
            [(repeat MIN #f SUB-PAT)
             ;; indefinite repeat
             (begin
@@ -115,10 +118,15 @@
             (begin
               (define min (syntax-e #'MIN))
               (define max (syntax-e #'MAX))
-              (define new-rule-stx (with-syntax ([(MIN-SUBPAT ...) (make-list min #'SUB-PAT)]
+              (unless (<= min max)
-                                                 [(EXTRA-SUBPAT ...) (make-list (- max min) #'SUB-PAT)])
+                (raise-syntax-error #f (format "minimum repeat count cannot be larger than maximum, got {~a,~a}" min max) a-rule))
-                                     ;; has to keep the same name to work correctly
+              ;; has to keep the same rule NAME to work correctly
-                                     #'(rule NAME (seq MIN-SUBPAT ... (maybe EXTRA-SUBPAT) ...))))
+              (define new-rule-stx
+                (if (= min max)
+                    (with-syntax ([MIN-SUBPATS (make-list min #'SUB-PAT)])
+                                  #'(rule NAME (seq . MIN-SUBPATS)))
+                    (with-syntax ([REPEATS-REMAINING (- max min)]) ; REPEATS-REMAINING is a positive integer
+                      #'(rule NAME (seq (repeat MIN MIN SUB-PAT) (repeat 0 REPEATS-REMAINING SUB-PAT))))))
               (recur new-rule-stx #f))]
 
            [(maybe SUB-PAT)

brag/examples/nested-repeats.rkt

@@ -0,0 +1,3 @@
+#lang brag
+
+start : ( (X | X Y) A* )*

brag/test/test-all.rkt

@@ -12,6 +12,7 @@
          "test-flatten.rkt"
          "test-hide-and-splice.rkt"
          "test-lexer.rkt"
+         "test-nested-repeats.rkt"
          "test-old-token.rkt"
          "test-parser.rkt"
          "test-quotation-marks-and-backslashes.rkt"

brag/test/test-flatten.rkt

@@ -96,14 +96,16 @@
 ;; repeat
 (check-equal? (map syntax->datum
                    (flatten-rule #'(rule rule-2+ (repeat 0 #f (id rule-2)))))
-              '((prim-rule repeat rule-2+
+              '((prim-rule maybe rule-2+ ((inferred-id %rule1 repeat)) ())
-                           [(inferred-id rule-2+ repeat) (id rule-2)]
+                (inferred-prim-rule repeat %rule1
-                           [])))
+                                    ((inferred-id %rule1 repeat) (id rule-2))
+                                    ((id rule-2)))))
 (check-equal? (map syntax->datum
                    (flatten-rule #'(rule rule-2+ (repeat 0 #f (seq (lit "+") (id rule-2))))))
-              '((prim-rule repeat rule-2+
+              '((prim-rule maybe rule-2+ ((inferred-id %rule2 repeat)) ())
-                           [(inferred-id rule-2+ repeat) (lit "+") (id rule-2)]
+                (inferred-prim-rule repeat %rule2
-                           [])))
+                                    ((inferred-id %rule2 repeat) (lit "+") (id rule-2))
+                                    ((lit "+") (id rule-2)))))
 
 (check-equal? (map syntax->datum
                    (flatten-rule #'(rule rule-2+ (repeat 1 #f (id rule-2)))))
@@ -174,8 +176,11 @@
 (check-equal? (map syntax->datum
                    (flatten-rule #'(rule expr (seq (id term) (repeat 0 #f (seq (lit "+") (id term)))))
                                  #:fresh-name (make-fresh-name)))
-              '((prim-rule seq expr [(id term) (inferred-id r1 repeat)])
+              '((prim-rule seq expr ((id term) (inferred-id r1 repeat)))
-                (inferred-prim-rule repeat r1 [(inferred-id r1 repeat) (lit "+") (id term)] [])))
+                (prim-rule maybe r1 ((inferred-id r2 repeat)) ())
+                (inferred-prim-rule repeat r2
+                                    ((inferred-id r2 repeat) (lit "+") (id term))
+                                    ((lit "+") (id term)))))
 
 
 ;; larger example: simple arithmetic
@@ -186,8 +191,14 @@
                                       (rule factor (token INT))))
                                   #:fresh-name (make-fresh-name)))
               
-              '((prim-rule seq expr [(id term) (inferred-id r1 repeat)])
+              '((prim-rule seq expr ((id term) (inferred-id r1 repeat)))
-                (inferred-prim-rule repeat r1 [(inferred-id r1 repeat) (lit "+") (id term)] [])
+                (prim-rule maybe r1 ((inferred-id r2 repeat)) ())
-                (prim-rule seq term [(id factor) (inferred-id r2 repeat)])
+                (inferred-prim-rule repeat r2
-                (inferred-prim-rule repeat r2 [(inferred-id r2 repeat) (lit "*") (id factor)] [])
+                 ((inferred-id r2 repeat) (lit "+") (id term))
-                (prim-rule token factor [(token INT)])))
+                 ((lit "+") (id term)))
+                (prim-rule seq term ((id factor) (inferred-id r3 repeat)))
+                (prim-rule maybe r3 ((inferred-id r4 repeat)) ())
+                (inferred-prim-rule repeat r4
+                 ((inferred-id r4 repeat) (lit "*") (id factor))
+                 ((lit "*") (id factor)))
+                (prim-rule token factor ((token INT)))))

brag/test/test-nested-repeats.rkt

@@ -0,0 +1,9 @@
+#lang racket/base
+(require brag/examples/nested-repeats
+         rackunit)
+
+(check-equal?
+ (syntax->datum (parse (list "X" "Y" "X")))
+ '(start "X" "Y" "X"))
+
+