X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftypedefs.lisp;h=bcbfecea2be2161a06f4a08d6c116eece6e23be0;hb=5108495b13b99452d5a85c4600f68432ff8894b2;hp=c8499831fa7c7410a0b26c517a27b741ba046021;hpb=ce02ab2ecd9c6ae2e570abd8c93ebf3be55bbdad;p=sbcl.git diff --git a/src/code/typedefs.lisp b/src/code/typedefs.lisp index c849983..bcbfece 100644 --- a/src/code/typedefs.lisp +++ b/src/code/typedefs.lisp @@ -27,7 +27,7 @@ ;;; Define the translation from a type-specifier to a type structure for ;;; some particular type. Syntax is identical to DEFTYPE. (defmacro !def-type-translator (name arglist &body body) - (check-type name symbol) + (declare (type symbol name)) ;; FIXME: Now that the T%CL hack is ancient history and we just use CL ;; instead, we can probably return to using PARSE-DEFMACRO here. ;; @@ -88,43 +88,10 @@ (declare (type ctype type)) `(specifier-type ',(type-specifier type))) -;;;; utilities +;;;; miscellany -;;; sort of like ANY and EVERY, except: -;;; * We handle two-VALUES predicate functions like SUBTYPEP. (And -;;; if the result is uncertain, then we return (VALUES NIL NIL).) -;;; * THING is just an atom, and we apply OP (an arity-2 function) -;;; successively to THING and each element of LIST. -(defun any/type (op thing list) - (declare (type function op)) - (let ((certain? t)) - (dolist (i list (values nil certain?)) - (multiple-value-bind (sub-value sub-certain?) - (funcall op thing i) - (unless sub-certain? (setf certain? nil)) - (when sub-value (return (values t t))))))) -(defun every/type (op thing list) - (declare (type function op)) - (dolist (i list (values t t)) - (multiple-value-bind (sub-value sub-certain?) - (funcall op thing i) - (unless sub-certain? (return (values nil nil))) - (unless sub-value (return (values nil t)))))) - -;;; Return a function like FUN, but expecting its (two) arguments in -;;; the opposite order that FUN does. -;;; -;;; (This looks like a sort of general utility, but currently it's -;;; used only in the implementation of the type system, so it's -;;; internal to SB-KERNEL. -- WHN 2001-02-13) -(declaim (inline swapped-args-fun)) -(defun swapped-args-fun (fun) - (declare (type function fun)) - (lambda (x y) - (funcall fun y x))) - -;;; Look for a nice intersection for types that intersect only when -;;; one is a hierarchical subtype of the other. +;;; Look for nice relationships for types that have nice relationships +;;; only when one is a hierarchical subtype of the other. (defun hierarchical-intersection2 (type1 type2) (multiple-value-bind (subtypep1 win1) (csubtypep type1 type2) (multiple-value-bind (subtypep2 win2) (csubtypep type2 type1) @@ -132,15 +99,15 @@ (subtypep2 type2) ((and win1 win2) *empty-type*) (t nil))))) - -(defun vanilla-union (type1 type2) +(defun hierarchical-union2 (type1 type2) (cond ((csubtypep type1 type2) type2) ((csubtypep type2 type1) type1) (t nil))) -;;; Hash two things (types) down to 8 bits. In CMU CL this was an EQ hash, but -;;; since it now needs to run in vanilla ANSI Common Lisp at cross-compile -;;; time, it's now based on the CTYPE-HASH-VALUE field instead. +;;; Hash two things (types) down to 8 bits. In CMU CL this was an EQ +;;; hash, but since it now needs to run in vanilla ANSI Common Lisp at +;;; cross-compile time, it's now based on the CTYPE-HASH-VALUE field +;;; instead. ;;; ;;; FIXME: This was a macro in CMU CL, and is now an INLINE function. Is ;;; it important for it to be INLINE, or could be become an ordinary