From 173f2f23366be7f38b35eb71515a14a0b9624d39 Mon Sep 17 00:00:00 2001
From: Kathy Gray <kathryn.gray@cl.cam.ac.uk>
Date: Wed, 1 Aug 2007 23:54:45 +0000
Subject: [PATCH] Fixed cdr null error

svn: r6997
---
 .../private-combinator/combinator.scm         |  4 ++-
 .../private-combinator/errors.scm             | 27 +++++++++++--------
 2 files changed, 19 insertions(+), 12 deletions(-)

diff --git a/collects/combinator-parser/private-combinator/combinator.scm b/collects/combinator-parser/private-combinator/combinator.scm
index 22c14dde09..f631d80efd 100644
--- a/collects/combinator-parser/private-combinator/combinator.scm
+++ b/collects/combinator-parser/private-combinator/combinator.scm
@@ -190,6 +190,7 @@
                                  (next-res old-answer new-id old-used tok rsts)]
                                 [else (printf "~a~n" rsts) (error 'here2)])))])
                     (cond
+                      [(null? subs) (error 'end-of-subs)]
                       [(null? next-preds)
                        (build-error (curr-pred input last-src) 
                                     (previous? input) (previous? return-name) #f
@@ -334,6 +335,7 @@
                                       [else (res-msg old-res)])]
                                    [(next-ok?)
                                     (and (= (fail-type-may-use fail) 1)
+                                         (not (null? (res-rest old-res)))
                                          next-pred
                                          (next-pred (cdr (res-rest old-res))))]
                                    [(next-used)
@@ -503,7 +505,7 @@
                      (cond
                        [(null? corrects) (fail-res input (fail-builder fails))]
                        [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)])))))
     
     ;correct-list: (list result) -> (list result)
diff --git a/collects/combinator-parser/private-combinator/errors.scm b/collects/combinator-parser/private-combinator/errors.scm
index 3d723b8afd..7e84b5438f 100644
--- a/collects/combinator-parser/private-combinator/errors.scm
+++ b/collects/combinator-parser/private-combinator/errors.scm
@@ -211,19 +211,23 @@
         winners))
     
     (define (first-n n lst)
-      (let loop ([count 0] [l lst])
-        (cond
-          [(>= count n) null]
-          [else (cons (car l) (loop (add1 count) (cdr l)))])))
+      (if (<= (length lst) n)
+          lst
+          (let loop ([count 0] [l lst])
+            (cond
+              [(>= count n) null]
+              [else (cons (car l) (loop (add1 count) (cdr l)))]))))
     
     (define (get-ties lst evaluate)
-      (letrec ([getter
-                (lambda (sub)
-                  (cond
-                    [(null? sub) null]
-                    [(>= (- (evaluate (car lst)) (evaluate (car sub))) .0001) null]
-                    [else (cons (car sub) (getter (cdr sub)))]))])
-        (cons (car lst) (getter (cdr lst)))))
+      (if (> (length lst) 1)
+          (letrec ([getter
+                    (lambda (sub)
+                      (cond
+                        [(null? sub) null]
+                        [(>= (- (evaluate (car lst)) (evaluate (car sub))) .0001) null]
+                        [else (cons (car sub) (getter (cdr sub)))]))])
+            (cons (car lst) (getter (cdr lst))))
+          lst))
     
     (define (a/an next-string)
       (if (string? next-string)
@@ -244,6 +248,7 @@
       (letrec ([formatter 
                 (lambda (l)
                   (cond
+                    [(null? l) ""]
                     [(null? (cdr l)) (string-append "or " (car l))]
                     [else (string-append (car l) ", " (formatter (cdr l)))]))])
         (cond