|
|
@ -122,14 +122,14 @@
|
|
|
|
(let ((action (find-action stack ip)))
|
|
|
|
(let ((action (find-action stack ip)))
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
((shift? action)
|
|
|
|
((shift? action)
|
|
|
|
(printf "shift:~a~n" (shift-state action))
|
|
|
|
;; (printf "shift:~a~n" (shift-state action))
|
|
|
|
(let ((val (if (token? ip)
|
|
|
|
(let ((val (if (token? ip)
|
|
|
|
(token-value ip)
|
|
|
|
(token-value ip)
|
|
|
|
#f)))
|
|
|
|
#f)))
|
|
|
|
(loop (cons (shift-state action) (cons val stack))
|
|
|
|
(loop (cons (shift-state action) (cons val stack))
|
|
|
|
(get-token))))
|
|
|
|
(get-token))))
|
|
|
|
((reduce? action)
|
|
|
|
((reduce? action)
|
|
|
|
(printf "reduce:~a~n" (reduce-prod-num action))
|
|
|
|
;; (printf "reduce:~a~n" (reduce-prod-num action))
|
|
|
|
(let-values (((new-stack args)
|
|
|
|
(let-values (((new-stack args)
|
|
|
|
(reduce-stack stack
|
|
|
|
(reduce-stack stack
|
|
|
|
(reduce-rhs-length action)
|
|
|
|
(reduce-rhs-length action)
|
|
|
@ -144,7 +144,7 @@
|
|
|
|
new-stack))
|
|
|
|
new-stack))
|
|
|
|
ip))))
|
|
|
|
ip))))
|
|
|
|
((accept? action)
|
|
|
|
((accept? action)
|
|
|
|
(printf "accept~n")
|
|
|
|
;; (printf "accept~n")
|
|
|
|
(cadr stack))
|
|
|
|
(cadr stack))
|
|
|
|
(else
|
|
|
|
(else
|
|
|
|
(err)
|
|
|
|
(err)
|
|
|
|