permit cuts on top-level rule name

brag/codegen/expander.rkt

@@ -88,7 +88,12 @@
                         (case-lambda [(tokenizer)
                                       (define next-token
                                         (make-permissive-tokenizer tokenizer all-tokens-hash/mutable))
-                                      (THE-GRAMMAR next-token)]
+                                      ;; little post-processor to allow cuts on top rule name
+                                      (syntax-case (THE-GRAMMAR next-token) ()
+                                        [(TOP-RULE-NAME . REST)
+                                         (eq? (syntax-property #'TOP-RULE-NAME 'hide-or-splice?) 'hide)
+                                         #'REST]
+                                        [ALL #'ALL])]
                                      [(source tokenizer)
                                       (parameterize ([current-source source])
                                         (PARSE tokenizer))])

brag/codegen/runtime.rkt

@@ -212,7 +212,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] #: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
+    ;; stash the hide property on rule names so we can use it later if we want
+    (syntax-property (datum->syntax #f rule-name/false srcloc stx-with-original?-property) 'hide-or-splice? hide-or-splice))
   (define new-rule-components (preprocess-component-lists component-lists))
   (define rule-result (cons new-rule-name new-rule-components))
   (define syntaxed-rule-result (datum->syntax #f rule-result srcloc stx-with-original?-property))

brag/examples/top-level-cut-1.rkt

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

brag/examples/top-level-cut-2.rkt

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

brag/examples/top-level-cut-3.rkt

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

brag/test/test-all.rkt

@@ -18,6 +18,7 @@
          "test-simple-arithmetic-grammar.rkt"
          "test-simple-line-drawing.rkt"
          "test-start-and-atok.rkt"
+         "test-top-level-cut.rkt"
          "test-weird-grammar.rkt"
          "test-whitespace.rkt"
          "test-wordy.rkt"

brag/test/test-top-level-cut.rkt

@@ -0,0 +1,11 @@
+#lang racket/base
+(require (prefix-in 1: brag/examples/top-level-cut-1)
+         (prefix-in 2: brag/examples/top-level-cut-2)
+         (prefix-in 3: brag/examples/top-level-cut-3)
+         brag/support
+         rackunit)
+
+(check-equal? (1:parse-to-datum "x") '((sub "x")))
+(check-equal? (2:parse-to-datum "x") '(("x")))
+(check-equal? (3:parse-to-datum "x") '("x"))
+