1 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; This software is derived from the CMU CL system, which was
5 ;;;; written at Carnegie Mellon University and released into the
6 ;;;; public domain. The software is in the public domain and is
7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
8 ;;;; files for more information.
10 (in-package "SB!KERNEL")
12 (!begin-collecting-cold-init-forms)
14 ;;;; representations of types
16 ;;; A HAIRY-TYPE represents anything too weird to be described
17 ;;; reasonably or to be useful, such as NOT, SATISFIES, unknown types,
18 ;;; and unreasonably complicated types involving AND. We just remember
19 ;;; the original type spec.
20 (defstruct (hairy-type (:include ctype
21 (class-info (type-class-or-lose 'hairy))
23 (might-contain-other-types-p t))
26 ;; the Common Lisp type-specifier of the type we represent
27 (specifier nil :type t))
29 (!define-type-class hairy)
31 ;;; An UNKNOWN-TYPE is a type not known to the type system (not yet
32 ;;; defined). We make this distinction since we don't want to complain
33 ;;; about types that are hairy but defined.
34 (defstruct (unknown-type (:include hairy-type)
37 (defun maybe-reparse-specifier (type)
38 (when (unknown-type-p type)
39 (let* ((spec (unknown-type-specifier type))
40 (name (if (consp spec)
43 (when (info :type :kind name)
44 (let ((new-type (specifier-type spec)))
45 (unless (unknown-type-p new-type)
49 (defmacro maybe-reparse-specifier! (type)
50 (assert (symbolp type))
51 (with-unique-names (new-type)
52 `(let ((,new-type (maybe-reparse-specifier ,type)))
54 (setf ,type ,new-type)
57 (defstruct (negation-type (:include ctype
58 (class-info (type-class-or-lose 'negation))
59 ;; FIXME: is this right? It's
60 ;; what they had before, anyway
62 (might-contain-other-types-p t))
65 (type (missing-arg) :type ctype))
67 (!define-type-class negation)
69 ;;; ARGS-TYPE objects are used both to represent VALUES types and
70 ;;; to represent FUNCTION types.
71 (defstruct (args-type (:include ctype)
74 ;; Lists of the type for each required and optional argument.
75 (required nil :type list)
76 (optional nil :type list)
77 ;; The type for the rest arg. NIL if there is no &REST arg.
78 (rest nil :type (or ctype null))
79 ;; true if &KEY arguments are specified
80 (keyp nil :type boolean)
81 ;; list of KEY-INFO structures describing the &KEY arguments
82 (keywords nil :type list)
83 ;; true if other &KEY arguments are allowed
84 (allowp nil :type boolean))
86 (defun canonicalize-args-type-args (required optional rest &optional keyp)
87 (when (eq rest *empty-type*)
90 (loop with last-not-rest = nil
93 do (cond ((eq opt *empty-type*)
94 (return (values required (subseq optional i) rest)))
95 ((and (not keyp) (neq opt rest))
96 (setq last-not-rest i)))
97 finally (return (values required
101 (subseq optional 0 (1+ last-not-rest))))
104 (defun parse-args-types (lambda-list-like-thing)
106 (required optional restp rest keyp keys allowp auxp aux
107 morep more-context more-count llk-p)
108 (parse-lambda-list-like-thing lambda-list-like-thing :silent t)
109 (declare (ignore aux morep more-context more-count))
111 (error "&AUX in a FUNCTION or VALUES type: ~S." lambda-list-like-thing))
112 (let ((required (mapcar #'single-value-specifier-type required))
113 (optional (mapcar #'single-value-specifier-type optional))
114 (rest (when restp (single-value-specifier-type rest)))
116 (collect ((key-info))
118 (unless (proper-list-of-length-p key 2)
119 (error "Keyword type description is not a two-list: ~S." key))
120 (let ((kwd (first key)))
121 (when (find kwd (key-info) :key #'key-info-name)
122 (error "~@<repeated keyword ~S in lambda list: ~2I~_~S~:>"
123 kwd lambda-list-like-thing))
127 :type (single-value-specifier-type (second key))))))
129 (multiple-value-bind (required optional rest)
130 (canonicalize-args-type-args required optional rest keyp)
131 (values required optional rest keyp keywords allowp llk-p)))))
133 (defstruct (values-type
135 (class-info (type-class-or-lose 'values)))
136 (:constructor %make-values-type)
137 (:predicate %values-type-p)
140 (declaim (inline value-type-p))
141 (defun values-type-p (x)
142 (or (eq x *wild-type*)
145 (defun-cached (make-values-type-cached
148 (lambda (req opt rest allowp)
150 (type-list-cache-hash req)
151 (type-list-cache-hash opt)
153 (type-hash-value rest)
155 ;; Results (logand #xFF (sxhash t/nil))
156 ;; hardcoded to avoid relying on the xc host.
161 ((required equal-but-no-car-recursion)
162 (optional equal-but-no-car-recursion)
165 (%make-values-type :required required
170 (defun make-values-type (&key required optional rest allowp)
171 (multiple-value-bind (required optional rest)
172 (canonicalize-args-type-args required optional rest)
173 (cond ((and (null required)
175 (eq rest *universal-type*))
177 ((memq *empty-type* required)
179 (t (make-values-type-cached required optional
182 (!define-type-class values)
184 ;;; (SPECIFIER-TYPE 'FUNCTION) and its subtypes
185 (defstruct (fun-type (:include args-type
186 (class-info (type-class-or-lose 'function)))
188 make-fun-type (&key required optional rest
192 &aux (rest (if (eq rest *empty-type*)
195 ;; true if the arguments are unrestrictive, i.e. *
196 (wild-args nil :type boolean)
197 ;; type describing the return values. This is a values type
198 ;; when multiple values were specified for the return.
199 (returns (missing-arg) :type ctype))
201 ;;; The CONSTANT-TYPE structure represents a use of the CONSTANT-ARG
202 ;;; "type specifier", which is only meaningful in function argument
203 ;;; type specifiers used within the compiler. (It represents something
204 ;;; that the compiler knows to be a constant.)
205 (defstruct (constant-type
207 (class-info (type-class-or-lose 'constant)))
209 ;; The type which the argument must be a constant instance of for this type
211 (type (missing-arg) :type ctype))
213 ;;; The NAMED-TYPE is used to represent *, T and NIL, the standard
214 ;;; special cases, as well as other special cases needed to
215 ;;; interpolate between regions of the type hierarchy, such as
216 ;;; INSTANCE (which corresponds to all those classes with slots which
217 ;;; are not funcallable), FUNCALLABLE-INSTANCE (those classes with
218 ;;; slots which are funcallable) and EXTENDED-SEQUUENCE (non-LIST
219 ;;; non-VECTOR classes which are also sequences). These special cases
220 ;;; are the ones that aren't really discussed by Baker in his
221 ;;; "Decision Procedure for SUBTYPEP" paper.
222 (defstruct (named-type (:include ctype
223 (class-info (type-class-or-lose 'named)))
225 (name nil :type symbol))
227 ;;; a list of all the float "formats" (i.e. internal representations;
228 ;;; nothing to do with #'FORMAT), in order of decreasing precision
229 (eval-when (:compile-toplevel :load-toplevel :execute)
230 (defparameter *float-formats*
231 '(long-float double-float single-float short-float)))
233 ;;; The type of a float format.
234 (deftype float-format () `(member ,@*float-formats*))
236 ;;; A NUMERIC-TYPE represents any numeric type, including things
238 (defstruct (numeric-type (:include ctype
239 (class-info (type-class-or-lose 'number)))
240 (:constructor %make-numeric-type)
242 ;; the kind of numeric type we have, or NIL if not specified (just
243 ;; NUMBER or COMPLEX)
245 ;; KLUDGE: A slot named CLASS for a non-CLASS value is bad.
246 ;; Especially when a CLASS value *is* stored in another slot (called
247 ;; CLASS-INFO:-). Perhaps this should be called CLASS-NAME? Also
248 ;; weird that comment above says "Numeric-Type is used to represent
249 ;; all numeric types" but this slot doesn't allow COMPLEX as an
250 ;; option.. how does this fall into "not specified" NIL case above?
251 ;; Perhaps someday we can switch to CLOS and make NUMERIC-TYPE
252 ;; be an abstract base class and INTEGER-TYPE, RATIONAL-TYPE, and
253 ;; whatnot be concrete subclasses..
254 (class nil :type (member integer rational float nil) :read-only t)
255 ;; "format" for a float type (i.e. type specifier for a CPU
256 ;; representation of floating point, e.g. 'SINGLE-FLOAT -- nothing
257 ;; to do with #'FORMAT), or NIL if not specified or not a float.
258 ;; Formats which don't exist in a given implementation don't appear
260 (format nil :type (or float-format null) :read-only t)
261 ;; Is this a complex numeric type? Null if unknown (only in NUMBER).
263 ;; FIXME: I'm bewildered by FOO-P names for things not intended to
264 ;; interpreted as truth values. Perhaps rename this COMPLEXNESS?
265 (complexp :real :type (member :real :complex nil) :read-only t)
266 ;; The upper and lower bounds on the value, or NIL if there is no
267 ;; bound. If a list of a number, the bound is exclusive. Integer
268 ;; types never have exclusive bounds, i.e. they may have them on
269 ;; input, but they're canonicalized to inclusive bounds before we
271 (low nil :type (or number cons null) :read-only t)
272 (high nil :type (or number cons null) :read-only t))
274 ;;; Impose canonicalization rules for NUMERIC-TYPE. Note that in some
275 ;;; cases, despite the name, we return *EMPTY-TYPE* instead of a
277 (defun make-numeric-type (&key class format (complexp :real) low high
279 ;; if interval is empty
282 (if (or (consp low) (consp high)) ; if either bound is exclusive
283 (>= (type-bound-number low) (type-bound-number high))
286 (multiple-value-bind (canonical-low canonical-high)
289 ;; INTEGER types always have their LOW and HIGH bounds
290 ;; represented as inclusive, not exclusive values.
291 (values (if (consp low)
292 (1+ (type-bound-number low))
295 (1- (type-bound-number high))
298 ;; no canonicalization necessary
300 (when (and (eq class 'rational)
301 (integerp canonical-low)
302 (integerp canonical-high)
303 (= canonical-low canonical-high))
304 (setf class 'integer))
305 (%make-numeric-type :class class
310 :enumerable enumerable))))
312 (defun modified-numeric-type (base
314 (class (numeric-type-class base))
315 (format (numeric-type-format base))
316 (complexp (numeric-type-complexp base))
317 (low (numeric-type-low base))
318 (high (numeric-type-high base))
319 (enumerable (numeric-type-enumerable base)))
320 (make-numeric-type :class class
325 :enumerable enumerable))
327 (defstruct (character-set-type
329 (class-info (type-class-or-lose 'character-set)))
330 (:constructor %make-character-set-type)
332 (pairs (missing-arg) :type list :read-only t))
333 (defun make-character-set-type (&key pairs)
334 ; (aver (equal (mapcar #'car pairs)
335 ; (sort (mapcar #'car pairs) #'<)))
336 ;; aver that the cars of the list elements are sorted into increasing order
337 (aver (or (null pairs)
338 (do ((p pairs (cdr p)))
340 (when (> (caar p) (caadr p)) (return nil)))))
341 (let ((pairs (let (result)
342 (do ((pairs pairs (cdr pairs)))
343 ((null pairs) (nreverse result))
344 (destructuring-bind (low . high) (car pairs)
345 (loop for (low1 . high1) in (cdr pairs)
346 if (<= low1 (1+ high))
347 do (progn (setf high (max high high1))
348 (setf pairs (cdr pairs)))
349 else do (return nil))
351 ((>= low sb!xc:char-code-limit))
353 (t (push (cons (max 0 low)
354 (min high (1- sb!xc:char-code-limit)))
358 (%make-character-set-type :pairs pairs))))
360 ;;; An ARRAY-TYPE is used to represent any array type, including
361 ;;; things such as SIMPLE-BASE-STRING.
362 (defstruct (array-type (:include ctype
363 (class-info (type-class-or-lose 'array)))
364 (:constructor %make-array-type)
366 ;; the dimensions of the array, or * if unspecified. If a dimension
367 ;; is unspecified, it is *.
368 (dimensions '* :type (or list (member *)))
369 ;; Is this not a simple array type? (:MAYBE means that we don't know.)
370 (complexp :maybe :type (member t nil :maybe))
371 ;; the element type as originally specified
372 (element-type (missing-arg) :type ctype)
373 ;; the element type as it is specialized in this implementation
374 (specialized-element-type *wild-type* :type ctype))
375 (define-cached-synonym make-array-type)
377 ;;; A MEMBER-TYPE represent a use of the MEMBER type specifier. We
378 ;;; bother with this at this level because MEMBER types are fairly
379 ;;; important and union and intersection are well defined.
380 (defstruct (member-type (:include ctype
381 (class-info (type-class-or-lose 'member))
384 (:constructor %make-member-type (xset fp-zeroes))
385 #-sb-xc-host (:pure nil))
386 (xset (missing-arg) :type xset)
387 (fp-zeroes (missing-arg) :type list))
388 (defun make-member-type (&key xset fp-zeroes members)
390 (aver (not fp-zeroes))
391 (setf xset (alloc-xset))
392 (dolist (elt members)
394 (pushnew elt fp-zeroes)
395 (add-to-xset elt xset))))
396 ;; if we have a pair of zeros (e.g. 0.0d0 and -0.0d0), then we can
397 ;; canonicalize to (DOUBLE-FLOAT 0.0d0 0.0d0), because numeric
398 ;; ranges are compared by arithmetic operators (while MEMBERship is
399 ;; compared by EQL). -- CSR, 2003-04-23
402 (do ((tail (cdr fp-zeroes) (cdr tail))
403 (zero (car fp-zeroes) (car tail)))
406 `(let ((neg (neg-fp-zero zero)))
407 (if (member neg tail)
408 (push (ctype-of ,c) union-types)
409 (push zero unpaired)))))
411 (single-float (frob 0.0f0))
412 (double-float (frob 0.0d0))
414 (long-float (frob 0.0l0)))))
415 ;; The actual member-type contains the XSET (with no FP zeroes),
416 ;; and a list of unpaired zeroes.
417 (let ((member-type (unless (and (xset-empty-p xset) (not unpaired))
418 (%make-member-type xset unpaired))))
420 (make-union-type t (if member-type
421 (cons member-type union-types)
428 (defun member-type-size (type)
429 (+ (length (member-type-fp-zeroes type))
430 (xset-count (member-type-xset type))))
432 (defun member-type-member-p (x type)
434 (and (member x (member-type-fp-zeroes type)) t)
435 (xset-member-p x (member-type-xset type))))
437 (defun mapcar-member-type-members (function type)
438 (declare (function function))
440 (map-xset (lambda (x)
441 (results (funcall function x)))
442 (member-type-xset type))
443 (dolist (zero (member-type-fp-zeroes type))
444 (results (funcall function zero)))
447 (defun mapc-member-type-members (function type)
448 (declare (function function))
449 (map-xset function (member-type-xset type))
450 (dolist (zero (member-type-fp-zeroes type))
451 (funcall function zero)))
453 (defun member-type-members (type)
454 (append (member-type-fp-zeroes type)
455 (xset-members (member-type-xset type))))
457 ;;; A COMPOUND-TYPE is a type defined out of a set of types, the
458 ;;; common parent of UNION-TYPE and INTERSECTION-TYPE.
459 (defstruct (compound-type (:include ctype
460 (might-contain-other-types-p t))
463 (types nil :type list :read-only t))
465 ;;; A UNION-TYPE represents a use of the OR type specifier which we
466 ;;; couldn't canonicalize to something simpler. Canonical form:
467 ;;; 1. All possible pairwise simplifications (using the UNION2 type
468 ;;; methods) have been performed. Thus e.g. there is never more
469 ;;; than one MEMBER-TYPE component. FIXME: As of sbcl-0.6.11.13,
470 ;;; this hadn't been fully implemented yet.
471 ;;; 2. There are never any UNION-TYPE components.
472 (defstruct (union-type (:include compound-type
473 (class-info (type-class-or-lose 'union)))
474 (:constructor %make-union-type (enumerable types))
476 (define-cached-synonym make-union-type)
478 ;;; An INTERSECTION-TYPE represents a use of the AND type specifier
479 ;;; which we couldn't canonicalize to something simpler. Canonical form:
480 ;;; 1. All possible pairwise simplifications (using the INTERSECTION2
481 ;;; type methods) have been performed. Thus e.g. there is never more
482 ;;; than one MEMBER-TYPE component.
483 ;;; 2. There are never any INTERSECTION-TYPE components: we've
484 ;;; flattened everything into a single INTERSECTION-TYPE object.
485 ;;; 3. There are never any UNION-TYPE components. Either we should
486 ;;; use the distributive rule to rearrange things so that
487 ;;; unions contain intersections and not vice versa, or we
488 ;;; should just punt to using a HAIRY-TYPE.
489 (defstruct (intersection-type (:include compound-type
490 (class-info (type-class-or-lose
492 (:constructor %make-intersection-type
496 ;;; Return TYPE converted to canonical form for a situation where the
497 ;;; "type" '* (which SBCL still represents as a type even though ANSI
498 ;;; CL defines it as a related but different kind of placeholder) is
499 ;;; equivalent to type T.
500 (defun type-*-to-t (type)
501 (if (type= type *wild-type*)
505 ;;; A CONS-TYPE is used to represent a CONS type.
506 (defstruct (cons-type (:include ctype (class-info (type-class-or-lose 'cons)))
508 %make-cons-type (car-type
511 ;; the CAR and CDR element types (to support ANSI (CONS FOO BAR) types)
513 ;; FIXME: Most or all other type structure slots could also be :READ-ONLY.
514 (car-type (missing-arg) :type ctype :read-only t)
515 (cdr-type (missing-arg) :type ctype :read-only t))
516 (defun make-cons-type (car-type cdr-type)
517 (aver (not (or (eq car-type *wild-type*)
518 (eq cdr-type *wild-type*))))
519 (if (or (eq car-type *empty-type*)
520 (eq cdr-type *empty-type*))
522 (%make-cons-type car-type cdr-type)))
524 (defun cons-type-length-info (type)
525 (declare (type cons-type type))
526 (do ((min 1 (1+ min))
527 (cdr (cons-type-cdr-type type) (cons-type-cdr-type cdr)))
528 ((not (cons-type-p cdr))
530 ((csubtypep cdr (specifier-type 'null))
532 ((csubtypep *universal-type* cdr)
534 ((type/= (type-intersection (specifier-type 'cons) cdr) *empty-type*)
536 ((type/= (type-intersection (specifier-type 'null) cdr) *empty-type*)
538 (t (values min :maybe))))
541 ;;; A SIMD-PACK-TYPE is used to represent a SIMD-PACK type.
543 (defstruct (simd-pack-type
544 (:include ctype (class-info (type-class-or-lose 'simd-pack)))
545 (:constructor %make-simd-pack-type (element-type))
547 (element-type (missing-arg)
548 :type (cons #||(member #.*simd-pack-element-types*) ||#)
552 (defun make-simd-pack-type (element-type)
553 (aver (neq element-type *wild-type*))
554 (if (eq element-type *empty-type*)
556 (%make-simd-pack-type
557 (dolist (pack-type *simd-pack-element-types*
558 (error "~S element type must be a subtype of ~
559 ~{~S~#[~;, or ~:;, ~]~}."
560 'simd-pack *simd-pack-element-types*))
561 (when (csubtypep element-type (specifier-type pack-type))
562 (return (list pack-type)))))))
567 ;;; Return the type structure corresponding to a type specifier. We
568 ;;; pick off structure types as a special case.
570 ;;; Note: VALUES-SPECIFIER-TYPE-CACHE-CLEAR must be called whenever a
571 ;;; type is defined (or redefined).
572 (defun-cached (values-specifier-type
573 :hash-function (lambda (x)
574 (logand (sxhash x) #x3FF))
576 :init-wrapper !cold-init-forms)
577 ((orig equal-but-no-car-recursion))
578 (let ((u (uncross orig)))
579 (or (info :type :builtin u)
580 (let ((spec (typexpand u)))
582 ((and (not (eq spec u))
583 (info :type :builtin spec)))
584 ((and (consp spec) (symbolp (car spec))
585 (info :type :builtin (car spec))
586 (let ((expander (info :type :expander (car spec))))
587 (and expander (values-specifier-type (funcall expander spec))))))
588 ((eq (info :type :kind spec) :instance)
589 (find-classoid spec))
590 ((typep spec 'classoid)
591 (if (typep spec 'built-in-classoid)
592 (or (built-in-classoid-translation spec) spec)
595 (when (and (atom spec)
596 (member spec '(and or not member eql satisfies values)))
597 (error "The symbol ~S is not valid as a type specifier." spec))
598 (let* ((lspec (if (atom spec) (list spec) spec))
599 (fun (info :type :translator (car lspec))))
602 ((or (and (consp spec) (symbolp (car spec))
603 (not (info :type :builtin (car spec))))
604 (and (symbolp spec) (not (info :type :builtin spec))))
605 (when (and *type-system-initialized*
606 (not (eq (info :type :kind spec)
607 :forthcoming-defclass-type)))
608 (signal 'parse-unknown-type :specifier spec))
609 ;; (The RETURN-FROM here inhibits caching; this
610 ;; does not only make sense from a compiler
611 ;; diagnostics point of view but is also
612 ;; indispensable for proper workingness of
613 ;; VALID-TYPE-SPECIFIER-P.)
614 (return-from values-specifier-type
615 (make-unknown-type :specifier spec)))
617 (error "bad thing to be a type specifier: ~S"
620 ;;; This is like VALUES-SPECIFIER-TYPE, except that we guarantee to
621 ;;; never return a VALUES type.
622 (defun specifier-type (x)
623 (let ((res (values-specifier-type x)))
624 (when (or (values-type-p res)
625 ;; bootstrap magic :-(
626 (and (named-type-p res)
627 (eq (named-type-name res) '*)))
628 (error "VALUES type illegal in this context:~% ~S" x))
631 (defun single-value-specifier-type (x)
636 (defun typexpand-1 (type-specifier &optional env)
638 "Takes and expands a type specifier once like MACROEXPAND-1.
639 Returns two values: the expansion, and a boolean that is true when
641 (declare (type type-specifier type-specifier))
642 (declare (ignore env))
643 (multiple-value-bind (expander lspec)
644 (let ((spec type-specifier))
645 (cond ((and (symbolp spec) (info :type :builtin spec))
646 ;; We do not expand builtins even though it'd be
647 ;; possible to do so sometimes (e.g. STRING) for two
650 ;; a) From a user's point of view, CL types are opaque.
652 ;; b) so (EQUAL (TYPEXPAND 'STRING) (TYPEXPAND-ALL 'STRING))
655 (values (info :type :expander spec) (list spec)))
656 ((and (consp spec) (symbolp (car spec)) (info :type :builtin (car spec)))
659 ((and (consp spec) (symbolp (car spec)))
660 (values (info :type :expander (car spec)) spec))
663 (values (funcall expander lspec) t)
664 (values type-specifier nil))))
666 (defun typexpand (type-specifier &optional env)
668 "Takes and expands a type specifier repeatedly like MACROEXPAND.
669 Returns two values: the expansion, and a boolean that is true when
671 (declare (type type-specifier type-specifier))
672 (multiple-value-bind (expansion flag)
673 (typexpand-1 type-specifier env)
675 (values (typexpand expansion env) t)
676 (values expansion flag))))
678 (defun typexpand-all (type-specifier &optional env)
680 "Takes and expands a type specifier recursively like MACROEXPAND-ALL."
681 (declare (type type-specifier type-specifier))
682 (declare (ignore env))
683 ;; I first thought this would not be a good implementation because
684 ;; it signals an error on e.g. (CONS 1 2) until I realized that
685 ;; walking and calling TYPEXPAND would also result in errors, and
686 ;; it actually makes sense.
688 ;; There's still a small problem in that
689 ;; (TYPEXPAND-ALL '(CONS * FIXNUM)) => (CONS T FIXNUM)
690 ;; whereas walking+typexpand would result in (CONS * FIXNUM).
692 ;; Similiarly, (TYPEXPAND-ALL '(FUNCTION (&REST T) *)) => FUNCTION.
693 (type-specifier (values-specifier-type type-specifier)))
695 (defun defined-type-name-p (name &optional env)
697 "Returns T if NAME is known to name a type specifier, otherwise NIL."
698 (declare (symbol name))
699 (declare (ignore env))
700 (and (info :type :kind name) t))
702 (defun valid-type-specifier-p (type-specifier &optional env)
704 "Returns T if TYPE-SPECIFIER is a valid type specifier, otherwise NIL.
706 There may be different metrics on what constitutes a \"valid type
707 specifier\" depending on context. If this function does not suit your
708 exact need, you may be able to craft a particular solution using a
709 combination of DEFINED-TYPE-NAME-P and the TYPEXPAND functions.
711 The definition of \"valid type specifier\" employed by this function
712 is based on the following mnemonic:
714 \"Would TYPEP accept it as second argument?\"
716 Except that unlike TYPEP, this function fully supports compound
717 FUNCTION type specifiers, and the VALUES type specifier, too.
719 In particular, VALID-TYPE-SPECIFIER-P will return NIL if
720 TYPE-SPECIFIER is not a class, not a symbol that is known to name a
721 type specifier, and not a cons that represents a known compound type
722 specifier in a syntactically and recursively correct way.
726 (valid-type-specifier-p '(cons * *)) => T
727 (valid-type-specifier-p '#:foo) => NIL
728 (valid-type-specifier-p '(cons * #:foo)) => NIL
729 (valid-type-specifier-p '(cons 1 *) => NIL
732 (declare (ignore env))
733 (handler-case (prog1 t (values-specifier-type type-specifier))
734 (parse-unknown-type () nil)
737 ;;; Note that the type NAME has been (re)defined, updating the
738 ;;; undefined warnings and VALUES-SPECIFIER-TYPE cache.
739 (defun %note-type-defined (name)
740 (declare (symbol name))
741 (note-name-defined name :type)
742 (values-specifier-type-cache-clear)
746 (!defun-from-collected-cold-init-forms !early-type-cold-init)