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

Corrected error with else case falling through and creating void

Browse Source 
svn: r6736
This commit is contained in:
Kathy Gray 2007-06-25 23:33:04 +00:00
parent e5408d40c8
commit ce4aa511ea
2 changed files with 46 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -66,7 +66,7 @@
(!!! result)))])]) (!!! result)))])])
(cond (cond
[(err? out) [(err? out)
;(printf "returning error") #;(printf "returning error")
(make-err (!!! (err-msg out)) (make-err (!!! (err-msg out))
(if (err-src out) (if (err-src out)
(list (!!! file) (list (!!! file)

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

@ -138,7 +138,8 @@
(res-rest (repeat-res-a rst)) seq-name (res-rest (repeat-res-a rst)) seq-name
(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)]
))]
[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)
(let* ([next-preds (cdr subs)] (let* ([next-preds (cdr subs)]
@ -162,7 +163,8 @@
[(res? rsts) (fail-res rest (res-msg rsts))] [(res? rsts) (fail-res rest (res-msg rsts))]
[(pair? rsts) [(pair? rsts)
(map (lambda (rst) (next-res old-answer new-id old-used tok rst)) (map (lambda (rst) (next-res old-answer new-id old-used tok rst))
rsts)])))]) (correct-list rsts))]
[else (error 'here2)])))])
(cond (cond
[(null? next-preds) [(null? next-preds)
(build-error (curr-pred input last-src) (build-error (curr-pred input last-src)
@ -180,14 +182,18 @@
(res-first-tok fst) alts)] (res-first-tok fst) alts)]
[else [else
(build-error fst (previous? input) (previous? return-name) (build-error fst (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
[(repeat-res? fst) (next-call (repeat-res-a fst) fst seen alts last-src)])]
(res-msg (repeat-res-a fst)) #f [(repeat-res? fst)
(res-first-tok (repeat-res-a fst)) alts)] #;(printf "repeat-res: ~a~n" fst)
(next-call (repeat-res-a fst) fst
(res-msg (repeat-res-a fst)) #f
(res-first-tok (repeat-res-a fst)) alts)]
[(or (choice-res? fst) (pair? fst)) [(or (choice-res? fst) (pair? fst))
#;(printf "choice-res or pair: ~a ~a ~n" #;(printf "choice-res or pair: ~a ~a ~a ~n"
(if (choice-res? fst) (map res-rest (choice-res-matches fst)) fst) (choice-res? fst)
(if (choice-res? fst) (map res-a (choice-res-matches fst)) fst)) (if (choice-res? fst) (map res-rest (choice-res-matches fst)) fst)
(if (choice-res? fst) (map res-a (choice-res-matches fst)) fst))
(let*-values (let*-values
([(lst name curr) ([(lst name curr)
(if (choice-res? fst) (if (choice-res? fst)
@ -200,28 +206,34 @@
(map (lambda (res) (map (lambda (res)
(cond (cond
[(res? res) [(res? res)
(next-call res (curr res) (name res) (and id-spot? (res-id res)) (next-call res (curr res) (name 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)
(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)) new-alts)])) lst)] (res-first-tok (repeat-res-a res))
new-alts)])) lst)]
[(correct-rsts) (correct-list rsts)]) [(correct-rsts) (correct-list 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))
#;(printf "rsts: ~a~n" (map res-a rsts)) #;(printf "rsts: ~a~n" (map res-a rsts))
(cond (cond
[(null? correct-rsts) [(null? correct-rsts)
(let ([fails (map (lambda (rst) (let ([fails
(res-msg (map
(build-error rst (previous? input) (previous? return-name) (lambda (rst)
(car next-preds) look-back used curr-id seen alts last-src))) (res-msg
rsts)]) (build-error rst (previous? input) (previous? return-name)
(car next-preds) look-back used curr-id seen alts last-src)))
rsts)])
(fail-res input (fail-res input
(make-options-fail (make-options-fail
(rank-choice (map fail-type-chance fails)) #f seq-name (rank-choice (map fail-type-chance fails)) #f seq-name
(rank-choice (map fail-type-used fails)) (rank-choice (map fail-type-used fails))
(rank-choice (map fail-type-may-use fails)) fails)))] (rank-choice (map fail-type-may-use fails)) fails)))]
[else correct-rsts]))]))])))]) [else correct-rsts]))]
[else (error 'here3)]))])))])
walker)) walker))
;get-fail-info: fail-type -> (values symbol 'a 'b) ;get-fail-info: fail-type -> (values symbol 'a 'b)
@ -309,7 +321,8 @@
(fail-type-src fail) (fail-type-src fail)
name used name used
(+ used (fail-type-may-use fail) next-used) (+ used (fail-type-may-use fail) next-used)
id kind (reverse seen) expected found (and (res? prev) (res-a prev) (res-msg prev)) id kind (reverse seen) expected found
(and (res? prev) (res-a prev) (res-msg prev))
prev-name)))]))) prev-name)))])))
(define (compute-chance expected-length seen-length used-toks num-alts sub-chance) (define (compute-chance expected-length seen-length used-toks num-alts sub-chance)
@ -357,7 +370,8 @@
rest))]) rest))])
(repeat-res-stop rest-ans)))] (repeat-res-stop rest-ans)))]
[(pair? rest-ans) [(pair? rest-ans)
(map (lambda (r) (process-rest curr-ans r)) rest-ans)]))]) (map (lambda (r) (process-rest curr-ans r)) rest-ans)]
[else (error 'here4)]))])
(opt-lambda (input [last-src (list 0 0 0 0)] [alts 1]) (opt-lambda (input [last-src (list 0 0 0 0)] [alts 1])
(cond (cond
[(eq? input return-name) repeat-name] [(eq? input return-name) repeat-name]
@ -370,15 +384,23 @@
(make-repeat-res (make-res null null repeat-name "" 0 #f #f) 'out-of-input)] (make-repeat-res (make-res null null repeat-name "" 0 #f #f) 'out-of-input)]
[else [else
(let ([this-res (sub curr-input last-src)]) (let ([this-res (sub curr-input last-src)])
#;(printf "Repeat of ~a called it's repeated entity: ~a~n" repeat-name this-res) #;(printf "Repeat of ~a called it's repeated entity: ~a~n"
repeat-name this-res)
(cond (cond
[(and (res? this-res) (res-a this-res)) [(and (res? this-res) (res-a this-res))
(process-rest this-res (loop (res-rest this-res)))] (process-rest this-res (loop (res-rest this-res)))]
[(res? this-res) [(res? this-res)
(make-repeat-res (make-res null curr-input repeat-name "" 0 #f #f) (res-msg this-res))] (make-repeat-res (make-res null curr-input repeat-name "" 0 #f #f)
(res-msg this-res))]
[(repeat-res? this-res)
(process-rest (repeat-res-a this-res)
(res-rest (repeat-res-a this-res)))]
[(or (choice-res? this-res) (pair? this-res)) [(or (choice-res? this-res) (pair? this-res))
(map (lambda (match) (process-rest match (loop (res-rest match)))) (map (lambda (match) (process-rest match (loop (res-rest match))))
(if (choice-res? this-res) (choice-res-matches this-res) this-res))]))]))]) (if (choice-res? this-res)
(choice-res-matches this-res)
this-res))]
[else (error 'here5)]))]))])
(hash-table-put! memo-table input ans) (hash-table-put! memo-table input ans)
#;(printf "repeat of ~a ended with ans ~a~n" repeat-name ans) #;(printf "repeat of ~a ended with ans ~a~n" repeat-name ans)
ans)])))) ans)]))))
@ -396,6 +418,7 @@
[(eq? input return-name) name] [(eq? input return-name) name]
[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))]
[fails (map res-msg options)] [fails (map res-msg options)]
[corrects (correct-list options)] [corrects (correct-list options)]
[ans [ans