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

Corrections to parsing errors

Browse Source 
svn: r6951
This commit is contained in:
Kathy Gray 2007-07-23 14:31:27 +00:00
parent 6641a81ff2
commit b0ac0c7c87
2 changed files with 58 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
collects/combinator-parser/private-combinator/combinator.scm
View File

@ -53,33 +53,44 @@
(opt-lambda (input [last-src (list 0 0 0 0)] [alts 1]) (opt-lambda (input [last-src (list 0 0 0 0)] [alts 1])
#;(!!! (printf "terminal ~a~n" name)) #;(!!! (printf "terminal ~a~n" name))
#;(!!! (printf "input ~a~n" (cons? input)))
#;(!!! (if (eq? input return-name)
(printf "dummy given~n")
(let ([token (!!! ((!!! position-token-token) (!!! (car input))))])
(!!! (printf "Look at token ~a~n" token))
(!!! (printf "calling token-name: ~a~n" ((!!! token-name) token)))
(!!! (printf "calling pred: ~a~n" (pred token)))
(!!! (printf "called pred~n"))
(!!! (printf "car of input ~a~n" (position-token-token (car input)))))))
(cond (cond
[(eq? input return-name) name] [(eq? input return-name) name]
[(null? input) [(null? input)
(fail-res null (make-terminal-fail rank-end last-src name 0 0 'end #f))] (fail-res null (make-terminal-fail rank-end last-src name 0 0 'end #f))]
[(pred (if src? (position-token-token (car input)) (car input)))
(make-res (list (builder (car input))) (cdr input)
name (value (car input)) 1 #f (car input))]
[else [else
#;(printf "Incorrect input for ~a : ~a miscase? ~a misspell? ~a ~n" name (let* ([curr-input (car input)]
(cond [token (position-token-token curr-input)])
[(and (position-token? (car input)) (cond
(token-value (position-token-token (car input)))) [(pred token)
(token-value (position-token-token (car input)))] (make-res (list (builder curr-input)) (cdr input) name
[(position-token? (car input)) (value curr-input) 1 #f curr-input)]
(token-name (position-token-token (car input)))] [else
[else (car input)]) #;(!!! (printf "Incorrect input for ~a : ~a miscase? ~a misspell? ~a ~n" name
(case? (car input)) (cond
(spell? (car input))) [(token-value token)
(fail-res (cdr input) (token-value token)]
(let-values ([(chance kind may-use) [else (token-name token)])
(cond (case? curr-input)
[(case? (car input)) (values rank-caps 'misscase 1)] (spell? curr-input)))
[(> (spell? (car input)) 3/5) (fail-res (cdr input)
(values (* rank-misspell (spell? (car input))) 'misspell 1)] (let-values ([(chance kind may-use)
[(class? (car input)) (values rank-class 'missclass 1)] (cond
[else (values rank-wrong 'wrong 0)])]) [(case? curr-input) (values rank-caps 'misscase 1)]
(make-fail chance name kind (car input) may-use)))]))))) [(> (spell? curr-input) 3/5)
(values (* rank-misspell
(spell? curr-input)) 'misspell 1)]
[(class? curr-input) (values rank-class 'missclass 1)]
[else (values rank-wrong 'wrong 0)])])
(make-fail chance name kind curr-input may-use)))]))])))))
;seq: ( (list ((list 'a) -> res)) ((list 'b) -> 'c) string -> ((list 'a) -> result) ;seq: ( (list ((list 'a) -> res)) ((list 'b) -> 'c) string -> ((list 'a) -> result)
(define seq (define seq
@ -103,7 +114,8 @@
name (res-id (repeat-res-a r)) name (res-id (repeat-res-a r))
(res-used (repeat-res-a r)) (res-used (repeat-res-a r))
(repeat-res-stop r) (repeat-res-stop r)
(res-first-tok (repeat-res-a r)))]))] (res-first-tok (repeat-res-a r)))]
[else (!!! (printf "~a~n" r)) (error 'stop1)]))]
[my-error (sequence-error-gen name sequence-length)] [my-error (sequence-error-gen name sequence-length)]
[my-walker (seq-walker id-position name my-error)]) [my-walker (seq-walker id-position name my-error)])
(opt-lambda (input [last-src (list 0 0 0 0)] [alts 1]) (opt-lambda (input [last-src (list 0 0 0 0)] [alts 1])
@ -139,6 +151,7 @@
(or id (res-id (repeat-res-a rst))) (or id (res-id (repeat-res-a rst)))
(+ used (res-used (repeat-res-a rst))) (+ used (res-used (repeat-res-a rst)))
(repeat-res-stop rst) tok)] (repeat-res-stop rst) tok)]
[else (printf "~a~n" rst) (error 'stop2)]
))] ))]
[walker [walker
(lambda (subs input previous? look-back curr-id seen used alts last-src) (lambda (subs input previous? look-back curr-id seen used alts last-src)
@ -186,7 +199,8 @@
(car next-preds) look-back used curr-id (car next-preds) look-back used curr-id
seen alts last-src)])] seen alts last-src)])]
[(repeat-res? fst) [(repeat-res? fst)
#;(printf "repeat-res: ~a~n" fst) #;(!!! (printf "repeat-res: ~n"))
#;(!!! (printf "res? ~a~n" (res? (repeat-res-a fst))))
(next-call (repeat-res-a fst) fst (next-call (repeat-res-a fst) fst
(res-msg (repeat-res-a fst)) #f (res-msg (repeat-res-a fst)) #f
(res-first-tok (repeat-res-a fst)) alts)] (res-first-tok (repeat-res-a fst)) alts)]
@ -211,10 +225,13 @@
(and id-spot? (res-id res)) (and id-spot? (res-id res))
(res-first-tok res) new-alts)] (res-first-tok res) new-alts)]
[(repeat-res? res) [(repeat-res? res)
#;(!!! (printf "choice-res, repeat-res ~a~n"
(res? (repeat-res-a res))))
(next-call (repeat-res-a res) res (next-call (repeat-res-a res) res
(res-msg (repeat-res-a res)) #f (res-msg (repeat-res-a res)) #f
(res-first-tok (repeat-res-a res)) (res-first-tok (repeat-res-a res))
new-alts)])) lst)] new-alts)]
[else (!!! (printf "~a~n" res))(error 'stop) ])) lst)]
[(correct-rsts) (correct-list rsts)]) [(correct-rsts) (correct-list rsts)])
#;(printf "rsts =~a~n" rsts) #;(printf "rsts =~a~n" rsts)
#;(printf "correct-rsts ~a~n" (map res-a correct-rsts)) #;(printf "correct-rsts ~a~n" (map res-a correct-rsts))
@ -224,6 +241,7 @@
(let ([fails (let ([fails
(map (map
(lambda (rst) (lambda (rst)
(!!! (unless (res? rst) (error 'here-we-are)))
(res-msg (res-msg
(build-error rst (previous? input) (previous? return-name) (build-error rst (previous? input) (previous? return-name)
(car next-preds) look-back used curr-id seen alts last-src))) (car next-preds) look-back used curr-id seen alts last-src)))
@ -247,7 +265,8 @@
[(sequence-fail? fail) [(sequence-fail? fail)
(values 'sub-seq (sequence-fail-expected fail) fail)] (values 'sub-seq (sequence-fail-expected fail) fail)]
[(choice-fail? fail) (values 'choice null fail)] [(choice-fail? fail) (values 'choice null fail)]
[(options-fail? fail) (values 'options null fail)])) [(options-fail? fail) (values 'options null fail)]
[else (printf "~a~n" fail) (error 'stop3)]))
;update-src: symbol src-list src-list token -> src-list ;update-src: symbol src-list src-list token -> src-list
(define (update-src error-kind src prev-src tok) (define (update-src error-kind src prev-src tok)
@ -420,7 +439,8 @@
[else [else
(let* ([options (map (lambda (term) (term input last-src sub-opts)) opt-list)] (let* ([options (map (lambda (term) (term input last-src sub-opts)) opt-list)]
#;[a (!!! (printf "choice-options ~a ~n ~a ~n~n~n" choice-names options))] #;[a (!!! (printf "choice-options ~a ~n ~a ~n~n~n" choice-names options))]
[fails (map res-msg options)] [fails (map (lambda (x) (if (res? x) (res-msg x) (error 'here-non-res)))
options)]
[corrects (correct-list options)] [corrects (correct-list options)]
[ans [ans
(cond (cond
@ -454,9 +474,10 @@
[(repeat-res? (car subs)) [(repeat-res? (car subs))
(correct-list (cons (repeat-res-a (car subs)) (cdr subs)))] (correct-list (cons (repeat-res-a (car subs)) (cdr subs)))]
[(pair? (car subs)) [(pair? (car subs))
(append (car subs) (correct-list (cdr subs)))] (append (correct-list (car subs)) (correct-list (cdr subs)))]
[else (correct-list (cdr subs))])] [else (correct-list (cdr subs))])]
[(null? subs) null])) [(null? subs) null]
[else (printf "subs~a~n" subs) (error 'stop5)]))
(define (update-src-start src new-start) (define (update-src-start src new-start)
(list (position-line new-start) (list (position-line new-start)

16
collects/profj/comb-parsers/parser-units.scm
View File

@ -391,10 +391,10 @@
(sequence (base --) id)) "unary modification")) (sequence (base --) id)) "unary modification"))
(define (cast type) (define (cast type)
(sequence (O_PAREN type C_PAREN expression) "cast expression")) (sequence (O_PAREN type C_PAREN expression) id "cast expression"))
(define instanceof-back (define instanceof-back
(sequence (instanceof name) "instanceof expression")) (sequence (instanceof name) id "instanceof expression"))
(define super-ctor (define super-ctor
(choose ((sequence (super O_PAREN C_PAREN) id) (choose ((sequence (super O_PAREN C_PAREN) id)
@ -714,10 +714,9 @@
(sequence (unique-base (repeat unique-end)) id "expression")) (sequence (unique-base (repeat unique-end)) id "expression"))
(define stmt-expr (define stmt-expr
(choose (new-class (choose (#;new-class
super-call #;super-call
(sequence (expression (method-call-end expression)) #;(sequence (unique-base method-call-end) id "method call")
id "method call")
(assignment (assignment
(choose (identifier (choose (identifier
(sequence (unique-base field-access-end) id)) (sequence (unique-base field-access-end) id))
@ -797,8 +796,7 @@
(define stmt-expr (define stmt-expr
(choose (new-class (choose (new-class
super-call super-call
(sequence (expression (method-call-end expression)) (sequence (expression method-call-end) id "method call")
id "method call")
(assignment (assignment
(choose (identifier (choose (identifier
(sequence (unique-base field-access-end) id)) (sequence (unique-base field-access-end) id))
@ -885,7 +883,7 @@
(define stmt-expr (define stmt-expr
(choose (new-class (choose (new-class
super-call super-call
(sequence (expression method-call-end expression) id "method call") (sequence (expression method-call-end) id "method call")
(assignment (assignment
(choose (identifier (choose (identifier
(sequence (expression field-access-end) id) (sequence (expression field-access-end) id)