mbutterick
/
br-parser-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

*** empty log message ***

Browse Source 
original commit: 2bb8faea6977540b956037dedd6773a717f6674d
tokens
Scott Owens 22 years ago
parent 485a7712a4
commit facf53edf8
2 changed files with 25 additions and 26 deletions
Show Stats Download Patch File Download Diff File

1
collects/parser-tools/private-yacc/input-file-parser.ss
Unescape Escape View File

@ -17,6 +17,7 @@
;; get-args: int * syntax-object list * syntax-object -> syntax-object list
(define (get-args i rhs act src-pos term-defs)
(let ((empty-table (make-hash-table)))
(hash-table-put! empty-table 'error #t)
(for-each (lambda (td)
(let ((v (syntax-local-value td)))
(if (e-terminals-def? v)

50
collects/parser-tools/yacc.ss
Unescape Escape View File

@ -177,7 +177,7 @@
(reduce-stack (cdr stack) (sub1 num) ret-vals src-pos)))
(else (values stack ret-vals))))
(define-struct stack-frame (state value start-pos end-pos))
(define-struct stack-frame (state value start-pos end-pos) (make-inspector))
(define empty-stack (list (make-stack-frame 0 #f #f #f)))
@ -214,26 +214,28 @@
(fix-error
(lambda (stack tok ip get-token)
(printf "stack: ~a~n" stack)
(letrec ((remove-input
(lambda ()
(if (memq (token-name tok) ends)
#f
(raise-read-error "parser: Cannot continue after error"
#f #f #f #f #f)
(let ((a (find-action stack tok ip)))
(cond
((shift? a)
;; (printf "shift:~a~n" (shift-state a))
(printf "shift:~a~n" (shift-state a))
(cons (if src-pos
(make-stack-frame (shift-state a)
(if (token? ip) (token-value ip) #f)
(token-value tok)
(cadr ip)
(caddr ip))
(make-stack-frame (shift-state a)
(if (token? ip) (token-value ip) #f)
(token-value tok)
#f
#f))
stack))
(else
;; (printf "discard input:~a~n" tok)
(printf "discard input:~a~n" tok)
(set! ip (get-token))
(set! tok (input->token ip))
(remove-input)))))))
@ -242,28 +244,29 @@
(let ((a (find-action stack (make-token 'error #f) ip)))
(cond
((shift? a)
;; (printf "shift:~a~n" (shift-state a))
(printf "shift:~a~n" (shift-state a))
(set! stack
(cons
(if src-pos
(make-stack-frame (shift-state a)
#f
(cadr ip)
(caddr ip))
(make-stack-frame (shift-state a)
#f
#f
#f))
(make-stack-frame (shift-state a)
#f
(cadr ip)
(caddr ip))
(make-stack-frame (shift-state a)
#f
#f
#f))
stack))
(remove-input))
(else
;; (printf "discard state:~a~n" (car stack))
(printf "discard state:~a~n" (car stack))
(cond
((< (length stack) 2)
(printf "Unable to shift error token~n")
#f)
(raise-read-error "parser: Cannot continue after error"
#f #f #f #f #f))
(else
(set! stack (cdr stack))))))))))
(set! stack (cdr stack))
(remove-states)))))))))
(remove-states))))
(find-action
@ -331,13 +334,8 @@
(if src-pos
(err #t (token-name tok) (token-value tok) (cadr ip) (caddr ip))
(err #t (token-name tok) (token-value tok)))
(let ((new-stack (fix-error stack tok ip get-token)))
(if new-stack
(parsing-loop new-stack (get-token))
(raise-read-error
"parser: Could not parse input"
#f #f #f #f #f))))))))))
(parsing-loop (fix-error stack tok ip get-token) (get-token)))))))))
)
Write Preview
Loading…
Cancel
Save