permit cuts on top-level rule name

brag/codegen/expander.rkt

@@ -17,7 +17,7 @@
 (define-for-syntax (rules->token-types rules)
   (define-values (implicit-tokens explicit-tokens) (rules-collect-token-types rules))
   (remove-duplicates (append (for/list ([it (in-list implicit-tokens)])
-                                       (string->symbol (syntax-e it)))
+                               (string->symbol (syntax-e it)))
                              (map syntax-e explicit-tokens)) eq?))
 
 (define-syntax (brag-module-begin rules-stx)
@@ -37,7 +37,7 @@
        (with-syntax ([START-ID (first rule-ids)] ; The first rule, by default, is the start rule.
                      [((TOKEN-TYPE . TOKEN-TYPE-CONSTRUCTOR) ...)
                       (for/list ([tt (in-list (rules->token-types rules))])
-                                (cons tt (string->symbol (format "token-~a" tt))))]
+                        (cons tt (string->symbol (format "token-~a" tt))))]
                      ;; Flatten rules to use the yacc-style ruleset that br-parser-tools supports       
                      [GENERATED-RULE-CODES (map flat-rule->yacc-rule (flatten-rules rules))]
                      ;; main exports. Break hygiene so they're also available at top-level / repl
@@ -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"))
+