improve cutting of top-level rule name

pull/14/head
Matthew Butterick 6 years ago
parent 8fd0aa4092
commit f8687db35a

@ -2,6 +2,7 @@
(require (for-syntax racket/base (require (for-syntax racket/base
racket/list racket/list
"codegen.rkt" "codegen.rkt"
"runtime.rkt"
"flatten.rkt") "flatten.rkt")
br-parser-tools/lex br-parser-tools/lex
br-parser-tools/cfg-parser br-parser-tools/cfg-parser
@ -88,12 +89,15 @@
(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))
;; little post-processor to allow cuts on top rule name ;; little post-processor to support cuts on top rule name
(syntax-case (THE-GRAMMAR next-token) () (define parse-tree-stx (THE-GRAMMAR next-token))
[(TOP-RULE-NAME . REST) (define top-rule-name-stx (syntax-case parse-tree-stx ()
(eq? (syntax-property #'TOP-RULE-NAME 'hide-or-splice?) 'hide) [(TRN . REST) #'TRN]
#'REST] [_ (error 'malformed-parse-tree)]))
[ALL #'ALL])] (if (eq? (syntax-property top-rule-name-stx 'hide-or-splice?) 'hide)
;; use `remove-rule-name` so we get the same housekeeping
(remove-rule-name parse-tree-stx)
parse-tree-stx)]
[(source tokenizer) [(source tokenizer)
(parameterize ([current-source source]) (parameterize ([current-source source])
(PARSE tokenizer))]) (PARSE tokenizer))])

@ -1,5 +1,4 @@
#lang racket/base #lang racket/base
(require racket/match (require racket/match
racket/list racket/list
racket/generator racket/generator
@ -12,7 +11,8 @@
make-permissive-tokenizer make-permissive-tokenizer
atomic-datum->syntax atomic-datum->syntax
positions->srcloc positions->srcloc
rule-components->syntax) rule-components->syntax
remove-rule-name)
@ -177,12 +177,14 @@ This would be the place to check a syntax property for hiding.
(syntax-case component-stx () (syntax-case component-stx ()
[(name . subcomponents) [(name . subcomponents)
(let ([name-datum (syntax->datum #'name)]) (let ([name-datum (syntax->datum #'name)])
;; two properties: 'rule returns name-datum, and name-datum returns original #'name stx
(define (annotate-name stx) (syntax-property (syntax-property stx name-datum #'name) 'rule name-datum))
(if splice (if splice
;; when splicing, returned list is a regular list, with each element having the property. ;; when splicing, returned list is a regular list, with each element having the property.
(map (λ(sc) (syntax-property sc name-datum #'name)) (syntax->list #'subcomponents)) (map annotate-name (syntax->list #'subcomponents))
;; when hiding, returned list should be a syntaxed list with the property ;; when hiding, returned list should be a syntaxed list with the property
;; iow, basically the same as `component-stx`, minus the name ;; iow, basically the same as `component-stx`, minus the name
(syntax-property (datum->syntax component-stx #'subcomponents component-stx component-stx) name-datum #'name)))] (annotate-name (datum->syntax component-stx #'subcomponents component-stx component-stx))))]
[_ (raise-syntax-error 'remove-rule-name "component has no name" component-stx)])) [_ (raise-syntax-error 'remove-rule-name "component has no name" component-stx)]))

Loading…
Cancel
Save