suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

moved to scheme/base language and has it overwrite the output file, if it exists

Browse Source 
svn: r14114
This commit is contained in:
Robby Findler 2009-03-15 23:01:54 +00:00
parent ed566b2f7d
commit cf791ead47
1 changed files with 24 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/parser-tools/yacc.ss
View File

@ -1,9 +1,10 @@
(module yacc mzscheme #lang scheme/base
(require-for-syntax "private-yacc/parser-builder.ss" (require (for-syntax scheme/base
"private-yacc/grammar.ss" "private-yacc/parser-builder.ss"
"private-yacc/yacc-helper.ss" "private-yacc/grammar.ss"
"private-yacc/parser-actions.ss") "private-yacc/yacc-helper.ss"
"private-yacc/parser-actions.ss"))
(require "private-lex/token.ss" (require "private-lex/token.ss"
"private-yacc/parser-actions.ss" "private-yacc/parser-actions.ss"
mzlib/etc mzlib/etc
@ -19,12 +20,12 @@
(list->vector (list->vector
(map (map
(lambda (state-entry) (lambda (state-entry)
(let ((ht (make-hash-table))) (let ((ht (make-hasheq)))
(for-each (for-each
(lambda (gs/action) (lambda (gs/action)
(hash-table-put! ht (hash-set! ht
(gram-sym-symbol (car gs/action)) (gram-sym-symbol (car gs/action))
(action->runtime-action (cdr gs/action)))) (action->runtime-action (cdr gs/action))))
state-entry) state-entry)
ht)) ht))
(vector->list table)))) (vector->list table))))
@ -177,13 +178,14 @@
yacc-output)))] yacc-output)))]
(call-with-output-file yacc-output (call-with-output-file yacc-output
(lambda (port) (lambda (port)
(display-yacc (syntax-object->datum grammar) (display-yacc (syntax->datum grammar)
tokens tokens
(map syntax-object->datum start) (map syntax->datum start)
(if precs (if precs
(syntax-object->datum precs) (syntax->datum precs)
#f) #f)
port))))) port))
#:exists 'truncate)))
(with-syntax ((check-syntax-fix check-syntax-fix) (with-syntax ((check-syntax-fix check-syntax-fix)
(err error) (err error)
(ends end) (ends end)
@ -245,7 +247,7 @@
(define (extract-no-src-pos ip) (define (extract-no-src-pos ip)
(extract-helper ip #f #f)) (extract-helper ip #f #f))
(define-struct stack-frame (state value start-pos end-pos) (make-inspector)) (define-struct stack-frame (state value start-pos end-pos) #:inspector (make-inspector))
(define (make-empty-stack i) (list (make-stack-frame i #f #f #f))) (define (make-empty-stack i) (list (make-stack-frame i #f #f #f)))
@ -304,17 +306,17 @@
(remove-states))))))))) (remove-states)))))))))
(define (find-action stack tok val start-pos end-pos) (define (find-action stack tok val start-pos end-pos)
(unless (hash-table-get all-term-syms (unless (hash-ref all-term-syms
tok tok
(lambda () #f)) #f)
(if src-pos (if src-pos
(err #f tok val start-pos end-pos) (err #f tok val start-pos end-pos)
(err #f tok val)) (err #f tok val))
(raise-read-error (format "parser: got token of unknown type ~a" tok) (raise-read-error (format "parser: got token of unknown type ~a" tok)
#f #f #f #f #f)) #f #f #f #f #f))
(hash-table-get (vector-ref table (stack-frame-state (car stack))) (hash-ref (vector-ref table (stack-frame-state (car stack)))
tok tok
(lambda () #f))) #f))
(define (make-parser start-number) (define (make-parser start-number)
(lambda (get-token) (lambda (get-token)
@ -341,7 +343,7 @@
src-pos))) src-pos)))
(let ((goto (let ((goto
(runtime-goto-state (runtime-goto-state
(hash-table-get (hash-ref
(vector-ref table (stack-frame-state (car new-stack))) (vector-ref table (stack-frame-state (car new-stack)))
(runtime-reduce-lhs action))))) (runtime-reduce-lhs action)))))
(parsing-loop (parsing-loop
@ -378,4 +380,3 @@
(cond (cond
((null? l) null) ((null? l) null)
(else (cons (make-parser i) (loop (cdr l) (add1 i)))))))))) (else (cons (make-parser i) (loop (cdr l) (add1 i))))))))))
)