You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
br-parser-tools/collects/parser-tools/private-yacc/parser-builder.ss

74 lines
3.0 KiB
Scheme

#cs
(module parser-builder mzscheme
(require "input-file-parser.ss"
"table.ss"
"parser-actions.ss"
"grammar.ss")
(provide build-parser)
(define (build-parser start input-terms assocs prods filename runtime src)
(let* ((grammar (parse-input start input-terms assocs prods))
(table (build-table grammar ""))
(table-code
(cons 'vector
(map (lambda (action)
(cond
((shift? action)
`(make-shift ,(shift-state action)))
((reduce? action)
`(make-reduce ,(reduce-prod-num action)
,(reduce-lhs-num action)
,(reduce-rhs-length action)))
((accept? action)
`(make-accept))
(else action)))
(vector->list table))))
(num-non-terms (length (grammar-non-terms grammar)))
(token-code
`(let ((ht (make-hash-table)))
(begin
,@(map (lambda (term)
`(hash-table-put! ht
',(gram-sym-symbol term)
,(+ num-non-terms (gram-sym-index term))))
(grammar-terms grammar))
ht)))
(parser-code
`(letrec ((term-sym->index ,token-code)
(table ,table-code)
(pop-2x
(lambda (s n)
(if (> n 0)
(pop-2x (cdr (cdr s)) (sub1 n))
s))))
(lambda (get-token)
(let loop ((stack (list 0))
(next (get-token)))
(let* ((s (car stack))
(a (hash-table-get term-sym->index
(if (token? next)
(token-name next)
next)))
(action (array2d-ref table s a)))
(cond
((shift? action)
(loop (cons (shift-state action) (cons a stack)) (get-token)))
((reduce? action)
(printf "reduce:~a~n" (reduce-prod-num action))
(let* ((A (reduce-lhs-num action))
(new-stack (pop-2x stack (reduce-rhs-length action)))
(goto (array2d-ref table (car new-stack) A)))
(loop (cons goto (cons A new-stack)) next)))
((accept? action)
(printf "accept~n"))
(else (error 'parser)))))))))
(datum->syntax-object
runtime
parser-code
src))))