diff --git a/brag/codegen/expander.rkt b/brag/codegen/expander.rkt index b40aaac..a3e9336 100755 --- a/brag/codegen/expander.rkt +++ b/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))]) diff --git a/brag/codegen/runtime.rkt b/brag/codegen/runtime.rkt index b847e35..613a1c8 100755 --- a/brag/codegen/runtime.rkt +++ b/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)) diff --git a/brag/examples/top-level-cut-1.rkt b/brag/examples/top-level-cut-1.rkt new file mode 100644 index 0000000..f91a6ca --- /dev/null +++ b/brag/examples/top-level-cut-1.rkt @@ -0,0 +1,3 @@ +#lang brag +/top : sub +sub : "x" \ No newline at end of file diff --git a/brag/examples/top-level-cut-2.rkt b/brag/examples/top-level-cut-2.rkt new file mode 100644 index 0000000..d2b46e7 --- /dev/null +++ b/brag/examples/top-level-cut-2.rkt @@ -0,0 +1,3 @@ +#lang brag +/top : sub +/sub : "x" \ No newline at end of file diff --git a/brag/examples/top-level-cut-3.rkt b/brag/examples/top-level-cut-3.rkt new file mode 100644 index 0000000..e3a793c --- /dev/null +++ b/brag/examples/top-level-cut-3.rkt @@ -0,0 +1,3 @@ +#lang brag +/top : sub +@sub : "x" \ No newline at end of file diff --git a/brag/test/test-all.rkt b/brag/test/test-all.rkt index 58e326d..09658b3 100755 --- a/brag/test/test-all.rkt +++ b/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" diff --git a/brag/test/test-top-level-cut.rkt b/brag/test/test-top-level-cut.rkt new file mode 100755 index 0000000..2483999 --- /dev/null +++ b/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")) +