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

Bug fixes (more on the way)

Browse Source 
svn: r7046
This commit is contained in:
Kathy Gray 2007-08-07 17:47:37 +00:00
parent 67d8a3ad9a
commit c6b723bbd8
2 changed files with 24 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -61,10 +61,10 @@
[(null? input) (printf "null given~n")]
[else
(let ([token (!!! ((!!! position-token-token) (!!! (car input))))])
#;(!!! (printf "Look at token ~a~n" token))
(!!! (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 "called pred~n"))
#;(!!! (printf "car of input ~a~n" (position-token-token (car input)))))]))
(cond
[(eq? input return-name) name]
@ -188,11 +188,12 @@
(correct-list (choice-res-matches rsts)))]
[(repeat-res? rsts)
(next-res old-answer new-id old-used tok rsts)]
[else (printf "~a~n" rsts) (error 'here2)])))])
[else (error 'parser-internal-error3 rsts)])))])
(cond
[(null? subs) (error 'end-of-subs)]
[(null? next-preds)
#;(printf "seq-warker called: last case, ~a ~n" seq-name)
#;(printf "seq-warker called: last case, ~a case of ~a ~n"
seq-name (curr-pred return-name))
(build-error (curr-pred input last-src)
(previous? input) (previous? return-name) #f
look-back used curr-id seen alts last-src)]
@ -247,7 +248,7 @@
(res-msg (repeat-res-a res)) #f
(res-first-tok (repeat-res-a res))
new-alts)]
[else (!!! (printf "~a~n" res))(error 'stop) ])) (correct-list lst))]
[else (!!! (error 'parser-internal-error4 res))])) (correct-list lst))]
[(correct-rsts) (correct-list rsts)])
#;(printf "rsts =~a~n" rsts)
#;(printf "correct-rsts ~a~n" (map res-a correct-rsts))
@ -282,7 +283,7 @@
(values 'sub-seq (sequence-fail-expected fail) fail)]
[(choice-fail? fail) (values 'choice null fail)]
[(options-fail? fail) (values 'options null fail)]
[else (printf "~a~n" fail) (error 'stop3)]))
[else (error 'parser-internal-error5 fail)]))
;update-src: symbol src-list src-list token -> src-list
(define (update-src error-kind src prev-src tok)
@ -344,17 +345,17 @@
(cond
[(and (repeat-res? 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)))
(repeat-res-stop look-back)]
[(and (choice-res? look-back)
#;[(and (choice-res? 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)))
(choice-res-errors look-back)]
[(and (res? look-back)
#;[(and (res? 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)))
(res-possible-error look-back)]
[else #f])]
@ -601,7 +602,7 @@
(apply append (cons (correct-list (car subs)) (correct-list (cdr subs))))]
[else (correct-list (cdr subs))])]
[(null? subs) null]
[else (printf "subs~a~n" subs) (error 'stop5)]))
[else (error 'parser-internal-error6 subs)]))
(define (split-list subs)
(let loop ([in subs] [correct null] [incorrect null])

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

@ -230,31 +230,31 @@
(export java-ops^)
(define math-ops
(choose (PLUS MINUS TIMES DIVIDE %) "binary operation"))
(choose (PLUS MINUS TIMES DIVIDE %) "binary operater"))
(define shift-ops
(choose (<< >> >>>) "shift operation"))
(choose (<< >> >>>) "shift operater"))
(define compare-ops
(choose (== GT LT LTEQ GTEQ !=) "binary operation"))
(choose (== GT LT LTEQ GTEQ !=) "binary operater"))
(define bool-ops
(choose (&& OR) "binary operation"))
(choose (&& OR) "binary operater"))
(define bit-ops
(choose (^T PIPE &) "binary operation"))
(choose (^T PIPE &) "binary operater"))
(define assignment-ops
(choose (EQUAL OREQUAL += -= *= /= &= ^= %= <<= >>= >>>=) "assignment"))
(define (bin-ops ops)
(choice ops "binary operation"))
(choice ops "binary operater"))
(define un-assignment
(choose (++ --) "unary operation"))
(choose (++ --) "unary operater"))
(define un-op
(choose (~ + -) "unary operation"))
(choose (~ PLUS MINUS) "unary operater"))
)
@ -361,7 +361,7 @@
(sequence (new type-name init) "array initialization")))
(define (binary-expression-end op)
(sequence ((^ op) expression) id "binary expression"))
(sequence (op expression) id "binary expression"))
(define if-expr-end
(sequence (? (eta expression) : (eta expression)) id "conditional expression"))
@ -648,13 +648,13 @@
(sequence (O_PAREN (eta expression) C_PAREN) id)
(sequence (! (eta expression)) id "conditional expression")
(sequence (MINUS (eta expression)) id "negation expression")
checks) "expression -unique base"))
checks) "expression"))
(define unique-end
(choose (field-access-end
method-call-end
(binary-expression-end (bin-ops (list math-ops compare-ops bool-ops))))
"expression -unique end"))
"expression"))
(define expression
(sequence (unique-base (repeat-greedy unique-end)) id "expression"))