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

*** empty log message ***

Browse Source 
original commit: 5c5088e25177f4d087a86edf98568918e020e753
tokens
Scott Owens 23 years ago
parent bc38b81823
commit 036a5f5104
1 changed files with 21 additions and 15 deletions
Show Stats Download Patch File Download Diff File

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

@ -152,10 +152,12 @@
(define empty-stack (list (make-stack-frame 0 #f #f #f))) (define empty-stack (list (make-stack-frame 0 #f #f #f)))
(define (false-thunk) #f)
(define (parser-body err ends table term-sym->index actions src-pos) (define (parser-body err ends table term-sym->index actions src-pos)
(letrec ((input->token (letrec ((input->token
(lambda (ip) (if src-pos
(if src-pos (lambda (ip)
(cond (cond
((and (list? ip) (= 3 (length ip))) ((and (list? ip) (= 3 (length ip)))
(let ((tok (car ip))) (let ((tok (car ip)))
@ -170,7 +172,8 @@
(raise-type-error 'parser (raise-type-error 'parser
"(list (token or symbol) position position)" "(list (token or symbol) position position)"
0 0
ip))) ip))))
(lambda (ip)
(cond (cond
((symbol? ip) (make-token ip #f)) ((symbol? ip) (make-token ip #f))
((token? ip) ip) ((token? ip) ip)
@ -203,7 +206,7 @@
(remove-input))))))) (remove-input)))))))
(remove-states (remove-states
(lambda () (lambda ()
(let ((a (find-action stack (make-token 'error #f) #f))) (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))
@ -232,16 +235,19 @@
(find-action (find-action
(lambda (stack tok ip) (lambda (stack tok ip)
(array2d-ref table (let ((token-index (hash-table-get term-sym->index
(stack-frame-state (car stack)) (token-name tok)
(hash-table-get term-sym->index false-thunk)))
(token-name tok) (if token-index
(lambda () (array2d-ref table
(if src-pos (stack-frame-state (car stack))
(err #t (token-name tok) (token-value tok) (cadr ip) (caddr ip)) token-index)
(err #t (token-name tok) (token-value tok))) (begin
(raise-read-error (format "parser: got token of unknown type ~a" (token-name tok)) (if src-pos
#f #f #f #f #f))))))) (err #t (token-name tok) (token-value tok) (cadr ip) (caddr ip))
(err #t (token-name tok) (token-value tok)))
(raise-read-error (format "parser: got token of unknown type ~a" (token-name tok))
#f #f #f #f #f)))))))
(lambda (get-token) (lambda (get-token)
(let parsing-loop ((stack empty-stack) (let parsing-loop ((stack empty-stack)
(ip (get-token))) (ip (get-token)))

Write Preview
Loading…
Cancel
Save