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

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