|
|
@ -209,20 +209,17 @@
|
|
|
|
(let ([a (find-action stack tok val start-pos end-pos)])
|
|
|
|
(let ([a (find-action stack tok val start-pos end-pos)])
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
[(runtime-shift? a)
|
|
|
|
[(runtime-shift? a)
|
|
|
|
;; (printf "shift:~a\n" (runtime-shift-state a))
|
|
|
|
|
|
|
|
(cons (stack-frame (runtime-shift-state a)
|
|
|
|
(cons (stack-frame (runtime-shift-state a)
|
|
|
|
val
|
|
|
|
val
|
|
|
|
start-pos
|
|
|
|
start-pos
|
|
|
|
end-pos)
|
|
|
|
end-pos)
|
|
|
|
stack)]
|
|
|
|
stack)]
|
|
|
|
[else
|
|
|
|
[else
|
|
|
|
;; (printf "discard input:~a\n" tok)
|
|
|
|
|
|
|
|
(call-with-values (λ () (extract (get-token))) remove-input)])))))
|
|
|
|
(call-with-values (λ () (extract (get-token))) remove-input)])))))
|
|
|
|
(let remove-states ()
|
|
|
|
(let remove-states ()
|
|
|
|
(define a (find-action stack 'error #f start-pos end-pos))
|
|
|
|
(define a (find-action stack 'error #f start-pos end-pos))
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
[(runtime-shift? a)
|
|
|
|
[(runtime-shift? a)
|
|
|
|
;; (printf "shift:~a\n" (runtime-shift-state a))
|
|
|
|
|
|
|
|
(set! stack
|
|
|
|
(set! stack
|
|
|
|
(cons
|
|
|
|
(cons
|
|
|
|
(stack-frame (runtime-shift-state a)
|
|
|
|
(stack-frame (runtime-shift-state a)
|
|
|
@ -232,7 +229,6 @@
|
|
|
|
stack))
|
|
|
|
stack))
|
|
|
|
(remove-input tok val start-pos end-pos)]
|
|
|
|
(remove-input tok val start-pos end-pos)]
|
|
|
|
[else
|
|
|
|
[else
|
|
|
|
;; (printf "discard state:~a\n" (car stack))
|
|
|
|
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
[(< (length stack) 2)
|
|
|
|
[(< (length stack) 2)
|
|
|
|
(raise-read-error "parser: Cannot continue after error"
|
|
|
|
(raise-read-error "parser: Cannot continue after error"
|
|
|
@ -260,7 +256,6 @@
|
|
|
|
(define action (find-action stack tok val start-pos end-pos))
|
|
|
|
(define action (find-action stack tok val start-pos end-pos))
|
|
|
|
(cond
|
|
|
|
(cond
|
|
|
|
[(runtime-shift? action)
|
|
|
|
[(runtime-shift? action)
|
|
|
|
;; (printf "shift:~a\n" (runtime-shift-state action))
|
|
|
|
|
|
|
|
(parsing-loop (cons (stack-frame (runtime-shift-state action)
|
|
|
|
(parsing-loop (cons (stack-frame (runtime-shift-state action)
|
|
|
|
val
|
|
|
|
val
|
|
|
|
start-pos
|
|
|
|
start-pos
|
|
|
@ -268,7 +263,6 @@
|
|
|
|
stack)
|
|
|
|
stack)
|
|
|
|
(get-token))]
|
|
|
|
(get-token))]
|
|
|
|
[(runtime-reduce? action)
|
|
|
|
[(runtime-reduce? action)
|
|
|
|
;; (printf "reduce:~a\n" (runtime-reduce-prod-num action))
|
|
|
|
|
|
|
|
(let-values ([(new-stack args)
|
|
|
|
(let-values ([(new-stack args)
|
|
|
|
(reduce-stack stack
|
|
|
|
(reduce-stack stack
|
|
|
|
(runtime-reduce-rhs-length action)
|
|
|
|
(runtime-reduce-rhs-length action)
|
|
|
@ -297,7 +291,6 @@
|
|
|
|
new-stack)
|
|
|
|
new-stack)
|
|
|
|
ip))]
|
|
|
|
ip))]
|
|
|
|
[(runtime-accept? action)
|
|
|
|
[(runtime-accept? action)
|
|
|
|
;; (printf "accept\n")
|
|
|
|
|
|
|
|
(stack-frame-value (car stack))]
|
|
|
|
(stack-frame-value (car stack))]
|
|
|
|
[else
|
|
|
|
[else
|
|
|
|
(if src-pos
|
|
|
|
(if src-pos
|
|
|
|