lhs-id splicing works ; tests pass

brag/brag/codegen/codegen.rkt

@@ -42,7 +42,7 @@
        #|
        MB: `rules` still carries 'hide syntax property
        |#
-       #;(report flattened-rules)
+       #;(report rules)
        
        
        #|
@@ -54,7 +54,7 @@
        (define generated-rule-codes (map flat-rule->yacc-rule flattened-rules))
        
        #|
-       MB: `generated-rule-codes` loses the 'hide syntax property
+       MB: `generated-rule-codes` loses the 'hide syntax property (but not for lhs-ids)
        |#
        #;(report generated-rule-codes)
        
@@ -179,6 +179,7 @@
 ;;     stx :== (name (U tokens rule-stx) ...)
 ;;
 (define (flat-rule->yacc-rule a-flat-rule)
+  ;; lhs-ids still carry 'hide property on #'name field
   #;(report a-flat-rule)
   (syntax-case a-flat-rule ()
     [(rule-type origin name clauses ...)
@@ -251,7 +252,8 @@
                 [(translated-action ...) translated-actions])
     #`[(translated-pattern ...)
        (rule-components->syntax '#,rule-name/false translated-action ...
-                                #:srcloc #,whole-rule-loc)]))
+                                #:srcloc #,whole-rule-loc
+                                #:splice? #,(syntax-property rule-name/false 'hide))]))
 
 
 

brag/brag/codegen/runtime.rkt

@@ -158,14 +158,20 @@ This would be the place to check a syntax property for hiding.
   (datum->syntax #f d (positions->srcloc start-pos end-pos) stx-with-original?-property))
 
 
-
+(define splice-signal '@)
 ;; rule-components->syntax: (U symbol false) (listof stx) ... #:srcloc (U #f (list src line column offset span)) -> stx
 ;; 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 (rule-components->syntax rule-name/false #:srcloc [srcloc #f] #:splice? [splice #f] . componentss)
-  (datum->syntax #f 
+  (let ([componentss (append-map (λ(cs)
-                 (cons
+                                   (if (and (pair? cs) (syntax-property (car cs) 'splice))
-                  (datum->syntax #f rule-name/false srcloc stx-with-original?-property)
+                                            (list (cdr (syntax->list (car cs))))
-                  (apply append components))
+                                            (list cs))) componentss)])
-                 srcloc
+    (syntax-property
-                 stx-with-original?-property))
+     (datum->syntax #f 
+                    (cons
+                     (datum->syntax #f rule-name/false srcloc stx-with-original?-property)
+                     (apply append componentss))
+                    srcloc
+                    stx-with-original?-property)
+     'splice splice)))

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.rkt

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

brag/brag/rules/stx.rkt

@@ -21,17 +21,19 @@
 
 (define (rule->stx source a-rule)
   (define id-stx
-    (datum->syntax #f
+    (syntax-property
-                   (string->symbol (lhs-id-val (rule-lhs a-rule)))
+     (datum->syntax #f
-                   (list source
+                    (string->symbol (lhs-id-val (rule-lhs a-rule)))
-                         (pos-line (lhs-id-start (rule-lhs a-rule)))
+                    (list source
-                         (pos-col (lhs-id-start (rule-lhs a-rule)))
+                          (pos-line (lhs-id-start (rule-lhs a-rule)))
-                         (pos-offset (lhs-id-start (rule-lhs a-rule)))
+                          (pos-col (lhs-id-start (rule-lhs a-rule)))
-                         (if (and (number? (pos-offset (lhs-id-start (rule-lhs a-rule))))
+                          (pos-offset (lhs-id-start (rule-lhs a-rule)))
-                                  (number? (pos-offset (lhs-id-end (rule-lhs a-rule)))))
+                          (if (and (number? (pos-offset (lhs-id-start (rule-lhs a-rule))))
-                             (- (pos-offset (lhs-id-end (rule-lhs a-rule)))
+                                   (number? (pos-offset (lhs-id-end (rule-lhs a-rule)))))
-                                (pos-offset (lhs-id-start (rule-lhs a-rule))))
+                              (- (pos-offset (lhs-id-end (rule-lhs a-rule)))
-                             #f))))
+                                 (pos-offset (lhs-id-start (rule-lhs a-rule))))
+                              #f)))
+     'hide (lhs-id-hide (rule-lhs a-rule))))
   (define pattern-stx (pattern->stx source (rule-pattern a-rule)))
   (define line (pos-line (rule-start a-rule)))
   (define column (pos-col (rule-start a-rule)))