Changeset 111

Timestamp:

Dec 12, 2003, 1:12:00 PM (21 years ago)

Author:

Gary Byers

Message:

Set TYPE-PREDICATE slot of standard slot definition.

File:

• trunk/ccl/level-1/l1-typesys.lisp (modified) (1 diff)

trunk/ccl/level-1/l1-typesys.lisp

@@ -3074 +3074 @@
                      (union-ctype-types ctype))))))
 
+
+;;; Ensure that standard EFFECTIVE-SLOT-DEFINITIONs have a meaningful
+;;; type predicate, if we can.
+(defmethod shared-initialize :after ((spec effective-slot-definition)
+                                     slot-names
+                                     &key type
+                                     &allow-other-keys)
+  (declare (ignore slot-names))
+  (unless (eq type t)
+    (setf (slot-value spec 'type-predicate)
+          (or (and (typep type 'symbol)
+                   (type-predicate type))
+              (let* ((ctype (specifier-type type)))
+                #'(lambda (value) (ctypep value ctype)))))))