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

*** empty log message ***

Browse Source 
original commit: de0a1d7c61d0d21a75b134914b423e702ea2dcca
tokens
Scott Owens 23 years ago
parent f49e733504
commit e8c9c4d877
3 changed files with 38 additions and 23 deletions
Show Stats Download Patch File Download Diff File

2
collects/parser-tools/private-lex/token.ss
Unescape Escape View File

@ -5,7 +5,7 @@
(require-for-syntax "token-syntax.ss")
(provide define-tokens define-empty-tokens token-name token-value token?)
(provide define-tokens define-empty-tokens make-token token-name token-value token?)
(define-struct token (name value) (make-inspector))

56
collects/parser-tools/private-yacc/parser-builder.ss
Unescape Escape View File

@ -69,7 +69,7 @@
(if (> n 0)
,(if src-pos
`(reduce-stack (cddddr s) (sub1 n) `(,(cadr s) ,(caddr s) ,(cadddr s) ,@v))
`(reduce-stack (cddddr s) (sub1 n) (cons (cadr s) v)))
`(reduce-stack (cddr s) (sub1 n) (cons (cadr s) v)))
(values s v))))
(fix-error
(lambda (stack ip get-token)
@ -110,32 +110,42 @@
(remove-states))))
(find-action
(lambda (stack tok)
;; (display (if (token? tok) (token-name tok) tok))
;; (newline)
(lambda (stack tok ,@(if src-pos `(ip) `()))
(array2d-ref table
(car stack)
(hash-table-get term-sym->index
(if (token? tok)
(token-name tok)
tok)
err)))))
(token-name tok)
(lambda ()
,(if src-pos
`(err #t (token-name tok) (token-value tok) (cadr ip) (caddr ip))
`(err #t (token-name tok) (token-value tok)))))))))
(lambda (get-token)
(let parsing-loop ((stack (list 0))
(ip (get-token)))
;; (display stack)
;; (newline)
(let* ((tok ,(if src-pos `(car ip) `ip))
(action (find-action stack tok)))
;; (display (if (token? tok) (token-name tok) tok))
;; (newline)
(let* ((tok ,(if src-pos `(cond
((and (list? ip) (= 3 (length ip)))
(let ((tok (car ip)))
(cond
((symbol? tok) (make-token tok #f))
((token? tok) tok)
(else (raise-type-error 'parser
"(list (token or symbol) position position)"
0
ip)))))
(else
(raise-type-error 'parser
"(list (token or symbol) position position)"
0
ip)))
`(cond
((symbol? ip) (make-token ip #f))
((token? ip) ip)
(else (raise-type-error 'parser "token or symbol" 0 ip)))))
(action (find-action stack tok) ,@(if src-pos `(ip) `())))
(cond
((shift? action)
;; (printf "shift:~a~n" (shift-state action))
(let ((val (if (token? tok)
(token-value tok)
#f)))
(let ((val (token-value tok)))
(parsing-loop ,(if src-pos
``(,(shift-state action) ,val ,(cadr ip) ,(caddr ip) ,@stack)
``(,(shift-state action) ,val ,@stack))
@ -172,11 +182,15 @@
;; (printf "accept~n")
(cadr stack))
(else
(err ip)
(let ((new-stack (fix-error stack tok get-token)))
,(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 ip get-token)))
(if new-stack
(parsing-loop new-stack (get-token))
(void)))))))))))
(raise-read-error
"parser: Could not parse input"
#f #f #f #f #f)))))))))))
(datum->syntax-object
runtime
parser-code

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

@ -5,7 +5,8 @@
"private-yacc/yacc-helper.ss")
(require "private-yacc/parser-actions.ss"
"private-yacc/array2d.ss"
"private-lex/token.ss")
"private-lex/token.ss"
(lib "readerr.ss" "syntax"))
(provide parser)

Write Preview
Loading…
Cancel
Save