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

Fixed cdr null error

Browse Source 
svn: r6997
This commit is contained in:
Kathy Gray 2007-08-01 23:54:45 +00:00
parent 94a30c2e14
commit 173f2f2336
2 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -190,6 +190,7 @@
(next-res old-answer new-id old-used tok rsts)] (next-res old-answer new-id old-used tok rsts)]
[else (printf "~a~n" rsts) (error 'here2)])))]) [else (printf "~a~n" rsts) (error 'here2)])))])
(cond (cond
[(null? subs) (error 'end-of-subs)]
[(null? next-preds) [(null? next-preds)
(build-error (curr-pred input last-src) (build-error (curr-pred input last-src)
(previous? input) (previous? return-name) #f (previous? input) (previous? return-name) #f
@ -334,6 +335,7 @@
[else (res-msg old-res)])] [else (res-msg old-res)])]
[(next-ok?) [(next-ok?)
(and (= (fail-type-may-use fail) 1) (and (= (fail-type-may-use fail) 1)
(not (null? (res-rest old-res)))
next-pred next-pred
(next-pred (cdr (res-rest old-res))))] (next-pred (cdr (res-rest old-res))))]
[(next-used) [(next-used)
@ -503,7 +505,7 @@
(cond (cond
[(null? corrects) (fail-res input (fail-builder fails))] [(null? corrects) (fail-res input (fail-builder fails))]
[else (make-choice-res name corrects (fail-builder errors))])]) [else (make-choice-res name corrects (fail-builder errors))])])
#;(!!! (printf "choice ~a is returning ~a options were ~a ~n" name ans choice-names)) #;(!!! (printf "choice ~a is returning options were ~a ~n" name choice-names))
(hash-table-put! memo-table input ans) ans)]))))) (hash-table-put! memo-table input ans) ans)])))))
;correct-list: (list result) -> (list result) ;correct-list: (list result) -> (list result)

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

@ -211,19 +211,23 @@
winners)) winners))
(define (first-n n lst) (define (first-n n lst)
(let loop ([count 0] [l lst]) (if (<= (length lst) n)
(cond lst
[(>= count n) null] (let loop ([count 0] [l lst])
[else (cons (car l) (loop (add1 count) (cdr l)))]))) (cond
[(>= count n) null]
[else (cons (car l) (loop (add1 count) (cdr l)))]))))
(define (get-ties lst evaluate) (define (get-ties lst evaluate)
(letrec ([getter (if (> (length lst) 1)
(lambda (sub) (letrec ([getter
(cond (lambda (sub)
[(null? sub) null] (cond
[(>= (- (evaluate (car lst)) (evaluate (car sub))) .0001) null] [(null? sub) null]
[else (cons (car sub) (getter (cdr sub)))]))]) [(>= (- (evaluate (car lst)) (evaluate (car sub))) .0001) null]
(cons (car lst) (getter (cdr lst))))) [else (cons (car sub) (getter (cdr sub)))]))])
(cons (car lst) (getter (cdr lst))))
lst))
(define (a/an next-string) (define (a/an next-string)
(if (string? next-string) (if (string? next-string)
@ -244,6 +248,7 @@
(letrec ([formatter (letrec ([formatter
(lambda (l) (lambda (l)
(cond (cond
[(null? l) ""]
[(null? (cdr l)) (string-append "or " (car l))] [(null? (cdr l)) (string-append "or " (car l))]
[else (string-append (car l) ", " (formatter (cdr l)))]))]) [else (string-append (car l) ", " (formatter (cdr l)))]))])
(cond (cond