2:
DEFSTRUCT should almost certainly overwrite the old LAYOUT information
instead of just punting when a contradictory structure definition
- is loaded.
+ is loaded. As it is, if you redefine DEFSTRUCTs in a way which
+ changes their layout, you probably have to rebuild your entire
+ program, even if you know or guess enough about the internals of
+ SBCL to wager that this (undefined in ANSI) operation would be safe.
3:
It should cause a STYLE-WARNING, not a full WARNING, when a structure
very good when the stream argument has the wrong type, because
the operation tries to fall through to Gray stream code, and then
dies because it's undefined. E.g.
- (PRINT-UNREADABLE-OBJECT (*STANDARD-OUTPUT* 1))
+ (PRINT-UNREADABLE-OBJECT (*STANDARD-OUTPUT* 1)) ..)
gives the error message
error in SB-KERNEL::UNDEFINED-SYMBOL-ERROR-HANDLER:
The function SB-IMPL::STREAM-WRITE-STRING is undefined.
it doesn't seem to affect SBCL after all
* The system now recovers better from non-PACKAGE values of the *PACKAGE*
variable.
+* The system now understands compound CONS types (e.g. (CONS FIXNUM T))
+ as required by ANSI. (thanks to Douglas Crosher's CMU CL patches, with
+ some porting work by Martin Atzmueller)
"*COLD-INIT-COMPLETE-P*"
"!COLD-INIT-FORMS" "COMPLEX-DOUBLE-FLOAT-P"
"COMPLEX-FLOAT-P" "COMPLEX-LONG-FLOAT-P"
- "COMPLEX-RATIONAL-P" "COMPLEX-SINGLE-FLOAT-P"
- "COMPLEX-VECTOR-P" "CONSED-SEQUENCE" "CONSTANT" "CONSTANT-TYPE"
+ "COMPLEX-RATIONAL-P" "COMPLEX-SINGLE-FLOAT-P" "COMPLEX-VECTOR-P"
+ "CONS-TYPE" "CONS-TYPE-CAR-TYPE" "CONS-TYPE-CDR-TYPE"
+ "CONS-TYPE-P"
+ "CONSED-SEQUENCE" "CONSTANT" "CONSTANT-TYPE"
"CONSTANT-TYPE-P" "CONSTANT-TYPE-TYPE"
"CONTAINING-INTEGER-TYPE"
"CONTROL-STACK-POINTER-SAP" "COPY-FROM-SYSTEM-AREA"
"LONG-FLOAT-LOW-BITS" "LONG-FLOAT-MID-BITS" "LONG-FLOAT-P"
"LRA" "LRA-CODE-HEADER" "LRA-P"
"MAKE-ALIEN-TYPE-TYPE" "MAKE-ARGS-TYPE"
- "MAKE-ARRAY-HEADER" "MAKE-ARRAY-TYPE" "MAKE-DOUBLE-FLOAT"
- "MAKE-FUNCTION-TYPE"
+ "MAKE-ARRAY-HEADER" "MAKE-ARRAY-TYPE" "MAKE-CONS-TYPE"
+ "MAKE-DOUBLE-FLOAT" "MAKE-FUNCTION-TYPE"
"MAKE-KEY-INFO" "MAKE-LISP-OBJ" "MAKE-LONG-FLOAT"
"MAKE-MEMBER-TYPE" "MAKE-NAMED-TYPE"
"MAKE-NULL-LEXENV" "MAKE-NUMERIC-TYPE"
generic-sequence collection))
(cons
:codes (#.sb!vm:list-pointer-type)
+ :translation cons
:inherits (list sequence
mutable-sequence mutable-collection
generic-sequence collection))
:complexp (not (typep x 'simple-array))
:element-type etype
:specialized-element-type etype)))
- (cons (sb!xc:find-class 'cons))
+ (cons (specifier-type 'cons))
(character
(cond ((typep x 'standard-char)
;; (Note that SBCL doesn't distinguish between BASE-CHAR and
;;; A UNION-TYPE represents a use of the OR type specifier which can't
;;; be canonicalized to something simpler. Canonical form:
-;;; 1. There is never more than one Member-Type component.
-;;; 2. There are never any Union-Type components.
+;;; 1. There is never more than one MEMBER-TYPE component.
+;;; 2. There are never any UNION-TYPE components.
(defstruct (union-type (:include ctype
(class-info (type-class-or-lose 'union)))
(:constructor %make-union-type (enumerable types)))
;; The types in the union.
(types nil :type list))
-;;; Note that the type Name has been (re)defined, updating the
+;;; Return TYPE converted to canonical form for a situation where the
+;;; type '* is equivalent to type T.
+(defun type-*-to-t (type)
+ (if (type= type *wild-type*)
+ *universal-type*
+ type))
+
+;;; A CONS-TYPE is used to represent a CONS type.
+(defstruct (cons-type (:include ctype
+ (:class-info (type-class-or-lose 'cons)))
+ (:constructor
+ ;; ANSI says that for CAR and CDR subtype
+ ;; specifiers '* is equivalent to T. In order
+ ;; to avoid special cases in SUBTYPEP and
+ ;; possibly elsewhere, we slam all CONS-TYPE
+ ;; objects into canonical form w.r.t. this
+ ;; equivalence at creation time.
+ make-cons-type (car-raw-type
+ cdr-raw-type
+ &aux
+ (car-type (type-*-to-t car-raw-type))
+ (cdr-type (type-*-to-t cdr-raw-type)))))
+ ;; the CAR and CDR element types (to support ANSI (CONS FOO BAR) types)
+ ;;
+ ;; FIXME: Most or all other type structure slots could also be :READ-ONLY.
+ (car-type (required-argument) :type ctype :read-only t)
+ (cdr-type (required-argument) :type ctype :read-only t))
+
+;;; Note that the type NAME has been (re)defined, updating the
;;; undefined warnings and VALUES-SPECIFIER-TYPE cache.
(defun %note-type-defined (name)
(declare (symbol name))
(return (make-hairy-type :specifier spec)))
(setq res int))))))
\f
+;;;; CONS types
+
+(define-type-class cons)
+
+(def-type-translator cons (&optional (car-type-spec '*) (cdr-type-spec '*))
+ (make-cons-type (specifier-type car-type-spec)
+ (specifier-type cdr-type-spec)))
+
+(define-type-method (cons :unparse) (type)
+ (let ((car-eltype (type-specifier (cons-type-car-type type)))
+ (cdr-eltype (type-specifier (cons-type-cdr-type type))))
+ (if (and (member car-eltype '(t *))
+ (member cdr-eltype '(t *)))
+ 'cons
+ `(cons ,car-eltype ,cdr-eltype))))
+
+(define-type-method (cons :simple-=) (type1 type2)
+ (declare (type cons-type type1 type2))
+ (and (type= (cons-type-car-type type1) (cons-type-car-type type2))
+ (type= (cons-type-cdr-type type1) (cons-type-cdr-type type2))))
+
+(define-type-method (cons :simple-subtypep) (type1 type2)
+ (declare (type cons-type type1 type2))
+ (multiple-value-bind (val-car win-car)
+ (csubtypep (cons-type-car-type type1) (cons-type-car-type type2))
+ (multiple-value-bind (val-cdr win-cdr)
+ (csubtypep (cons-type-cdr-type type1) (cons-type-cdr-type type2))
+ (if (and val-car val-cdr)
+ (values t (and win-car win-cdr))
+ (values nil (or win-car win-cdr))))))
+
+;;; Give up if a precise type is not possible, to avoid returning
+;;; overly general types.
+(define-type-method (cons :simple-union) (type1 type2)
+ (declare (type cons-type type1 type2))
+ (let ((car-type1 (cons-type-car-type type1))
+ (car-type2 (cons-type-car-type type2))
+ (cdr-type1 (cons-type-cdr-type type1))
+ (cdr-type2 (cons-type-cdr-type type2)))
+ (cond ((type= car-type1 car-type2)
+ (make-cons-type car-type1
+ (type-union cdr-type1 cdr-type2)))
+ ((type= cdr-type1 cdr-type2)
+ (make-cons-type (type-union cdr-type1 cdr-type2)
+ cdr-type1)))))
+
+(define-type-method (cons :simple-intersection) (type1 type2)
+ (declare (type cons-type type1 type2))
+ (multiple-value-bind (int-car win-car)
+ (type-intersection (cons-type-car-type type1)
+ (cons-type-car-type type2))
+ (multiple-value-bind (int-cdr win-cdr)
+ (type-intersection (cons-type-cdr-type type1)
+ (cons-type-cdr-type type2))
+ (values (make-cons-type int-car int-cdr)
+ (and win-car win-cdr)))))
+\f
;;; Return the type that describes all objects that are in X but not
;;; in Y. If we can't determine this type, then return NIL.
;;;
named-type
member-type
array-type
- sb!xc:built-in-class)
+ sb!xc:built-in-class
+ cons-type)
(values (%typep obj type) t))
(sb!xc:class
(if (if (csubtypep type (specifier-type 'funcallable-instance))
\f
;;;; miscellaneous interfaces
-;;; Clear memoization of all type system operations that can be altered by
-;;; type definition/redefinition.
+;;; Clear memoization of all type system operations that can be
+;;; altered by type definition/redefinition.
(defun clear-type-caches ()
(when *type-system-initialized*
(dolist (sym '(values-specifier-type-cache-clear
(funcall (symbol-function sym))))
(values))
-;;; Like TYPE-OF, only we return a CTYPE structure instead of a type specifier,
-;;; and we try to return the type most useful for type checking, rather than
-;;; trying to come up with the one that the user might find most informative.
+;;; Like TYPE-OF, only we return a CTYPE structure instead of a type
+;;; specifier, and we try to return the type most useful for type
+;;; checking, rather than trying to come up with the one that the user
+;;; might find most informative.
(declaim (ftype (function (t) ctype) ctype-of))
(defun-cached (ctype-of
:hash-function (lambda (x) (logand (sxhash x) #x1FF))
:complexp (not (typep x 'simple-array))
:element-type etype
:specialized-element-type etype)))
+ (cons
+ (make-cons-type *universal-type* *universal-type*))
(t
(sb!xc:class-of x))))
(dolist (type (union-type-types type))
(when (%%typep object type)
(return t))))
+ (cons-type
+ (and (consp object)
+ (%%typep (car object) (cons-type-car-type type))
+ (%%typep (cdr object) (cons-type-cdr-type type))))
(unknown-type
;; dunno how to do this ANSIly -- WHN 19990413
#+sb-xc-host (error "stub: %%TYPEP UNKNOWN-TYPE in xcompilation host")
;;; versions, and a string like "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.8.14"
+"0.6.8.15"
projects / sbcl.git / commitdiff