From 5d3ab96c2c76ed557c82e3658f1c679dd7480b7f Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Mon, 12 May 2008 02:39:28 -0700
Subject: [PATCH] fixed "inaccurate error message" bug in map when applied a
 non-list argument.

---
 scheme/ikarus.lists.ss          | 20 +++++++++++++++-----
 scheme/ikarus.pretty-formats.ss | 15 ++++++++-------
 scheme/last-revision            |  2 +-
 3 files changed, 24 insertions(+), 13 deletions(-)

diff --git a/scheme/ikarus.lists.ss b/scheme/ikarus.lists.ss
index 1b508bd..6e4e79d 100644
--- a/scheme/ikarus.lists.ss
+++ b/scheme/ikarus.lists.ss
@@ -525,14 +525,18 @@
                               ($car d1) ($car d2)
                               ($cdr d1) ($cdr d2)
                               ($fxsub1 n))))]
-             [else (die who "length mismatch")])]
+             [(null? d2) (die who "length mismatch")]
+             [else (die who "not a proper list")])]
           [(null? d1)
            (cond
              [(null? d2)
               (if ($fxzero? n)
                   (cons (f a1 a2) '())
                   (die who "list was altered"))]
-             [else (die who "length mismatch")])]
+             [else
+              (die who (if (list? d2) 
+                           "length mismatch"
+                           "not a proper list"))])]
           [else (die who "list was altered")])))
     (define cars
       (lambda (ls*)
@@ -590,11 +594,17 @@
              (if (pair? ls2)
                  (let ([d ($cdr ls)])
                    (map2 f ($car ls) ($car ls2) d ($cdr ls2) (len d d 0)))
-                 (die who "length mismatch"))]
+                 (die who 
+                    (if (list? ls2)
+                        "length mismatch"
+                        "not a proper list")))]
             [(null? ls)
              (if (null? ls2)
                  '()
-                 (die who "length mismatch"))]
+                 (die who
+                   (if (list? ls2)
+                       "length mismatch"
+                       "not a proper list")))]
             [else (die who "not a list")])]
          [(f ls . ls*)
           (unless (procedure? f)
@@ -606,7 +616,7 @@
             [(null? ls)
              (if (andmap null? ls*)
                  '()
-                 (die who "length mismatch"))]
+                 (die who "invalid arguments"))]
             [else (die who "not a list" ls)])])))
 
   (module (for-each)
diff --git a/scheme/ikarus.pretty-formats.ss b/scheme/ikarus.pretty-formats.ss
index 57f269c..24d2bc0 100644
--- a/scheme/ikarus.pretty-formats.ss
+++ b/scheme/ikarus.pretty-formats.ss
@@ -18,20 +18,21 @@
   (export get-fmt pretty-format)
   (import (except (ikarus) pretty-format))
 
-  (define *pretty-format* '*pretty-format*)
-  (define (get-fmt name)
-    (getprop name *pretty-format*))
-  (define (set-fmt! name fmt)
-    (putprop name *pretty-format* fmt))
+  (define h (make-eq-hashtable))
 
+  (define (get-fmt name)
+    (hashtable-ref h name #f))
+  
+  (define (set-fmt! name fmt)
+    (hashtable-set! h name fmt))
 
   (define pretty-format
     (lambda (x)
       (unless (symbol? x)
         (die 'pretty-format "not a symbol" x))
       (case-lambda
-        [() (getprop x *pretty-format*)]
-        [(v) (putprop x *pretty-format* v)])))
+        [() (hashtable-ref h x)]
+        [(v) (hashtable-set! h x v)])))
 
   ;;; standard formats
   (set-fmt! 'quote '(read-macro . "'"))
diff --git a/scheme/last-revision b/scheme/last-revision
index 2478883..3c074e4 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1473
+1475