Changeset 7234

Timestamp:

Sep 17, 2007, 7:40:29 AM (14 years ago)

Author:

gb

Message:

%REQUIRE-TYPE tries to map back to the type from the predicate in the case
when an error is signaled.

File:

• branches/working-0709/ccl/level-1/sysutils.lisp (modified) (2 diffs)

branches/working-0709/ccl/level-1/sysutils.lisp

@@ -310 +310 @@
     (%kernel-restart $xwrongtype arg type)))
 
-; Might want to use an inverted mapping instead of (satisfies ccl::obscurely-named)
+;;; Might want to use an inverted mapping instead of (satisfies ccl::obscurely-named)
 (defun %require-type (arg predsym)
-    (if (funcall predsym arg)
+  (if (funcall predsym arg)
     arg
-    (%kernel-restart $xwrongtype arg `(satisfies ,predsym))))
+    (%kernel-restart $xwrongtype arg (type-for-predicate predsym))))
 
 (defun %require-type-builtin (arg type-cell)  
@@ -323 +323 @@
 
 
+;;; In lieu of an inverted mapping, at least try to find cases involving
+;;; builtin numeric types and predicates associated with them.
+(defun type-for-predicate (pred)
+  (or (block find
+        (maphash #'(lambda (type ctype) (when (and (typep ctype 'numeric-ctype)
+                                                   (eq (numeric-ctype-predicate ctype)
+                                                       pred))
+                                          (return-from find type)))
+                 *builtin-type-info*))
+      `(satisfies ,pred)))