*** empty log message ***

original commit: fd6994ff1f843f794b3491d338db4bfc8afb6329
tokens
Scott Owens 23 years ago
parent 584ff1ccfb
commit 28a7fc60c9

@ -45,11 +45,11 @@
`(letrec ((term-sym->index ,token-code)
(table ,table-code)
(actions ,actions-code)
(pop-x
(lambda (s n)
(reduce-stack
(lambda (s n v)
(if (> n 0)
(pop-x (cdr s) (sub1 n))
s))))
(reduce-stack (cdr (cdr s)) (sub1 n) (cons (cadr s) v))
(values s v)))))
(lambda (get-token)
(let loop ((stack (list 0))
(ip (get-token)))
@ -66,13 +66,26 @@
(cond
((shift? action)
(printf "shift:~a~n" (shift-state action))
(loop (cons (shift-state action) stack) (get-token)))
(let ((val (if (token? ip)
(token-value ip)
#f)))
(loop (cons (shift-state action) (cons val stack))
(get-token))))
((reduce? action)
(printf "reduce:~a~n" (reduce-prod-num action))
(let-values (((new-stack args)
(reduce-stack stack
(reduce-rhs-length action)
null)))
(let* ((A (reduce-lhs-num action))
(new-stack (pop-x stack (reduce-rhs-length action)))
(goto (array2d-ref table (car new-stack) A)))
(loop (cons goto new-stack) ip)))
(loop (cons goto
(cons (apply
(vector-ref actions
(reduce-prod-num action))
args)
new-stack))
ip))))
((accept? action)
(printf "accept~n"))
(else (error 'parser)))))))))

Loading…
Cancel
Save