hiding works for literals and tokens ; tests pass ; resume in ids

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

@@ -1,4 +1,4 @@
-#lang racket/base
+#lang br
 
 (require (for-template racket/base)
          racket/list
@@ -38,10 +38,26 @@
        
        ;; We flatten the rules so we can use the yacc-style ruleset that parser-tools
        ;; supports.
+       
+       #|
+       MB: `rules` still carries 'hide syntax property
+       |#
+       #;(report flattened-rules)
+
+
+       #|
+       MB: `flattened-rules` still carries 'hide syntax property
+       |#
        (define flattened-rules (flatten-rules rules))
+       #;(report flattened-rules)
        
        (define generated-rule-codes (map flat-rule->yacc-rule flattened-rules))
 
+       #|
+       MB: `generated-rule-codes` loses the 'hide syntax property
+       |#
+       #;(report generated-rule-codes)
+       
        ;; The first rule, by default, is the start rule.
        (define rule-ids (for/list ([a-rule (in-list rules)])
                                   (rule-id a-rule)))
@@ -163,6 +179,7 @@
 ;;     stx :== (name (U tokens rule-stx) ...)
 ;;
 (define (flat-rule->yacc-rule a-flat-rule)
+  #;(report a-flat-rule)
   (syntax-case a-flat-rule ()
     [(rule-type origin name clauses ...)
      (begin
@@ -206,6 +223,7 @@
                             [$X-end-pos
                              (format-id translated-pattern "$~a-end-pos" pos)])
                 (syntax-case primitive-pattern (id lit token inferred-id)
+                  
                   ;; When a rule usage is inferred, the value of $X is a syntax object
                   ;; whose head is the name of the inferred rule . We strip that out,
                   ;; leaving the residue to be absorbed.
@@ -214,11 +232,13 @@
                        [(inferred-rule-name . rest)
                         (syntax->list #'rest)])]
                   [(id val)
-                   #`(list $X)]
+                   #'(list $X)]
+                  ;; move the 'hide syntax property into the translated-action
+                  ;; because syntax gets datum-ized
                   [(lit val)
-                   #`(list (atomic-datum->syntax $X $X-start-pos $X-end-pos))]
+                   #`(list (atomic-datum->syntax $X $X-start-pos $X-end-pos #,(syntax-property primitive-pattern 'hide)))]
                   [(token val)
-                   #`(list (atomic-datum->syntax $X $X-start-pos $X-end-pos))]))))
+                   #`(list (atomic-datum->syntax $X $X-start-pos $X-end-pos #,(syntax-property primitive-pattern 'hide)))]))))
   
   (define whole-rule-loc
     (if (empty? translated-patterns)

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

@@ -1,4 +1,4 @@
-#lang racket/base
+#lang br
 
 (require racket/match 
          racket/list
@@ -140,19 +140,25 @@
                (lex:position-offset start-pos))
             #f)))
 
-
+#|
+MB: the next three functions control the parse tree output.
+This would be the place to check a syntax property for hiding.
+|#
 ;; We create a syntax using read-syntax; by definition, it should have the
 ;; original? property set to #t, which we then copy over to syntaxes constructed
 ;; with atomic-datum->syntax and rule-components->syntax.
 (define stx-with-original?-property
-  (read-syntax #f (open-input-string "original")))
+  (read-syntax #f (open-input-string "meaningless-string")))
 
+(define elided (gensym))
 
 ;; atomic-datum->syntax: datum position position
 ;; Helper that does the ugly work in wrapping a datum into a syntax
 ;; with source location.
-(define (atomic-datum->syntax d start-pos end-pos)
+(define (atomic-datum->syntax d start-pos end-pos [hide? #f])
-  (datum->syntax #f d (positions->srcloc start-pos end-pos) stx-with-original?-property))
+  (if hide?
+      elided
+      (datum->syntax #f d (positions->srcloc start-pos end-pos) stx-with-original?-property)))
 
 
 
@@ -160,11 +166,10 @@
 ;; Creates an stx out of the rule name and its components.
 ;; The location information of the rule spans that of its components.
 (define (rule-components->syntax rule-name/false #:srcloc [srcloc #f] . components)
-  (define flattened-components (apply append components))
+  (define flattened-elided-components (filter-not (λ(c) (eq? c elided)) (apply append components)))
   (datum->syntax #f 
-                 (apply append
+                 (cons
-                        (list 
+                        (datum->syntax #f rule-name/false srcloc stx-with-original?-property)
-                         (datum->syntax #f rule-name/false srcloc stx-with-original?-property))
+                        flattened-elided-components)
-                        components)
                  srcloc
                  stx-with-original?-property))

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

@@ -0,0 +1,4 @@
+#lang br/ragg
+
+;; Simple baby example of JSON structure
+json: ID <":"> ID

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

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

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

@@ -1,4 +1,4 @@
-#lang racket/base
+#lang br
 (require "json-elider.rkt"
          br/ragg/support
          rackunit)
@@ -10,15 +10,13 @@
                ":"
                (token 'STRING "'hello world'")
                "}")))
- '(json (object "{"
+ '(json (object (kvpair (json (string "'hello world'"))))))
-                (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 #\{ #\})) #\])) #\])) #\])))
+ '(json (array #\[ (json (array #\[ (json (array #\[ (json (object)) #\])) #\])) #\, (json (array #\[ #\])) #\, (json (array #\[ (json (array #\[ (json (object )) #\])) #\])) #\])))
 
  
                

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

@@ -1,4 +1,4 @@
-#lang racket/base
+#lang br
 
 (require "rule-structs.rkt"
          parser-tools/lex

beautiful-racket-ragg/br/ragg/test/test-all.rkt

@@ -1,4 +1,4 @@
-#lang racket/base
+#lang br
 
 
 (require "test-0n1.rkt"

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

@@ -1,4 +1,4 @@
-#lang racket/base
+#lang br
 
 
 (require rackunit
@@ -47,11 +47,11 @@
                                       1
                                       (pattern-lit (p 8) (p 15) "hello" #f)))))
 
-(check-equal? (grammar-parser (tokenize (open-input-string "expr : ['hello']")))
+(check-equal? (grammar-parser (tokenize (open-input-string "expr : [<'hello'>]")))
-              (list (rule (p 1) (p 17)
+              (list (rule (p 1) (p 19)
                           (lhs-id (p 1) (p 5) "expr" #f)
-                          (pattern-maybe (p 8) (p 17)
+                          (pattern-maybe (p 8) (p 19)
-                                     (pattern-lit (p 9) (p 16) "hello" #f)))))
+                                     (pattern-lit (p 9) (p 18) "hello" #t)))))
 
 (check-equal? (grammar-parser (tokenize (open-input-string "expr : COLON | BLAH")))
               (list (rule (p 1) (p 20)
@@ -70,12 +70,12 @@
                                                      (list (pattern-token (p 23) (p 26) "BAZ" #f)
                                                            (pattern-id (p 27) (p 31) "expr" #f))))))))
 
-(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two three")))
+(check-equal? (grammar-parser (tokenize (open-input-string "expr : one two <three>")))
-              (list (rule (p 1) (p 21)
+              (list (rule (p 1) (p 23)
                           (lhs-id (p 1) (p 5) "expr" #f)
-                          (pattern-seq (p 8) (p 21) (list (pattern-id (p 8) (p 11) "one" #f)
+                          (pattern-seq (p 8) (p 23) (list (pattern-id (p 8) (p 11) "one" #f)
                                               (pattern-id (p 12) (p 15) "two" #f)
-                                              (pattern-id (p 16) (p 21) "three" #f))))))
+                                              (pattern-id (p 16) (p 23) "three" #t))))))
 
 
 (check-equal? (grammar-parser (tokenize (open-input-string "expr : (one two three)")))