permit hiding of starting rule name

brag/codegen/runtime.rkt

@@ -171,48 +171,61 @@ 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 (remove-rule-name component-stx #:splice? [splice #f])
+(define (apply-name-property name-stx stxs)
-  ;; when removing a rule name, we apply it as a syntax property to the remaining elements
+  (for/list ([stx (in-list (syntax->list stxs))])
-  ;; for possible later usage (aka, why throw away information)   
+    (syntax-property stx (syntax->datum name-stx) name-stx)))
-  (with-syntax ([(name . subcomponents) component-stx])
+
-    (let ([name-datum (syntax->datum #'name)])
+
-      (if splice
+(define (splice-stx component-stx)
-          ;; when splicing, returned list is a regular list, with each element having the property.
+  ;; when splicing, we apply rule name as a syntax property to the remaining elements
-          (map (λ(sc) (syntax-property sc name-datum #'name)) (syntax->list #'subcomponents))
+  (syntax-case component-stx ()
-          ;; when hiding, returned list should be a syntaxed list with the property
+    [(name . subcomponents)
-          ;; iow, basically the same as `component-stx`, minus the name
+     (syntax-property #'name 'rule-id) ; name has not been removed (recognized by presence of 'rule-id)
-          (syntax-property (datum->syntax component-stx #'subcomponents component-stx component-stx) name-datum #'name)))))
+     (apply-name-property #'name #'subcomponents)]
-
+    [subcomponents ; name has been removed, but it is stored in 'generating-rule property
-
+     (let* ([name-datum (syntax-property #'subcomponents 'generating-rule)]
-(define (preprocess-component-lists component-lists)
+            [name-stx (syntax-property #'subcomponents name-datum)])
-  ; "preprocess" means splicing and rule-name-hiding where indicated
+       (apply-name-property name-stx #'subcomponents))]))
+
+
+(define (remove-rule-name component-stx)
+  (syntax-case component-stx ()
+    [(name . subcomponents)
+     (let ([name-datum (syntax->datum #'name)])
+       (syntax-property
+        (syntax-property
+         (datum->syntax component-stx #'subcomponents component-stx component-stx)
+         name-datum #'name)
+        'generating-rule name-datum))]))
+
+
+(define (splice-component-lists component-lists)
+  ;; each `component-list` is a list that's either empty, or contains component-stx objects
+  ;; inside `component-stx` is a name followed by subcomponents
   (append*
-   ;; each `component-list` is a list that's either empty, or has a single component-stx object
-   ;; inside `component-stx` is a name followed by subcomponents
    (for*/list ([component-list (in-list component-lists)]
-               [component-stx (in-list component-list)]) ; this has the effect of omitting any empty `component-list`
+               #:unless (empty? component-list) 
-     (list
+               [component-stx (in-list component-list)])
-      (cond
+     (if (or (eq? (syntax-property component-stx 'hide-or-splice) 'splice)
-        ;; test splice first in case both hiding and splicing are set, for instance:
-        ;; /rule : thing @rule
-        ;; otherwise the hide prevents the splice from being expressed
-        [(or (eq? (syntax-property component-stx 'hide-or-splice) 'splice)
              (syntax-property component-stx 'splice-rh-id))
-         (remove-rule-name component-stx #:splice? #t)] ; spliced version is lifted out of the sublist
+         (splice-stx component-stx) ; spliced version is lifted out of the sublist
-        [(eq? (syntax-property component-stx 'hide-or-splice) 'hide)
+         (list component-stx))))) ; otherwise left inside sublist
-         (list (remove-rule-name component-stx))] ; hidden version still wrapped in a sublist
-        [else (list component-stx)])))))
 
 
 ;; 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] #:hide-or-splice? [hide-or-splice #f] . component-lists)
-  (define new-rule-name (datum->syntax #f rule-name/false srcloc stx-with-original?-property))
+  (define new-rule-name (syntax-property
-  (define new-rule-components (append* (preprocess-component-lists component-lists)))
+                         (datum->syntax #f rule-name/false srcloc stx-with-original?-property)
-  (define rule-result (cons new-rule-name new-rule-components))
+                         'rule-id #t))
+  (define rule-result (cons new-rule-name (splice-component-lists component-lists)))
   (define syntaxed-rule-result (datum->syntax #f rule-result srcloc stx-with-original?-property))
-  ;; not 'hide-or-splice-lhs-id, because this will now become a (right-hand) component in a different (left-hand) rule
+  ;; not 'hide-or-splice-lhs-id, because this will now become
-  ;; actual splicing happens when the parent rule is processed (with procedure above)
+  ;; a (right-hand) component in a different (left-hand) rule
-  (syntax-property syntaxed-rule-result 'hide-or-splice hide-or-splice))
+  ;; actual splicing happens when the parent rule is processed (with `splice-component-lists`)
+  (syntax-property ((if (eq? hide-or-splice 'hide)
+                        remove-rule-name
+                        values) syntaxed-rule-result)
+                   'hide-or-splice hide-or-splice))
 

brag/examples/hide-top.rkt

@@ -0,0 +1,2 @@
+#lang brag
+/top : "x"

brag/test/test-all.rkt

@@ -11,6 +11,7 @@
          "test-errors.rkt"
          "test-flatten.rkt"
          "test-hide-and-splice.rkt"
+         "test-hide-top.rkt"
          "test-lexer.rkt"
          "test-old-token.rkt"
          "test-parser.rkt"

brag/test/test-hide-top.rkt

@@ -0,0 +1,8 @@
+#lang racket/base
+(require brag/examples/hide-top
+         brag/support
+         rackunit)
+
+;; check that the top rule name can be cut (hidden)
+
+(check-equal? (parse-to-datum "x") '("x"))