Changeset 7918

Timestamp:

Dec 17, 2007, 2:37:27 PM (17 years ago)

Author:

Gary Byers

Message:

Add TYPE-PREDICATEs for ARGS-CTYPE and its subclasses.

File:

• branches/working-0711/ccl/level-1/l1-typesys.lisp (modified) (1 diff)

branches/working-0711/ccl/level-1/l1-typesys.lisp

@@ -3386 +3386 @@
 (setf (type-predicate 'class-ctype) 'class-ctype-p)
 
+(defun args-ctype-p (x) (and (eql (typecode x) target::subtag-istruct)
+                             (member (%svref x 0)
+                                     '(args-ctype values-ctype function-ctype))))
+
+(defun function-ctype-p (x) (istruct-typep x 'function-ctype))
+(defun valuec-ctype-p (x) (istruct-typep x 'values-ctype))
+
+(setf (type-predicate 'args-ctype) 'args-ctype-p
+      (type-predicate 'function-ctype) 'function-ctype-p
+      (type-predicate 'values-ctype) 'values-ctype-p)
+
+
 ;;; Simple methods for TYPE= and SUBTYPEP should never be called when the two
 ;;; classes are equal, since there are EQ checks in those operations.