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

i

Browse Source 
original commit: 5564d30b2666489fc516a7791e488d537e6287fd
tokens
Scott Owens 22 years ago
parent 0a5d3bd5f1
commit 01364cc5f3
4 changed files with 270 additions and 257 deletions
Show Stats Download Patch File Download Diff File

90
collects/parser-tools/private-yacc/grammar.ss
Unescape Escape View File

@ -1,7 +1,9 @@
#cs #cs
(module grammar mzscheme (module grammar mzscheme
(require (lib "class.ss")) (require (lib "class.ss")
(lib "list.ss")
"yacc-helper.ss")
;; Constructs to create and access grammars, the internal ;; Constructs to create and access grammars, the internal
;; representation of the input to the parser generator. ;; representation of the input to the parser generator.
@ -148,16 +150,46 @@
;; where the nth element in the outermost list is the list of productions with the nth non-term as lhs ;; where the nth element in the outermost list is the list of productions with the nth non-term as lhs
(init prods) (init prods)
;; nullable-non-terms is indexed by the non-term-index and is true iff non-term is nullable ;; nullable-non-terms is indexed by the non-term-index and is true iff non-term is nullable
(init-field terms non-terms nullable-non-terms end-terms) (init-field terms non-terms end-terms)
;; indexed by the index of the non-term - contains the list of productions for that non-term
(define nt->prods (list->vector prods))
;; list of all productions ;; list of all productions
(define all-prods (apply append prods)) (define all-prods (apply append prods))
(define num-prods (length all-prods)) (define num-prods (length all-prods))
(define num-terms (length terms)) (define num-terms (length terms))
(define num-non-terms (length non-terms)) (define num-non-terms (length non-terms))
(let ((count 0))
(for-each
(lambda (nt)
(set-non-term-index! nt count)
(set! count (add1 count)))
non-terms))
(let ((count 0))
(for-each
(lambda (t)
(set-term-index! t count)
(set! count (add1 count)))
terms))
(let ((count 0))
(for-each
(lambda (prod)
(set-prod-index! prod count)
(set! count (add1 count)))
all-prods))
;; indexed by the index of the non-term - contains the list of productions for that non-term
(define nt->prods
(let ((v (make-vector (length prods) #f)))
(for-each (lambda (prods)
(vector-set! v (non-term-index (prod-lhs (car prods))) prods))
prods)
v))
(define nullable-non-terms
(nullable all-prods num-non-terms))
(define/public (get-num-terms) num-terms) (define/public (get-num-terms) num-terms)
(define/public (get-num-non-terms) num-non-terms) (define/public (get-num-non-terms) num-non-terms)
@ -193,8 +225,56 @@
(define/public (nullable-after-dot?-thunk) (define/public (nullable-after-dot?-thunk)
(lambda (item) (lambda (item)
(nullable-after-dot? item))))) (nullable-after-dot? item)))))
;; nullable: production list * int -> non-term set
;; determines which non-terminals can derive epsilon
(define (nullable prods num-nts)
(letrec ((nullable (make-vector num-nts #f))
(added #f)
;; possible-nullable: producion list -> production list
;; Removes all productions that have a terminal
(possible-nullable
(lambda (prods)
(filter (lambda (prod)
(vector-andmap non-term? (prod-rhs prod)))
prods)))
;; set-nullables: production list -> production list
;; makes one pass through the productions, adding the ones
;; known to be nullable now to nullable and returning a list
;; of productions that we don't know about yet.
(set-nullables
(lambda (prods)
(cond
((null? prods) null)
((vector-ref nullable
(gram-sym-index (prod-lhs (car prods))))
(set-nullables (cdr prods)))
((vector-andmap (lambda (nt)
(vector-ref nullable (gram-sym-index nt)))
(prod-rhs (car prods)))
(vector-set! nullable
(gram-sym-index (prod-lhs (car prods)))
#t)
(set! added #t)
(set-nullables (cdr prods)))
(else
(cons (car prods)
(set-nullables (cdr prods))))))))
(let loop ((P (possible-nullable prods)))
(cond
((null? P) nullable)
(else
(set! added #f)
(let ((new-P (set-nullables P)))
(if added
(loop new-P)
nullable)))))))
;; ------------------------ Productions --------------------------- ;; ------------------------ Productions ---------------------------
;; production = (make-prod non-term (gram-sym vector) int prec syntax-object) ;; production = (make-prod non-term (gram-sym vector) int prec syntax-object)

166
collects/parser-tools/private-yacc/input-file-parser.ss
Unescape Escape View File

@ -7,10 +7,13 @@
(require "yacc-helper.ss" (require "yacc-helper.ss"
"../private-lex/token-syntax.ss" "../private-lex/token-syntax.ss"
"grammar.ss" "grammar.ss"
(lib "list.ss") (lib "class.ss")
(lib "class.ss")) (lib "contracts.ss"))
(provide parse-input get-term-list) (provide/contract
(parse-input ((listof syntax?) (listof syntax?) syntax? (or/f false? syntax?) syntax? syntax? any? . -> . (is-a?/c grammar%)))
(get-term-list (syntax? . -> . (listof syntax?))))
(define stx-for-original-property (read-syntax #f (open-input-string "original"))) (define stx-for-original-property (read-syntax #f (open-input-string "original")))
@ -44,54 +47,6 @@
`(,(datum->syntax-object act name b stx-for-original-property) `(,(datum->syntax-object act name b stx-for-original-property)
,@(get-args (add1 i) (cdr rhs))))))))))) ,@(get-args (add1 i) (cdr rhs)))))))))))
;; nullable: production list * int -> non-term set
;; determines which non-terminals can derive epsilon
(define (nullable prods num-nts)
(letrec ((nullable (make-vector num-nts #f))
(added #f)
;; possible-nullable: producion list -> production list
;; Removes all productions that have a terminal
(possible-nullable
(lambda (prods)
(filter (lambda (prod)
(vector-andmap non-term? (prod-rhs prod)))
prods)))
;; set-nullables: production list -> production list
;; makes one pass through the productions, adding the ones
;; known to be nullable now to nullable and returning a list
;; of productions that we don't know about yet.
(set-nullables
(lambda (prods)
(cond
((null? prods) null)
((vector-ref nullable
(gram-sym-index (prod-lhs (car prods))))
(set-nullables (cdr prods)))
((vector-andmap (lambda (nt)
(vector-ref nullable (gram-sym-index nt)))
(prod-rhs (car prods)))
(vector-set! nullable
(gram-sym-index (prod-lhs (car prods)))
#t)
(set! added #t)
(set-nullables (cdr prods)))
(else
(cons (car prods)
(set-nullables (cdr prods))))))))
(let loop ((P (possible-nullable prods)))
(cond
((null? P) nullable)
(else
(set! added #f)
(let ((new-P (set-nullables P)))
(if added
(loop new-P)
nullable)))))))
;; Given the list of terminal symbols and the precedence/associativity definitions, ;; Given the list of terminal symbols and the precedence/associativity definitions,
;; builds terminal structures (See grammar.ss) ;; builds terminal structures (See grammar.ss)
;; build-terms: symbol list * symbol list list -> term list ;; build-terms: symbol list * symbol list list -> term list
@ -115,16 +70,12 @@
(set! counter (add1 counter)))) (set! counter (add1 counter))))
precs) precs)
(set! counter 0)
;; Build the terminal structures ;; Build the terminal structures
(map (map
(lambda (term-sym) (lambda (term-sym)
(begin0 (make-term term-sym
(make-term term-sym #f
counter (hash-table-get prec-table term-sym (lambda () #f))))
(hash-table-get prec-table term-sym (lambda () #f)))
(set! counter (add1 counter))))
term-list))) term-list)))
;; Retrieves the terminal symbols from a terminals-def (See terminal-syntax.ss) ;; Retrieves the terminal symbols from a terminals-def (See terminal-syntax.ss)
@ -158,12 +109,9 @@
"Token declaration must be (tokens symbol ...)" "Token declaration must be (tokens symbol ...)"
so)))) so))))
;; parse-input: syntax-object * syntax-object list * syntax-object^4 * boolean-> grammar
(define (parse-input start ends term-defs prec-decls prods runtime src-pos) (define (parse-input start ends term-defs prec-decls prods runtime src-pos)
(let* ((counter 0) (let* ((start-syms (map syntax-object->datum start))
(start-sym (syntax-object->datum start))
(list-of-terms (map syntax-object->datum (get-term-list term-defs))) (list-of-terms (map syntax-object->datum (get-term-list term-defs)))
(end-terms (end-terms
@ -177,7 +125,7 @@
end) end)
(syntax-object->datum end))) (syntax-object->datum end)))
ends)) ends))
;; Get the list of terminals out of input-terms ;; Get the list of terminals out of input-terms
(list-of-non-terms (list-of-non-terms
@ -263,13 +211,8 @@
(terms (build-terms list-of-terms precs)) (terms (build-terms list-of-terms precs))
(non-terms (begin (non-terms (map (lambda (non-term) (make-non-term non-term #f))
(set! counter 2) list-of-non-terms))
(map (lambda (non-term)
(begin0
(make-non-term non-term counter)
(set! counter (add1 counter))))
list-of-non-terms)))
(term-table (make-hash-table)) (term-table (make-hash-table))
(non-term-table (make-hash-table))) (non-term-table (make-hash-table)))
@ -337,11 +280,10 @@
(eq? (syntax-object->datum a) (syntax-object->datum b))) (eq? (syntax-object->datum a) (syntax-object->datum b)))
((prod-rhs action) ((prod-rhs action)
(let ((p (parse-prod (syntax prod-rhs)))) (let ((p (parse-prod (syntax prod-rhs))))
(set! counter (add1 counter))
(make-prod (make-prod
nt nt
p p
counter #f
(let loop ((i (sub1 (vector-length p)))) (let loop ((i (sub1 (vector-length p))))
(if (>= i 0) (if (>= i 0)
(let ((gs (vector-ref p i))) (let ((gs (vector-ref p i)))
@ -353,11 +295,10 @@
((prod-rhs (prec term) action) ((prod-rhs (prec term) action)
(identifier? (syntax term)) (identifier? (syntax term))
(let ((p (parse-prod (syntax prod-rhs)))) (let ((p (parse-prod (syntax prod-rhs))))
(set! counter (add1 counter))
(make-prod (make-prod
nt nt
p p
counter #f
(term-prec (term-prec
(hash-table-get (hash-table-get
term-table term-table
@ -382,9 +323,8 @@
(syntax-case prods-so () (syntax-case prods-so ()
((nt productions ...) ((nt productions ...)
(> (length (syntax->list (syntax (productions ...)))) 0) (> (length (syntax->list (syntax (productions ...)))) 0)
(let ((nt (hash-table-get (let ((nt (hash-table-get non-term-table
non-term-table (syntax-object->datum (syntax nt)))))
(syntax-object->datum (syntax nt)))))
(map (lambda (p) (parse-prod+action nt p)) (map (lambda (p) (parse-prod+action nt p))
(syntax->list (syntax (productions ...)))))) (syntax->list (syntax (productions ...))))))
(_ (_
@ -393,55 +333,43 @@
"A production for a non-terminal must be (non-term right-hand-side ...) with at least 1 right hand side" "A production for a non-terminal must be (non-term right-hand-side ...) with at least 1 right hand side"
prods-so)))))) prods-so))))))
(if (not (memq start-sym list-of-non-terms)) (for-each
(raise-syntax-error (lambda (sstx ssym)
'parser-start (unless (memq ssym list-of-non-terms)
(format "Start symbol ~a not defined as a non-terminal" (raise-syntax-error
start-sym) 'parser-start
start)) (format "Start symbol ~a not defined as a non-terminal" ssym)
sstx)))
start start-syms)
(set! counter (length end-terms)) (let* ((starts (map (lambda (x) (make-non-term (gensym) #f)) start-syms))
(let* ((start (make-non-term (gensym) 0)) (end-non-terms (map (lambda (x) (make-non-term (gensym) #f)) start-syms))
(end-non-term (make-non-term (gensym) 1))
(parsed-prods (map parse-prods-for-nt (cdr (syntax->list prods)))) (parsed-prods (map parse-prods-for-nt (cdr (syntax->list prods))))
(counter2 0)
(prods (prods
`((,(make-prod start (vector end-non-term) 0 #f #f)) `(,@(map (lambda (start end-non-term)
,(map (list (make-prod start (vector end-non-term) #f #f #f)))
(lambda (end) starts end-non-terms)
(set! counter2 (add1 counter2)) ,@(map
(make-prod end-non-term (lambda (end-nt start-sym)
(vector (map
(hash-table-get non-term-table start-sym) (lambda (end)
(hash-table-get term-table end)) (make-prod end-nt
counter2 (vector
#f (hash-table-get non-term-table start-sym)
(datum->syntax-object (hash-table-get term-table end))
runtime #f
`(lambda (x) x)))) #f
end-terms) (datum->syntax-object
,@parsed-prods)) runtime
(nulls (nullable (apply append prods) `(lambda (x) x))))
(+ 2 (length non-terms))))) end-terms))
end-non-terms start-syms)
,@parsed-prods)))
;; (printf "nullable: {~a}~n~n"
;; (apply string-append
;; (let loop ((i 0))
;; (cond
;; ((>= i (vector-length nulls)) null)
;; ((vector-ref nulls i)
;; (cons
;; (format "~a "
;; (gram-sym-symbol
;; (list-ref (cons start (cons end-non-term non-terms)) i)))
;; (loop (add1 i))))
;; (else (loop (add1 i)))))))
(make-object grammar% (make-object grammar%
prods prods
terms terms
(cons start (cons end-non-term non-terms)) (append starts (append end-non-terms non-terms))
nulls
(map (lambda (term-name) (map (lambda (term-name)
(hash-table-get term-table term-name)) (hash-table-get term-table term-name))
end-terms))))))) end-terms)))))))

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

@ -4,9 +4,12 @@
(require "input-file-parser.ss" (require "input-file-parser.ss"
"grammar.ss" "grammar.ss"
"table.ss" "table.ss"
(lib "class.ss")) (lib "class.ss")
(lib "contracts.ss"))
(provide build-parser) (provide/contract
(build-parser ((string? any? any? syntax? (listof syntax?) (listof syntax?)
(or/f syntax? false?) syntax? syntax?) . ->* . (any? any? any? any?))))
(define (strip so) (define (strip so)
(syntax-local-introduce (syntax-local-introduce
@ -20,14 +23,14 @@
(syntax-case prods () (syntax-case prods ()
((_ (bind ((bound ...) x ...) ...) ...) ((_ (bind ((bound ...) x ...) ...) ...)
(let ((binds (syntax->list (syntax (bind ...)))) (let ((binds (syntax->list (syntax (bind ...))))
(bounds (cons start (bounds (append start
(apply (apply
append append
(map syntax->list (map syntax->list
(apply (apply
append append
(map syntax->list (map syntax->list
(syntax->list (syntax (((bound ...) ...) ...))))))))) (syntax->list (syntax (((bound ...) ...) ...)))))))))
(terms (get-term-list terms)) (terms (get-term-list terms))
(precs (if precs (precs (if precs
(syntax-case precs () (syntax-case precs ()

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

@ -53,42 +53,43 @@
(if tokens (if tokens
(raise-syntax-error #f "Multiple tokens declarations" stx) (raise-syntax-error #f "Multiple tokens declarations" stx)
(set! tokens arg))) (set! tokens arg)))
((start symbol) ((start symbol ...)
(cond (let ((symbols (syntax->list (syntax (symbol ...)))))
((not (identifier? (syntax symbol))) (for-each
(raise-syntax-error (lambda (sym)
'parser-start (unless (identifier? sym)
"Start non-terminal must be a symbol" (raise-syntax-error 'parser-start
(syntax symbol))) "Start symbol must be a symbol"
(start sym)))
(raise-syntax-error #f "Multiple start declarations" stx)) symbols)
(else (when start
(set! start (syntax symbol))))) (raise-syntax-error #f "Multiple start declarations" stx))
(when (null? symbols)
(raise-syntax-error 'parser-start
"Missing start symbol"
stx))
(set! start symbols)))
((end symbols ...) ((end symbols ...)
(begin (let ((symbols (syntax->list (syntax (symbols ...)))))
(for-each (for-each
(lambda (sym) (lambda (sym)
(if (not (identifier? sym)) (unless (identifier? sym)
(raise-syntax-error (raise-syntax-error 'parser-end
'parser-end "End token must be a symbol"
"End token must be a symbol" sym)))
sym))) symbols)
(syntax->list (syntax (symbols ...)))) (let ((d (duplicate-list? (map syntax-object->datum symbols))))
(let ((d (duplicate-list? (syntax-object->datum (when d
(syntax (symbols ...)))))) (raise-syntax-error 'parser-end
(if d (format "Duplicate end token definition for ~a" d)
(raise-syntax-error arg))
'parser-end (when (null? symbols)
(format "Duplicate end token definition for ~a" d) (raise-syntax-error 'parser-end
arg))) "end declaration must contain at least 1 token"
(if (= 0 (length (syntax->list (syntax (symbols ...))))) arg))
(raise-syntax-error (when end
'parser-end
"end declaration must contain at least 1 token"
arg))
(if end
(raise-syntax-error #f "Multiple end declarations" stx)) (raise-syntax-error #f "Multiple end declarations" stx))
(set! end (syntax->list (syntax (symbols ...)))))) (set! end symbols))))
((precs decls ...) ((precs decls ...)
(if precs (if precs
(raise-syntax-error #f "Multiple precs declarations" stx) (raise-syntax-error #f "Multiple precs declarations" stx)
@ -100,26 +101,25 @@
((yacc-output filename) ((yacc-output filename)
(cond (cond
((not (string? (syntax-object->datum (syntax filename)))) ((not (string? (syntax-object->datum (syntax filename))))
(raise-syntax-error (raise-syntax-error 'parser-yacc-output
'parser-yacc-output "Yacc-output filename must be a string"
"Yacc-output filename must be a string" (syntax filename)))
(syntax filename)))
(yacc-output (yacc-output
(raise-syntax-error #f "Multiple yacc-output declarations" stx)) (raise-syntax-error #f "Multiple yacc-output declarations" stx))
(else (else
(set! yacc-output (syntax-object->datum (syntax filename)))))) (set! yacc-output (syntax-object->datum (syntax filename))))))
(_ (raise-syntax-error 'parser-args "argument must match (debug filename), (error expression), (tokens def ...), (start non-term), (end tokens ...), (precs decls ...), or (grammar prods ...)" arg)))) (_ (raise-syntax-error 'parser-args "argument must match (debug filename), (error expression), (tokens def ...), (start non-term), (end tokens ...), (precs decls ...), or (grammar prods ...)" arg))))
(syntax->list (syntax (args ...)))) (syntax->list (syntax (args ...))))
(if (not tokens) (unless tokens
(raise-syntax-error #f "missing tokens declaration" stx)) (raise-syntax-error #f "missing tokens declaration" stx))
(if (not error) (unless error
(raise-syntax-error #f "missing error declaration" stx)) (raise-syntax-error #f "missing error declaration" stx))
(if (not grammar) (unless grammar
(raise-syntax-error #f "missing grammar declaration" stx)) (raise-syntax-error #f "missing grammar declaration" stx))
(if (not end) (unless end
(raise-syntax-error #f "missing end declaration" stx)) (raise-syntax-error #f "missing end declaration" stx))
(if (not start) (unless start
(raise-syntax-error #f "missing start declaration" stx)) (raise-syntax-error #f "missing start declaration" stx))
(let-values (((table term-sym->index actions check-syntax-fix) (let-values (((table term-sym->index actions check-syntax-fix)
(build-parser (if debug debug "") (build-parser (if debug debug "")
src-pos src-pos
@ -130,23 +130,23 @@
precs precs
grammar grammar
stx))) stx)))
(if (and yacc-output (not (string=? yacc-output ""))) (when (and yacc-output (not (string=? yacc-output "")))
(with-handlers [(exn:i/o:filesystem? (with-handlers [(exn:i/o:filesystem?
(lambda (e) (lambda (e)
(fprintf (fprintf
(current-error-port) (current-error-port)
"Cannot write yacc-output to file \"~a\". ~a~n" "Cannot write yacc-output to file \"~a\". ~a~n"
(exn:i/o:filesystem-pathname e) (exn:i/o:filesystem-pathname e)
(exn:i/o:filesystem-detail e))))] (exn:i/o:filesystem-detail e))))]
(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-object->datum grammar)
tokens tokens
(syntax-object->datum start) (syntax-object->datum start)
(if precs (if precs
(syntax-object->datum precs) (syntax-object->datum precs)
#f) #f)
port))))) port)))))
(with-syntax ((check-syntax-fix check-syntax-fix) (with-syntax ((check-syntax-fix check-syntax-fix)
(err error) (err error)
(ends end) (ends end)
@ -160,10 +160,9 @@
check-syntax-fix check-syntax-fix
(parser-body debug err (quote ends) table term-sym->index actions src-pos))))))) (parser-body debug err (quote ends) table term-sym->index actions src-pos)))))))
(_ (_
(raise-syntax-error (raise-syntax-error #f
#f "parser must have the form (parser args ...)"
"parser must have the form (parser args ...)" stx))))
stx))))
(define (reduce-stack stack num ret-vals src-pos) (define (reduce-stack stack num ret-vals src-pos)
(cond (cond
@ -181,7 +180,7 @@
(define-struct stack-frame (state value start-pos end-pos) (make-inspector)) (define-struct stack-frame (state value start-pos end-pos) (make-inspector))
(define empty-stack (list (make-stack-frame 0 #f #f #f))) (define (make-empty-stack i) (list (make-stack-frame i #f #f #f)))
(define (false-thunk) #f) (define (false-thunk) #f)
@ -285,59 +284,62 @@
(err #f (token-name tok) (token-value tok) (cadr ip) (caddr ip)) (err #f (token-name tok) (token-value tok) (cadr ip) (caddr ip))
(err #f (token-name tok) (token-value tok))) (err #f (token-name tok) (token-value tok)))
(raise-read-error (format "parser: got token of unknown type ~a" (token-name tok)) (raise-read-error (format "parser: got token of unknown type ~a" (token-name tok))
#f #f #f #f #f))))))) #f #f #f #f #f))))))
(lambda (get-token) (make-parser
(let parsing-loop ((stack empty-stack) (lambda (start-number)
(ip (get-token))) (lambda (get-token)
(let* ((tok (input->token ip)) (let parsing-loop ((stack (make-empty-stack start-number))
(action (find-action stack tok ip))) (ip (get-token)))
(cond (let* ((tok (input->token ip))
((shift? action) (action (find-action stack tok ip)))
;; (printf "shift:~a~n" (shift-state action)) (cond
(let ((val (token-value tok))) ((shift? action)
(parsing-loop (cons (if src-pos ;; (printf "shift:~a~n" (shift-state action))
(make-stack-frame (shift-state action) (let ((val (token-value tok)))
val (parsing-loop (cons (if src-pos
(cadr ip) (make-stack-frame (shift-state action)
(caddr ip)) val
(make-stack-frame (shift-state action) (cadr ip)
val (caddr ip))
#f (make-stack-frame (shift-state action)
#f)) val
stack) #f
(get-token)))) #f))
((reduce? action) stack)
;; (printf "reduce:~a~n" (reduce-prod-num action)) (get-token))))
(let-values (((new-stack args) ((reduce? action)
(reduce-stack stack ;; (printf "reduce:~a~n" (reduce-prod-num action))
(reduce-rhs-length action) (let-values (((new-stack args)
null (reduce-stack stack
src-pos))) (reduce-rhs-length action)
(let* ((A (reduce-lhs-num action)) null
(goto (array2d-ref table (stack-frame-state (car new-stack)) A))) src-pos)))
(parsing-loop (cons (let* ((A (reduce-lhs-num action))
(if src-pos (goto (array2d-ref table (stack-frame-state (car new-stack)) A)))
(make-stack-frame goto (parsing-loop
(apply (vector-ref actions (reduce-prod-num action)) args) (cons
(if (null? args) (cadr ip) (cadr args)) (if src-pos
(if (null? args) (make-stack-frame
(caddr ip) goto
(list-ref args (- (* (reduce-rhs-length action) 3) 1)))) (apply (vector-ref actions (reduce-prod-num action)) args)
(make-stack-frame goto (if (null? args) (cadr ip) (cadr args))
(apply (vector-ref actions (reduce-prod-num action)) args) (if (null? args)
#f (caddr ip)
#f)) (list-ref args (- (* (reduce-rhs-length action) 3) 1))))
new-stack) (make-stack-frame
ip)))) goto
((accept? action) (apply (vector-ref actions (reduce-prod-num action)) args)
;; (printf "accept~n") #f
(stack-frame-value (car stack))) #f))
(else new-stack)
(if src-pos ip))))
(err #t (token-name tok) (token-value tok) (cadr ip) (caddr ip)) ((accept? action)
(err #t (token-name tok) (token-value tok))) ;; (printf "accept~n")
(parsing-loop (fix-error stack tok ip get-token) (get-token))))))))) (stack-frame-value (car stack)))
(else
(if src-pos
(err #t (token-name tok) (token-value tok) (cadr ip) (caddr ip))
(err #t (token-name tok) (token-value tok)))
(parsing-loop (fix-error stack tok ip get-token) (get-token))))))))))
(make-parser 0)))
) )
Write Preview
Loading…
Cancel
Save