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

Correction to bugs to the parser

Browse Source 
svn: r7006
This commit is contained in:
Kathy Gray 2007-08-03 01:50:39 +00:00
parent 394837c1eb
commit b01f462894
1 changed files with 23 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -343,17 +343,17 @@
(cond (cond
[(and (repeat-res? look-back) [(and (repeat-res? look-back)
(fail-type? (repeat-res-stop look-back)) (fail-type? (repeat-res-stop look-back))
(> (fail-type-chance (repeat-res-stop look-back)) (>= (fail-type-chance (repeat-res-stop look-back))
(fail-type-chance fail))) (fail-type-chance fail)))
(repeat-res-stop look-back)] (repeat-res-stop look-back)]
[(and (choice-res? look-back) [(and (choice-res? look-back)
(choice-res-errors look-back) (choice-res-errors look-back)
(> (fail-type-chance (choice-res-errors look-back)) (>= (fail-type-chance (choice-res-errors look-back))
(fail-type-chance fail))) (fail-type-chance fail)))
(choice-res-errors look-back)] (choice-res-errors look-back)]
[(and (res? look-back) [(and (res? look-back)
(fail-type? (res-possible-error look-back)) (fail-type? (res-possible-error look-back))
(> (fail-type-chance (res-possible-error look-back)) (>= (fail-type-chance (res-possible-error look-back))
(fail-type-chance fail))) (fail-type-chance fail)))
(res-possible-error look-back)] (res-possible-error look-back)]
[else #f])] [else #f])]
@ -375,8 +375,8 @@
[(updated-len) (+ (- used seen-len) len)]) [(updated-len) (+ (- used seen-len) len)])
#;(printf "sequence ~a failed.~n seen ~a~n" name (reverse seen)) #;(printf "sequence ~a failed.~n seen ~a~n" name (reverse seen))
#;(when (repeat-res? look-back) #;(when (repeat-res? look-back)
(printf "look-back ~a : ~a vs ~a : ~a > ~a~n" (printf "look-back repeat-res ~a : ~a vs ~a : ~a > ~a~n"
(repeat-res-stop look-back) (fail-type? (repeat-res-stop look-back))
(and (fail-type? (repeat-res-stop look-back)) (fail-type-name (repeat-res-stop look-back))) (and (fail-type? (repeat-res-stop look-back)) (fail-type-name (repeat-res-stop look-back)))
(fail-type-name (res-msg old-res)) (fail-type-name (res-msg old-res))
(and (fail-type? (repeat-res-stop look-back)) (fail-type-chance (repeat-res-stop look-back))) (and (fail-type? (repeat-res-stop look-back)) (fail-type-chance (repeat-res-stop look-back)))
@ -391,15 +391,10 @@
#;(when (pair? look-back) #;(when (pair? look-back)
(printf "look-back is a pair~n")) (printf "look-back is a pair~n"))
#;(when (res? look-back) #;(when (res? look-back)
(printf "lookbac is a res~n")) (printf "lookbac is a res, ~a~n" (fail-type? (res-possible-error look-back))))
#;(printf "old-probability ~a new probability ~a~n"
(cond
[(= 0 used) (fail-type-chance fail)]
[else (+ (* (fail-type-chance fail) (/ 1 updated-len))
(/ used updated-len))])
(compute-chance len seen-len used alts (fail-type-chance fail)))
(let* ([seq-fail-maker (let* ([seq-fail-maker
(lambda (fail) (lambda (fail)
(let-values ([(kind expected found) (get-fail-info fail)])
(make-sequence-fail (make-sequence-fail
(cond (cond
[(= 0 used) (fail-type-chance fail)] [(= 0 used) (fail-type-chance fail)]
@ -409,10 +404,11 @@
(+ used (fail-type-may-use fail) next-used) (+ used (fail-type-may-use fail) next-used)
id kind (reverse seen) expected found id kind (reverse seen) expected found
(and (res? prev) (res-a prev) (res-msg prev)) (and (res? prev) (res-a prev) (res-msg prev))
prev-name))] prev-name)))]
[seq-fail (seq-fail-maker fail)] [seq-fail (seq-fail-maker fail)]
[pos-fail (and possible-fail (seq-fail-maker fail))] [pos-fail (and possible-fail (seq-fail-maker possible-fail))]
[opt-fails (list seq-fail pos-fail)]) [opt-fails (list seq-fail pos-fail)])
#;(when pos-fail (printf "opt-fails ~a~n" opt-fails))
(if pos-fail (if pos-fail
(make-options-fail (rank-choice (map fail-type-chance opt-fails)) (make-options-fail (rank-choice (map fail-type-chance opt-fails))
#f #f
@ -481,12 +477,14 @@
(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" #;(printf "Repeat of ~a called it's repeated entity: ~n"
repeat-name this-res) repeat-name #;this-res)
(cond (cond
[(and (res? this-res) (res-a this-res)) [(and (res? this-res) (res-a this-res))
#;(printf "loop again case~n")
(process-rest this-res (loop (res-rest this-res)))] (process-rest this-res (loop (res-rest this-res)))]
[(res? this-res) [(res? this-res)
#;(printf "fail for error case ~a~n" (fail-type? (res-msg this-res)))
(make-repeat-res (make-res null curr-input repeat-name "" 0 #f #f) (make-repeat-res (make-res null curr-input repeat-name "" 0 #f #f)
(res-msg this-res))] (res-msg this-res))]
[(repeat-res? this-res) [(repeat-res? this-res)