permit cuts on top-level rule name

pull/14/head
Matthew Butterick 6 years ago
parent 6dff5018c6
commit bfacb563df

@ -88,7 +88,12 @@
(case-lambda [(tokenizer) (case-lambda [(tokenizer)
(define next-token (define next-token
(make-permissive-tokenizer tokenizer all-tokens-hash/mutable)) (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) [(source tokenizer)
(parameterize ([current-source source]) (parameterize ([current-source source])
(PARSE tokenizer))]) (PARSE tokenizer))])

@ -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. ;; Creates an stx out of the rule name and its components.
;; The location information of the rule spans that of 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 (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 new-rule-components (preprocess-component-lists component-lists))
(define rule-result (cons new-rule-name new-rule-components)) (define rule-result (cons new-rule-name new-rule-components))
(define syntaxed-rule-result (datum->syntax #f rule-result srcloc stx-with-original?-property)) (define syntaxed-rule-result (datum->syntax #f rule-result srcloc stx-with-original?-property))

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

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

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

@ -18,6 +18,7 @@
"test-simple-arithmetic-grammar.rkt" "test-simple-arithmetic-grammar.rkt"
"test-simple-line-drawing.rkt" "test-simple-line-drawing.rkt"
"test-start-and-atok.rkt" "test-start-and-atok.rkt"
"test-top-level-cut.rkt"
"test-weird-grammar.rkt" "test-weird-grammar.rkt"
"test-whitespace.rkt" "test-whitespace.rkt"
"test-wordy.rkt" "test-wordy.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"))
Loading…
Cancel
Save