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

Corrected bugs causing infinite (tight) loop

Browse Source 
svn: r6503
This commit is contained in:
Kathy Gray 2007-06-06 14:05:56 +00:00
parent 4996220198
commit fa7700e133
4 changed files with 8 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,7 +22,6 @@
[(and (res? result) (res-a result) (null? (res-rest result)))
(car (res-a (!!! result)))]
[(and (res? result) (res-a result) (res-possible-error result))
(printf "res fail~n")
(fail-type->message (!!! (res-possible-error result)))]
[(and (res? result) (res-a result))
(make-err
@ -32,7 +31,6 @@
(and src?
(make-src-lst (position-token-start-pos (!!! (car (res-rest result)))))))]
[(res? result)
(printf "res fail2~n")
(fail-type->message (res-msg (!!! result)))]
[(or (choice-res? result) (pair? result))
(let* ([options (if (choice-res? result) (choice-res-matches result) result)]
@ -47,7 +45,7 @@
(cond
[(not (null? finished-options)) (car (res-a (!!! (car finished-options))))]
[(not (null? possible-errors))
(printf "choice or pair fail~n")
;(printf "choice or pair fail~n")
(!!! (fail-type->message
(res-possible-error (!!! (car (sort-used possible-errors))))))]
[else
@ -62,12 +60,13 @@
[(and (repeat-res? result) (eq? 'out-of-input (repeat-res-stop (!!! result))))
(res-a (repeat-res-a result))]
[(and (repeat-res? result) (fail-type? (repeat-res-stop (!!! result))))
(printf "repeat-fail~n")
;(printf "repeat-fail~n")
(!!! (fail-type->message (!!! (repeat-res-stop (!!! result)))))]
[else (error 'parser (format "Internal error: recieved unexpected input ~a"
(!!! result)))])])
(cond
[(err? out)
;(printf "returning error")
(make-err (!!! (err-msg out))
(list (!!! file)
(!!! (first (err-src out)))

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

@ -26,8 +26,7 @@
[spell? (if spell? spell?
(lambda (token)
(when (position-token? token) (set! token (position-token-token token)))
(and (token-value token)
(misspelled name (token-value token)))))]
(if (token-value token) (misspelled name (token-value token)) 0)))]
[case? (if case? case?
(lambda (token)
(when (position-token? token) (set! token (position-token-token token)))

6
collects/combinator-parser/private-combinator/errors.scm
View File

@ -24,7 +24,7 @@
[name (fail-type-name fail-type)]
[a (a/an name)]
[msg (lambda (m) (make-err m (fail-type-src fail-type)))])
#;(printf "fail-type->message ~a~n" fail-type)
;(printf "fail-type->message ~a~n" fail-type)
(cond
[(terminal-fail? fail-type)
(combine-message
@ -184,8 +184,8 @@
(define (first-n n lst)
(let loop ([count 0] [l lst])
(cond
[(= count n) null]
[else (cons (car lst) (loop (add1 count) (cdr lst)))])))
[(>= count n) null]
[else (cons (car l) (loop (add1 count) (cdr l)))])))
(define (get-ties lst evaluate)
(letrec ([getter

2
collects/combinator-parser/private-combinator/parser-sigs.ss
View File

@ -116,7 +116,7 @@
(thunk (token-value x))
(thunk (token-value x) (car args) (cadr args))))
name
(lambda (token) #f)
(lambda (token) 0)
(lambda (token) #f))) ...))))]))))
(define-syntaxes (sequence choose ^)