mbutterick
/
br-parser-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

make it possible to use "start" and "atok" as literal tokens

Browse Source
tokens
Matthew Butterick 7 years ago
parent 3e71cfa350
commit 2d5d7ecaaf
1 changed files with 39 additions and 27 deletions
Show Stats Download Patch File Download Diff File

66
parser-tools-lib/parser-tools/cfg-parser.rkt
Unescape Escape View File

@ -489,6 +489,12 @@
(fail-k max-depth tasks))))]) (fail-k max-depth tasks))))])
(k end max-depth tasks new-got-k new-fail-k)))]))))) (k end max-depth tasks new-got-k new-fail-k)))])))))
;; These temp identifiers can't be `gensym` or `generate-temporary`
;; because they have to be consistent between module loads
;; (IIUC, the parser is multi-threaded, and this approach is not thread-safe)
;; so I see no alternative to the old standby of making them ludicrously unlikely
(define-for-syntax start-id-temp 'start_jihqolbbafscgxvsufnepvmxqipnxgmlpxukmdoqxqzmzgaogaftbkbyqjttwwfimifowdxfyekjiixdmtprfkcvfciraehoeuaz)
(define-for-syntax atok-id-temp 'atok_wrutdjgecmybyfipiwsgjlvsveryodlgassuzcargiuznzgdghrykfqfbwcjgzdhdoeqxcucmtjkuyucskzethozhqkasphdwbht)
(define-syntax (cfg-parser stx) (define-syntax (cfg-parser stx)
(syntax-case stx () (syntax-case stx ()
[(_ clause ...) [(_ clause ...)
@ -704,11 +710,17 @@
[(pos ...) [(pos ...)
(if src-pos? (if src-pos?
#'($1-start-pos $1-end-pos) #'($1-start-pos $1-end-pos)
#'(#f #f))]) #'(#f #f))]
#`(grammar (start [() null] ;; rename `start` and `atok` to temp ids
[(atok start) (cons $1 $2)]) ;; so that "start" and "atok" can be used as literal string tokens in a grammar.
(atok [(tok) (make-tok 'tok-id 'tok $e pos ...)] ...))) ;; not sure why this works, but it passes all tests.
#`(start start) [%start start-id-temp]
[%atok atok-id-temp])
#`(grammar (%start [() null]
[(%atok %start) (cons $1 $2)])
(%atok [(tok) (make-tok 'tok-id 'tok $e pos ...)] ...)))
(with-syntax ([%start start-id-temp])
#`(start %start))
parser-clauses)))] parser-clauses)))]
[(grammar . _) [(grammar . _)
(raise-syntax-error (raise-syntax-error
@ -751,30 +763,30 @@
[else [else
(error-proc tok-ok? tok-name tok-value)])) (error-proc tok-ok? tok-name tok-value)]))
(cond (cond
[(null? tok-list) [(null? tok-list)
(if error-proc (if error-proc
(call-error-proc #t (call-error-proc #t
'no-tokens 'no-tokens
#f #f
(make-position #f #f #f) (make-position #f #f #f)
(make-position #f #f #f)) (make-position #f #f #f))
(error (error
'cfg-parse 'cfg-parse
"no tokens"))] "no tokens"))]
[else [else
(let ([bad-tok (list-ref tok-list (let ([bad-tok (list-ref tok-list
(min (sub1 (length tok-list)) (min (sub1 (length tok-list))
max-depth))]) max-depth))])
(if error-proc (if error-proc
(call-error-proc #t (call-error-proc #t
(tok-orig-name bad-tok) (tok-orig-name bad-tok)
(tok-val bad-tok) (tok-val bad-tok)
(tok-start bad-tok) (tok-start bad-tok)
(tok-end bad-tok)) (tok-end bad-tok))
(error (error
'cfg-parse 'cfg-parse
"failed at ~a" "failed at ~a"
(tok-val bad-tok))))]))]) (tok-val bad-tok))))]))])
(#,start tok-list (#,start tok-list
;; we simulate a token at the very beginning with zero width ;; we simulate a token at the very beginning with zero width
;; for use with the position-generating code (*-start-pos, *-end-pos). ;; for use with the position-generating code (*-start-pos, *-end-pos).

Write Preview
Loading…
Cancel
Save