|
|
|
@ -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).
|
|
|
|
|
Matthew Butterick