make ids hideable

brag/brag/codegen/codegen.rkt

@@ -43,8 +43,8 @@
        MB: `rules` still carries 'hide syntax property
        |#
        #;(report flattened-rules)
-
+       
-
+       
        #|
        MB: `flattened-rules` still carries 'hide syntax property
        |#
@@ -52,7 +52,7 @@
        #;(report flattened-rules)
        
        (define generated-rule-codes (map flat-rule->yacc-rule flattened-rules))
-
+       
        #|
        MB: `generated-rule-codes` loses the 'hide syntax property
        |#
@@ -216,29 +216,29 @@
     (for/list ([translated-pattern (in-list translated-patterns)]
                [primitive-pattern (syntax->list a-clause)]
                [pos (in-naturals 1)])
-              (with-syntax ([$X 
+              (if (syntax-property primitive-pattern 'hide)
-                             (format-id translated-pattern "$~a" pos)]
+                  #'null
-                            [$X-start-pos 
+                  (with-syntax ([$X 
-                             (format-id translated-pattern "$~a-start-pos" pos)]
+                                 (format-id translated-pattern "$~a" pos)]
-                            [$X-end-pos
+                                [$X-start-pos 
-                             (format-id translated-pattern "$~a-end-pos" pos)])
+                                 (format-id translated-pattern "$~a-start-pos" pos)]
-                (syntax-case primitive-pattern (id lit token inferred-id)
+                                [$X-end-pos
-                  
+                                 (format-id translated-pattern "$~a-end-pos" pos)])
-                  ;; When a rule usage is inferred, the value of $X is a syntax object
+                    (syntax-case primitive-pattern (id lit token inferred-id)
-                  ;; whose head is the name of the inferred rule . We strip that out,
+                      
-                  ;; leaving the residue to be absorbed.
+                      ;; When a rule usage is inferred, the value of $X is a syntax object
-                  [(inferred-id val reason)
+                      ;; whose head is the name of the inferred rule . We strip that out,
-                   #'(syntax-case $X ()
+                      ;; leaving the residue to be absorbed.
-                       [(inferred-rule-name . rest)
+                      [(inferred-id val reason)
-                        (syntax->list #'rest)])]
+                       #'(syntax-case $X ()
-                  [(id val)
+                           [(inferred-rule-name . rest)
-                   #'(list $X)]
+                            (syntax->list #'rest)])]
-                  ;; move the 'hide syntax property into the translated-action
+                      [(id val)
-                  ;; because syntax gets datum-ized
+                       #'(list $X)]
-                  [(lit val)
+                      [(lit val)
-                   #`(list (atomic-datum->syntax $X $X-start-pos $X-end-pos #,(syntax-property primitive-pattern 'hide)))]
+                       #'(list (atomic-datum->syntax $X $X-start-pos $X-end-pos))]
-                  [(token val)
+                      [(token val)
-                   #`(list (atomic-datum->syntax $X $X-start-pos $X-end-pos #,(syntax-property primitive-pattern 'hide)))]))))
+                       #'(list (atomic-datum->syntax $X $X-start-pos $X-end-pos))])))))
   
   (define whole-rule-loc
     (if (empty? translated-patterns)

brag/brag/codegen/runtime.rkt

@@ -150,15 +150,12 @@ This would be the place to check a syntax property for hiding.
 (define stx-with-original?-property
   (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 [hide? #f])
+(define (atomic-datum->syntax d start-pos end-pos)
-  (if hide?
+  (datum->syntax #f d (positions->srcloc start-pos end-pos) stx-with-original?-property))
-      elided
-      (datum->syntax #f d (positions->srcloc start-pos end-pos) stx-with-original?-property)))
 
 
 
@@ -166,10 +163,9 @@ This would be the place to check a syntax property for hiding.
 ;; 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-elided-components (filter-not (λ(c) (eq? c elided)) (apply append components)))
   (datum->syntax #f 
                  (cons
-                        (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)
+                  (apply append components))
                  srcloc
-                 stx-with-original?-property))
+                 stx-with-original?-property))

brag/brag/elider/json-elider-toy.rkt

@@ -1,4 +1,4 @@
 #lang brag
 
-;; Simple baby example of JSON structure
+thing : foo
-json: ID <":"> ID
+foo : <"bar">

brag/brag/elider/json-elider.rkt

@@ -14,4 +14,4 @@ array: "[" [json ("," json)*] "]"
 
 object: <"{"> [kvpair ("," kvpair)*] <"}">
 
-kvpair: <ID> <":"> json
+kvpair: <ID> ":" <json>

brag/brag/elider/test-json-elider-toy.rkt

@@ -0,0 +1,9 @@
+#lang br
+(require "json-elider-toy.rkt"
+         brag/support
+         rackunit)
+
+(check-equal?
+ (syntax->datum
+  (parse (list "bar")))
+ '(thing))

brag/brag/elider/test-json-elider.rkt

@@ -10,10 +10,10 @@
                ":"
                (token 'STRING "'hello world'")
                "}")))
- '(json (object (kvpair (json (string "'hello world'"))))))
+ '(json (object (kvpair "message" (json (string "'hello world'"))))))
 
 
-(check-equal? 
+#;(check-equal? 
  (syntax->datum
   (parse "[[[{}]],[],[[{}]]]"))
  '(json (array #\[ (json (array #\[ (json (array #\[ (json (object)) #\])) #\])) #\, (json (array #\[ #\])) #\, (json (array #\[ (json (array #\[ (json (object )) #\])) #\])) #\])))