|
|
@ -58,10 +58,10 @@
|
|
|
|
(let ((a (find-action stack 'error)))
|
|
|
|
(let ((a (find-action stack 'error)))
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
((shift? a)
|
|
|
|
((shift? a)
|
|
|
|
(printf "shift:~a~n" (shift-state a))
|
|
|
|
;; (printf "shift:~a~n" (shift-state a))
|
|
|
|
(set! stack (cons (shift-state a) (cons #f stack))))
|
|
|
|
(set! stack (cons (shift-state a) (cons #f stack))))
|
|
|
|
(else
|
|
|
|
(else
|
|
|
|
(printf "discard-state:~a~n" (car stack))
|
|
|
|
;; (printf "discard-state:~a~n" (car stack))
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
((< (length stack) 3)
|
|
|
|
((< (length stack) 3)
|
|
|
|
(printf "Unable to shift error token~n")
|
|
|
|
(printf "Unable to shift error token~n")
|
|
|
@ -73,7 +73,7 @@
|
|
|
|
(let ((a (find-action stack ip)))
|
|
|
|
(let ((a (find-action stack ip)))
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
((shift? a)
|
|
|
|
((shift? a)
|
|
|
|
(printf "shift:~a~n" (shift-state a))
|
|
|
|
;; (printf "shift:~a~n" (shift-state a))
|
|
|
|
(cons (shift-state a)
|
|
|
|
(cons (shift-state a)
|
|
|
|
(cons (if (token? ip)
|
|
|
|
(cons (if (token? ip)
|
|
|
|
(token-value ip)
|
|
|
|
(token-value ip)
|
|
|
@ -105,14 +105,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)
|
|
|
@ -127,7 +127,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)
|
|
|
|