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

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

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

Write Preview
Loading…
Cancel
Save