angle brackets behave ; tests pass

beautiful-racket-ragg/br/ragg/codegen/codegen.rkt

@@ -260,7 +260,7 @@
   (let loop ([a-pattern a-pattern]
              [implicit implicit]
              [explicit explicit])
-    (syntax-case a-pattern (id lit token choice repeat maybe elide seq)
+    (syntax-case a-pattern (id lit token choice elide repeat maybe seq)
       [(id val)
        (values implicit explicit)]
       [(lit val)
@@ -275,12 +275,15 @@
                   [explicit explicit])
                  ([v (in-list (syntax->list #'(vals ...)))])
          (loop v implicit explicit))]
+      [(elide vals ...)
+       (for/fold ([implicit implicit]
+                  [explicit explicit])
+                 ([v (in-list (syntax->list #'(vals ...)))])
+         (loop v implicit explicit))]
       [(repeat min val)
        (loop #'val implicit explicit)]
       [(maybe val)
        (loop #'val implicit explicit)]
-      [(elide val)
-       (loop #'val implicit explicit)]
       [(seq vals ...)
        (for/fold ([implicit implicit]
                   [explicit explicit])
@@ -344,7 +347,7 @@
 (define (pattern-collect-used-ids a-pattern acc)
   (let loop ([a-pattern a-pattern]
              [acc acc])
-    (syntax-case a-pattern (id lit token choice repeat maybe elide seq)
+    (syntax-case a-pattern (id lit token choice elide repeat maybe seq)
       [(id val)
        (cons #'val acc)]
       [(lit val)
@@ -355,12 +358,14 @@
        (for/fold ([acc acc])
                  ([v (in-list (syntax->list #'(vals ...)))])
          (loop v acc))]
+      [(elide vals ...)
+       (for/fold ([acc acc])
+                 ([v (in-list (syntax->list #'(vals ...)))])
+         (loop v acc))]
       [(repeat min val)
        (loop #'val acc)]
       [(maybe val)
        (loop #'val acc)]
-      [(elide val)
-       (loop #'val acc)]
       [(seq vals ...)
        (for/fold ([acc acc])
                  ([v (in-list (syntax->list #'(vals ...)))])
@@ -389,7 +394,7 @@
     a-leaf)
   
   (define (process-pattern a-pattern)
-    (syntax-case a-pattern (id lit token choice repeat maybe elide seq)
+    (syntax-case a-pattern (id lit token choice elide repeat maybe  seq)
       [(id val)
        (free-id-table-ref toplevel-rule-table #'val)]
       [(lit val)
@@ -403,6 +408,13 @@
               (define a-child (process-pattern v))
               (sat:add-child! an-or-node a-child))
          an-or-node)]
+      [(elide vals ...)
+       (begin
+         (define an-or-node (sat:make-or))
+         (for ([v (in-list (syntax->list #'(vals ...)))])
+              (define a-child (process-pattern v))
+              (sat:add-child! an-or-node a-child))
+         an-or-node)]
       [(repeat min val)
        (syntax-case #'min ()
          [0
@@ -411,8 +423,6 @@
           (process-pattern #'val)])]
       [(maybe val)
        (make-leaf)]
-      [(elide val)
-       (make-leaf)]
       [(seq vals ...)
        (begin
          (define an-and-node (sat:make-and))

beautiful-racket-ragg/br/ragg/codegen/flatten.rkt

@@ -72,7 +72,7 @@
                   [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 elide seq)
+         (syntax-case #'pat (id inferred-id lit token choice elide repeat maybe seq)
 
            ;; The primitive types stay as they are:
            [(id val)
@@ -98,6 +98,18 @@
                 (append (list #'(head origin name [sub-pat ...] ...))
                         (apply append (reverse inferred-ruless/rev)))))]
 
+           [(elide sub-pat ...)
+            (begin
+              (define-values (inferred-ruless/rev new-sub-patss/rev)
+                (for/fold ([rs '()] [ps '()])
+                          ([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 ...] ...))
+                        (apply append (reverse inferred-ruless/rev)))))]
+
            [(repeat min sub-pat)
             (begin
               (define-values (inferred-rules new-sub-pats)
@@ -123,16 +135,6 @@
                               [])
                       inferred-rules)))]
 
-           [(elide sub-pat)
-            (begin
-              (define-values (inferred-rules new-sub-pats)
-                (lift-nonprimitive-pattern #'sub-pat))
-              (with-syntax ([(sub-pat ...) new-sub-pats])
-                (cons #'(head origin name
-                              [sub-pat ...]
-                              [])
-                      inferred-rules)))]
-
            [(seq sub-pat ...)
             (begin
               (define-values (inferred-rules new-sub-pats)
@@ -149,7 +151,7 @@
 
 ;; Returns true if the pattern looks primitive
 (define (primitive-pattern? a-pat)
-  (syntax-case a-pat (id lit token choice repeat maybe elide seq)
+  (syntax-case a-pat (id lit token choice elide repeat maybe seq)
     [(id val)
      #t]
     [(lit val)
@@ -158,12 +160,12 @@
      #t]
     [(choice sub-pat ...)
      #f]
+    [(elide sub-pat)
+     #f]
     [(repeat min val)
      #f]
     [(maybe sub-pat)
      #f]
-    [(elide sub-pat)
-     #f]
     [(seq sub-pat ...)
      (andmap primitive-pattern? (syntax->list #'(sub-pat ...)))]))
 

beautiful-racket-ragg/br/ragg/elider/json-elider.rkt

@@ -1,10 +1,9 @@
 #lang br/ragg
 
 ;; Simple baby example of JSON structure
-json: number | string
+json: <number | string
     | array
-    | object
-
+    | object>
 number: NUMBER
 
 string: STRING
@@ -13,4 +12,4 @@ array: "[" [json ("," json)*] "]"
 
 object: "{" [kvpair ("," kvpair)*] "}"
 
-kvpair: ID <":"> json
+kvpair: ID ":" json

beautiful-racket-ragg/br/ragg/elider/test-json-elider.rkt

@@ -11,7 +11,7 @@
                (token 'STRING "'hello world'")
                "}")))
  '(json (object "{"
-                (kvpair "message" (json (string "'hello world'")))
+                (kvpair "message" ":" (json (string "'hello world'")))
                 "}")))
 
 

beautiful-racket-ragg/br/ragg/rules/lexer.rkt

@@ -14,7 +14,7 @@
 (define-lex-abbrevs
    [letter (:or (:/ "a" "z") (:/ #\A #\Z))]
    [digit (:/ #\0 #\9)]
-   [id-char (:or letter digit (char-set "-.!$%&/<=>?^_~@"))]
+   [id-char (:or letter digit (char-set "-.!$%&/=?^_~@"))]
  )
 
 (define-lex-abbrev id

beautiful-racket-ragg/br/ragg/rules/parser.rkt

@@ -10,10 +10,10 @@
 (provide tokens
          token-LPAREN
          token-RPAREN
-         token-LBRACKET
-         token-RBRACKET
          token-LANGLE ; for elider
          token-RANGLE ; for elider
+         token-LBRACKET
+         token-RBRACKET
          token-PIPE
          token-REPEAT
          token-RULE_HEAD
@@ -32,9 +32,9 @@
          [struct-out pattern-lit]
          [struct-out pattern-token]
          [struct-out pattern-choice]
+         [struct-out pattern-elide]
          [struct-out pattern-repeat]
          [struct-out pattern-maybe]
-         [struct-out pattern-elide]
          [struct-out pattern-seq])
 
 (define-tokens tokens (LPAREN
@@ -49,7 +49,7 @@
                        ID
                        LIT
                        EOF))
-
+(require sugar/debug)
 ;; grammar-parser: (-> token) -> (listof rule)
 (define grammar-parser
   (parser
@@ -145,12 +145,10 @@
                      (position->pos $3-end-pos)
                      $2)]
      
-     [(LANGLE pattern RANGLE)
-      (pattern-elide (position->pos $1-start-pos)
-                     (position->pos $3-end-pos)
-                     $2)]
-     
      [(LPAREN pattern RPAREN)
+      (relocate-pattern $2 (position->pos $1-start-pos) (position->pos $3-end-pos))]
+     
+     [(LANGLE pattern RANGLE)
       (relocate-pattern $2 (position->pos $1-start-pos) (position->pos $3-end-pos))]])
    
    
@@ -170,12 +168,12 @@
      (pattern-lit start-pos end-pos v)]
     [(pattern-choice _ _ vs)
      (pattern-choice start-pos end-pos vs)]
+    [(pattern-elide _ _ vs)
+     (pattern-elide start-pos end-pos vs)]
     [(pattern-repeat _ _ m v)
      (pattern-repeat start-pos end-pos m v)]
     [(pattern-maybe _ _ v)
      (pattern-maybe start-pos end-pos v)]
-    [(pattern-elide _ _ v)
-     (pattern-elide start-pos end-pos v)]
     [(pattern-seq _ _ vs)
      (pattern-seq start-pos end-pos vs)]
     [else

beautiful-racket-ragg/br/ragg/rules/rule-structs.rkt

@@ -35,6 +35,9 @@
 (struct pattern-choice pattern (vals)
         #:transparent)
 
+(struct pattern-elide pattern (val)
+        #:transparent)
+
 (struct pattern-repeat pattern (min ;; either 0 or 1
                                 val)
         #:transparent)
@@ -42,9 +45,6 @@
 (struct pattern-maybe pattern (val)
         #:transparent)
 
-(struct pattern-elide pattern (val)
-        #:transparent)
-
 (struct pattern-seq pattern (vals)
         #:transparent)
 

beautiful-racket-ragg/br/ragg/rules/stx-types.rkt

@@ -11,7 +11,7 @@
 (define (lit stx) (raise-syntax-error #f "Used out of context of rules" stx))
 (define (token stx) (raise-syntax-error #f "Used out of context of rules" stx))
 (define (choice stx) (raise-syntax-error #f "Used out of context of rules" stx))
+(define (elide stx) (raise-syntax-error #f "Used out of context of rules" stx))
 (define (repeat stx) (raise-syntax-error #f "Used out of context of rules" stx))
 (define (maybe stx) (raise-syntax-error #f "Used out of context of rules" stx))
-(define (elide stx) (raise-syntax-error #f "Used out of context of rules" stx))
 (define (seq stx) (raise-syntax-error #f "Used out of context of rules" stx))

beautiful-racket-ragg/br/ragg/rules/stx.rkt

@@ -67,12 +67,12 @@
                     `(token ,(datum->syntax #f (string->symbol val) source-location))]
                    [(struct pattern-choice (start end vals))
                     `(choice ,@(map recur vals))]
+                   [(struct pattern-elide (start end vals))
+                    `(elide ,@(map recur vals))]
                    [(struct pattern-repeat (start end min val))
                     `(repeat ,min ,(recur val))]
                    [(struct pattern-maybe (start end val))
                     `(maybe ,(recur val))]
-                   [(struct pattern-elide (start end val))
-                    `(elide ,(recur val))]
                    [(struct pattern-seq (start end vals))
                     `(seq ,@(map recur vals))])
                  source-location))