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

*** empty log message ***

Browse Source 
original commit: af83831fbdc425214e32cea86041dbe05e685bfe
tokens
Scott Owens 23 years ago
parent 53ac439c6a
commit 807265c2fc
2 changed files with 31 additions and 16 deletions
Show Stats Download Patch File Download Diff File

8
collects/parser-tools/lex.ss
Unescape Escape View File

@ -10,16 +10,16 @@
(lib "readerr.ss" "syntax") (lib "readerr.ss" "syntax")
"private-lex/token.ss") "private-lex/token.ss")
(provide lexer lexer-src-loc define-lex-abbrev define-lex-abbrevs (provide lexer lexer-src-pos define-lex-abbrev define-lex-abbrevs
make-lex-buf make-lex-buf
get-position position-offset position-line position-col position? get-position position-offset position-line position-col position?
define-tokens define-empty-tokens) define-tokens define-empty-tokens)
(define-syntaxes (lexer lexer-src-loc) (define-syntaxes (lexer lexer-src-pos)
(values (values
(build-lexer #'here `(lambda (x) x)) (build-lexer #'here '(lambda (x) x))
(build-lexer #'here `(lambda (x) (list x first-pos end-pos))))) (build-lexer #'here '(lambda (x) (list x first-pos end-pos)))))
(define-syntax (define-lex-abbrev stx) (define-syntax (define-lex-abbrev stx)

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

@ -68,8 +68,8 @@
(lambda (s n v) (lambda (s n v)
(if (> n 0) (if (> n 0)
,(if src-pos ,(if src-pos
`(reduce-stack (cddr s) (sub1 n) `(,(cadr s) ,(caddr s) ,(cadddr s) ,@v)) `(reduce-stack (cddddr s) (sub1 n) `(,(cadr s) ,(caddr s) ,(cadddr s) ,@v))
`(reduce-stack (cddr s) (sub1 n) (cons (cadr s) v))) `(reduce-stack (cddddr s) (sub1 n) (cons (cadr s) v)))
(values s v)))) (values s v))))
(fix-error (fix-error
(lambda (stack ip get-token) (lambda (stack ip get-token)
@ -111,6 +111,8 @@
(find-action (find-action
(lambda (stack tok) (lambda (stack tok)
;; (display (if (token? tok) (token-name tok) tok))
;; (newline)
(array2d-ref table (array2d-ref table
(car stack) (car stack)
(hash-table-get term-sym->index (hash-table-get term-sym->index
@ -122,12 +124,12 @@
(let parsing-loop ((stack (list 0)) (let parsing-loop ((stack (list 0))
(ip (get-token))) (ip (get-token)))
;;(display stack) ;; (display stack)
;;(newline) ;; (newline)
;;(display (if (token? ip) (token-name ip) ip))
;;(newline)
(let* ((tok ,(if src-pos `(car ip) `ip)) (let* ((tok ,(if src-pos `(car ip) `ip))
(action (find-action stack tok))) (action (find-action stack tok)))
;; (display (if (token? tok) (token-name tok) tok))
;; (newline)
(cond (cond
((shift? action) ((shift? action)
;; (printf "shift:~a~n" (shift-state action)) ;; (printf "shift:~a~n" (shift-state action))
@ -146,12 +148,25 @@
null))) null)))
(let* ((A (reduce-lhs-num action)) (let* ((A (reduce-lhs-num action))
(goto (array2d-ref table (car new-stack) A))) (goto (array2d-ref table (car new-stack) A)))
(parsing-loop (cons goto (parsing-loop ,(if src-pos
(cons (apply ``(,goto
,(apply
(vector-ref actions
(reduce-prod-num action))
args)
,(if (null? args)
(caddr new-stack)
(cadr args))
,(if (null? args)
(caddr new-stack)
(list-ref args (- (* (reduce-rhs-length action) 3) 1)))
,@new-stack)
``(,goto
,(apply
(vector-ref actions (vector-ref actions
(reduce-prod-num action)) (reduce-prod-num action))
args) args)
new-stack)) ,@new-stack))
ip)))) ip))))
((accept? action) ((accept? action)
;; (printf "accept~n") ;; (printf "accept~n")

Write Preview
Loading…
Cancel
Save