`elide` token added with no functional changes; all tests still 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 seq)
+    (syntax-case a-pattern (id lit token choice repeat maybe elide seq)
       [(id val)
        (values implicit explicit)]
       [(lit val)
@@ -279,6 +279,8 @@
        (loop #'val implicit explicit)]
       [(maybe val)
        (loop #'val implicit explicit)]
+      [(elide val)
+       (loop #'val implicit explicit)]
       [(seq vals ...)
        (for/fold ([implicit implicit]
                   [explicit explicit])
@@ -342,7 +344,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 seq)
+    (syntax-case a-pattern (id lit token choice repeat maybe elide seq)
       [(id val)
        (cons #'val acc)]
       [(lit val)
@@ -357,6 +359,8 @@
        (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 ...)))])
@@ -385,7 +389,7 @@
     a-leaf)
 
   (define (process-pattern a-pattern)
-    (syntax-case a-pattern (id lit token choice repeat maybe seq)
+    (syntax-case a-pattern (id lit token choice repeat maybe elide seq)
       [(id val)
        (free-id-table-ref toplevel-rule-table #'val)]
       [(lit val)
@@ -407,6 +411,8 @@
           (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 seq)
+         (syntax-case #'pat (id inferred-id lit token choice repeat maybe elide seq)
 
            ;; The primitive types stay as they are:
            [(id val)
@@ -123,6 +123,16 @@
                               [])
                       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)
@@ -139,7 +149,7 @@
 
 ;; Returns true if the pattern looks primitive
 (define (primitive-pattern? a-pat)
-  (syntax-case a-pat (id lit token choice repeat maybe seq)
+  (syntax-case a-pat (id lit token choice repeat maybe elide seq)
     [(id val)
      #t]
     [(lit val)
@@ -152,6 +162,8 @@
      #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

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

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

@@ -0,0 +1,25 @@
+#lang racket/base
+(require "json-elider.rkt"
+         br/ragg/support
+         rackunit)
+
+(check-equal?
+ (syntax->datum
+  (parse (list "{" 
+               (token 'ID "message")
+               ":"
+               (token 'STRING "'hello world'")
+               "}")))
+ '(json (object "{"
+                (kvpair "message" (json (string "'hello world'")))
+                "}")))
+
+
+#;(check-equal? 
+ (syntax->datum
+  (parse "[[[{}]],[],[[{}]]]"))
+ '(json (array #\[ (json (array #\[ (json (array #\[ (json (object #\{ #\})) #\])) #\])) #\, (json (array #\[ #\])) #\, (json (array #\[ (json (array #\[ (json (object #\{ #\})) #\])) #\])) #\])))
+
+ 
+               
+               

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

@@ -2,7 +2,6 @@
 (define name "ragg")
 (define categories '(devtools))
 (define can-be-loaded-with 'all)
-(define required-core-version "5.3.1")
 (define version "1.0")
 (define repositories '("4.x"))
 (define scribblings '(("br-ragg.scrbl")))

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

@@ -39,10 +39,14 @@
     (token-LPAREN lexeme)]
    ["["
     (token-LBRACKET lexeme)]
+   ["<"
+    (token-LANGLE lexeme)]
    [")"
     (token-RPAREN lexeme)]
    ["]"
     (token-RBRACKET lexeme)]
+   [">"
+    (token-RANGLE lexeme)]
    ["|"
     (token-PIPE lexeme)]
    [(:or "+" "*")

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

@@ -12,6 +12,8 @@
          token-RPAREN
          token-LBRACKET
          token-RBRACKET
+         token-LANGLE ; for elider
+         token-RANGLE ; for elider
          token-PIPE
          token-REPEAT
          token-RULE_HEAD
@@ -32,12 +34,15 @@
          [struct-out pattern-choice]
          [struct-out pattern-repeat]
          [struct-out pattern-maybe]
+         [struct-out pattern-elide]
          [struct-out pattern-seq])
 
 (define-tokens tokens (LPAREN
                        RPAREN
                        LBRACKET
                        RBRACKET
+                       LANGLE
+                       RANGLE
                        PIPE
                        REPEAT
                        RULE_HEAD
@@ -140,6 +145,11 @@
                      (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))]])
    
@@ -152,22 +162,24 @@
 ;; Rewrites the pattern's start and end pos accordingly.
 (define (relocate-pattern a-pat start-pos end-pos)
   (match a-pat
-   [(pattern-id _ _ v)
+    [(pattern-id _ _ v)
-    (pattern-id start-pos end-pos v)]
+     (pattern-id start-pos end-pos v)]
-   [(pattern-token _ _ v)
+    [(pattern-token _ _ v)
-    (pattern-token start-pos end-pos v)]
+     (pattern-token start-pos end-pos v)]
-   [(pattern-lit _ _ v)
+    [(pattern-lit _ _ v)
-    (pattern-lit start-pos end-pos v)]
+     (pattern-lit start-pos end-pos v)]
-   [(pattern-choice _ _ vs)
+    [(pattern-choice _ _ vs)
-    (pattern-choice start-pos end-pos vs)]
+     (pattern-choice start-pos end-pos vs)]
-   [(pattern-repeat _ _ m v)
+    [(pattern-repeat _ _ m v)
-    (pattern-repeat start-pos end-pos m v)]
+     (pattern-repeat start-pos end-pos m v)]
-   [(pattern-maybe _ _ v)
+    [(pattern-maybe _ _ v)
-    (pattern-maybe start-pos end-pos v)]
+     (pattern-maybe start-pos end-pos v)]
-   [(pattern-seq _ _ vs)
+    [(pattern-elide _ _ v)
-    (pattern-seq start-pos end-pos vs)]
+     (pattern-elide start-pos end-pos v)]
-   [else
+    [(pattern-seq _ _ vs)
-    (error 'relocate-pattern "Internal error when relocating ~s\n" a-pat)]))
+     (pattern-seq start-pos end-pos vs)]
+    [else
+     (error 'relocate-pattern "Internal error when relocating ~s\n" a-pat)]))
 
 
 ; token-id: string -> boolean
@@ -194,9 +206,9 @@
 
 ;; When bad things happen, we need to emit errors with source location.
 (struct exn:fail:parse-grammar exn:fail (srclocs)
-        #:transparent
+  #:transparent
-        #:property prop:exn:srclocs (lambda (instance)
+  #:property prop:exn:srclocs (lambda (instance)
-                                      (exn:fail:parse-grammar-srclocs instance)))
+                                (exn:fail:parse-grammar-srclocs instance)))
 
 (define current-parser-error-handler
   (make-parameter

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

@@ -42,6 +42,9 @@
 (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

@@ -13,4 +13,5 @@
 (define (choice 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

@@ -71,6 +71,8 @@
                     `(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))

beautiful-racket/br/demo/txtadv/world-test.rkt

@@ -1,4 +1,4 @@
-#lang at-exp racket
+#lang racket
 (require rackunit)
 (require "world.rkt")
 
@@ -20,6 +20,7 @@
  "get key"
  "You now have the key.\n")
 
+
 (check-cmd?
  "n"
  "You're standing in a meadow. There is a house to the north.\n")