mbutterick
/
brag
1
0
Fork 0
Code Issues 3 Pull Requests 1 Projects Releases Wiki Activity

don't be a slob (fixes #3)

Browse Source
pull/6/head
Matthew Butterick 7 years ago
parent 9e2e7f04c8
commit 93fcabcc51
1 changed files with 66 additions and 61 deletions
Show Stats Download Patch File Download Diff File

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

@ -652,67 +652,72 @@
pats (caddr old-list)))) pats (caddr old-list))))
nt-ids patss) nt-ids patss)
;; Build a definition for each non-term: ;; Build a definition for each non-term:
(loop (cdr clauses) (let ([start-id-temp (gensym)]
cfg-start [atok-id-temp (gensym)])
(map (lambda (nt pats handles $ctxs) (loop (cdr clauses)
(define info (bound-identifier-mapping-get nts nt)) cfg-start
(list nt (map (lambda (nt pats handles $ctxs)
#`(let ([key (gensym '#,nt)]) (define info (bound-identifier-mapping-get nts nt))
(lambda (stream last-consumed-token depth end success-k fail-k max-depth tasks) (list nt
(parse-nt/share #`(let ([key (gensym '#,nt)])
key #,(car info) '#,(cadr info) stream last-consumed-token depth end (lambda (stream last-consumed-token depth end success-k fail-k max-depth tasks)
max-depth tasks (parse-nt/share
success-k fail-k key #,(car info) '#,(cadr info) stream last-consumed-token depth end
(lambda (end max-depth tasks success-k fail-k) max-depth tasks
#,(let loop ([pats pats] success-k fail-k
[handles (syntax->list handles)] (lambda (end max-depth tasks success-k fail-k)
[$ctxs (syntax->list $ctxs)] #,(let loop ([pats pats]
[simple?s (caddr info)]) [handles (syntax->list handles)]
(if (null? pats) [$ctxs (syntax->list $ctxs)]
#'(fail-k max-depth tasks) [simple?s (caddr info)])
#`(#,(if (or (null? (cdr pats)) (if (null? pats)
(car simple?s)) #'(fail-k max-depth tasks)
#'parse-or #`(#,(if (or (null? (cdr pats))
#'parse-parallel-or) (car simple?s))
(lambda (stream last-consumed-token depth end success-k fail-k max-depth tasks) #'parse-or
#,(build-match nts #'parse-parallel-or)
toks (lambda (stream last-consumed-token depth end success-k fail-k max-depth tasks)
(car pats) #,(build-match nts
(car handles) toks
(car $ctxs))) (car pats)
(lambda (stream last-consumed-token depth end success-k fail-k max-depth tasks) (car handles)
#,(loop (cdr pats) (car $ctxs)))
(cdr handles) (lambda (stream last-consumed-token depth end success-k fail-k max-depth tasks)
(cdr $ctxs) #,(loop (cdr pats)
(cdr simple?s))) (cdr handles)
stream last-consumed-token depth end success-k fail-k max-depth tasks))))))))) (cdr $ctxs)
nt-ids (cdr simple?s)))
patss stream last-consumed-token depth end success-k fail-k max-depth tasks)))))))))
(syntax->list #'(((begin handle0 handle ...) ...) ...)) nt-ids
(syntax->list #'((handle0 ...) ...))) patss
cfg-error (syntax->list #'(((begin handle0 handle ...) ...) ...))
src-pos? (syntax->list #'((handle0 ...) ...)))
(list* cfg-error
(with-syntax ([((tok tok-id . $e) ...) src-pos?
(token-identifier-mapping-map toks (list*
(lambda (k v) (with-syntax ([((tok tok-id . $e) ...)
(list* k (token-identifier-mapping-map toks
(car v) (lambda (k v)
(if (cdr v) (list* k
#f (car v)
'$1))))] (if (cdr v)
[(pos ...) #f
(if src-pos? '$1))))]
#'($1-start-pos $1-end-pos) [(pos ...)
#'(#f #f))]) (if src-pos?
;; rename `start` and `atok` to `%start` and `%atok` #'($1-start-pos $1-end-pos)
;; so that "start" and "atok" can be used as literal string tokens in a grammar. #'(#f #f))]
;; not sure why this works, but it passes all tests. ;; rename `start` and `atok` to temp ids
#`(grammar (%start [() null] ;; so that "start" and "atok" can be used as literal string tokens in a grammar.
[(%atok %start) (cons $1 $2)]) ;; not sure why this works, but it passes all tests.
(%atok [(tok) (make-tok 'tok-id 'tok $e pos ...)] ...))) [%start start-id-temp]
#`(start %start) [%atok atok-id-temp])
parser-clauses)))] #`(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))))]
[(grammar . _) [(grammar . _)
(raise-syntax-error (raise-syntax-error
#f #f

Write Preview
Loading…
Cancel
Save