improve cutting of top-level rule name

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

@ -2,6 +2,7 @@
(require (for-syntax racket/base
racket/list
"codegen.rkt"
"runtime.rkt"
"flatten.rkt")
br-parser-tools/lex
br-parser-tools/cfg-parser
@ -88,12 +89,15 @@
(case-lambda [(tokenizer)
(define next-token
(make-permissive-tokenizer tokenizer all-tokens-hash/mutable))
;; 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])]
;; little post-processor to support cuts on top rule name
(define parse-tree-stx (THE-GRAMMAR next-token))
(define top-rule-name-stx (syntax-case parse-tree-stx ()
[(TRN . REST) #'TRN]
[_ (error 'malformed-parse-tree)]))
(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)
(parameterize ([current-source source])
(PARSE tokenizer))])

@ -1,5 +1,4 @@
#lang racket/base
(require racket/match
racket/list
racket/generator
@ -12,7 +11,8 @@
make-permissive-tokenizer
atomic-datum->syntax
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 ()
[(name . subcomponents)
(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
;; 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
;; 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)]))

Loading…
Cancel
Save