From: William Harold Newman Date: Fri, 2 Mar 2001 17:36:19 +0000 (+0000) Subject: 0.6.11.9: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8624c52d7620e8a4d3de23c363e843a10815f4f4;p=sbcl.git 0.6.11.9: enabled some INTERSECTION-TYPE stuff made INTERSECTION-TYPE and UNION-TYPE share a parent This changes the layout of UNION-TYPE: new fasl version again.. defined placeholder SOURCE-TRANSFORM-INTERSECTION-TYPEP --- diff --git a/BUGS b/BUGS index 8fa26ae..4ffc694 100644 --- a/BUGS +++ b/BUGS @@ -132,7 +132,9 @@ WORKAROUND: to SBCL, I was looking for complexity to delete, and I thought it was safe to just delete support for floating point infinities. It wasn't: they're generated by the floating point hardware even when we remove support - for them in software. -- WHN] Support for them should be restored. + for them in software. Also we claim the :IEEE-FLOATING-POINT feature, + and I think that means we should support infinities.-- WHN] Support + for them should be restored. 14: The ANSI syntax for non-STANDARD method combination types in CLOS is diff --git a/NEWS b/NEWS index 32f02cb..196ae66 100644 --- a/NEWS +++ b/NEWS @@ -685,19 +685,26 @@ changes in sbcl-0.6.12 relative to sbcl-0.6.11: * many patches ported from CMU CL by Martin Atzmueller, with half a dozen bug fixes in pretty-printing and the debugger, and half a dozen others elsewhere -?? The :PROPAGATE-FLOAT-TYPE and :PROPAGATE-FUN-TYPE target features +?? improved support for intersection types, fixing bug 12 (E.g., now + (SUBTYPEP 'KEYWORD 'SYMBOL)=>T,T.) +?? The :PROPAGATE-FLOAT-TYPE and :PROPAGATE-FUN-TYPE features are now supported, and enabled by default. Thus, the compiler can handle many floating point and complex operations much less inefficiently. (Thus e.g. you can implement a complex FFT without consing!) +?? unscrewed floating point infinities (bug 13) in order to support + :PROPAGATE-FLOAT-TYPE and :PROPAGATE-FUN-TYPE features +?? some minor ANSIfication of type specifications: bare 'AND and 'OR + are no longer valid type specifiers, so e.g. (TYPEP 11 'AND) now + signals an error; and SATISFIES requires its predicate to be a + symbol, not a function object * various fixes to make the cross-compiler more portable to ANSI-conforming-but-different cross-compilation hosts (notably Lispworks for Windows, following bug reports from Arthur Lemmens) * a new workaround to make the cross-compiler portable to CMU CL again despite its non-ANSI EVAL-WHEN, thanks to Martin Atzmueller -* new fasl file format version number (because a disused value was - removed from the sequence of byte code opcodes, causing the other - opcodes to change) +* new fasl file format version number (because of changes in byte + code opcodes and in internal representation of (OR ..) types) planned incompatible changes in 0.7.x: * The debugger prompt sequence now goes "5]", "5[2]", "5[3]", etc. @@ -710,4 +717,8 @@ planned incompatible changes in 0.7.x: e.g. UNPROFILE will interact with TRACE and UNTRACE. (This shouldn't matter, though, unless you are using profiling. If you never profile anything, TRACE should continue to behave as before.) -* The fasl file extension may change, perhaps to ".fasl". \ No newline at end of file +* The fasl file extension may change, perhaps to ".fasl". +* The default output representation for unprintable ASCII characters + which, unlike e.g. #\Newline, don't have names defined in the + ANSI Common Lisp standard, may change to their ASCII symbolic + names: #\Nul, #\Soh, #\Stx, etc. diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index eef14df..afcc413 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -923,6 +923,7 @@ is a good idea, but see SB-SYS for blurring of boundaries." "!COLD-INIT-FORMS" "COMPLEX-DOUBLE-FLOAT-P" "COMPLEX-FLOAT-P" "COMPLEX-LONG-FLOAT-P" "COMPLEX-RATIONAL-P" "COMPLEX-SINGLE-FLOAT-P" "COMPLEX-VECTOR-P" + "COMPOUND-TYPE" "COMPOUND-TYPE-P" "COMPOUND-TYPE-TYPES" "CONS-TYPE" "CONS-TYPE-CAR-TYPE" "CONS-TYPE-CDR-TYPE" "CONS-TYPE-P" "CONSED-SEQUENCE" "CONSTANT" "CONSTANT-TYPE" @@ -966,6 +967,8 @@ is a good idea, but see SB-SYS for blurring of boundaries." "INDEX-TOO-LARGE-ERROR" "INTEGER-DECODE-DOUBLE-FLOAT" "INTEGER-DECODE-LONG-FLOAT" "INTEGER-DECODE-SINGLE-FLOAT" "INTERNAL-ERROR" "INTERNAL-TIME" + "INTERSECTION-TYPE" "INTERSECTION-TYPE-P" + "INTERSECTION-TYPE-TYPES" "INVALID-ARGUMENT-COUNT-ERROR" "INVALID-ARRAY-INDEX-ERROR" "INVALID-UNWIND-ERROR" "IRRATIONAL" "JUST-DUMP-IT-NORMALLY" diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 1b34a4e..785989f 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -186,38 +186,54 @@ ;;; things such as SIMPLE-STRING. (defstruct (array-type (:include ctype (class-info (type-class-or-lose 'array)))) - ;; The dimensions of the array. * if unspecified. If a dimension is - ;; unspecified, it is *. + ;; the dimensions of the array, or * if unspecified. If a dimension + ;; is unspecified, it is *. (dimensions '* :type (or list (member *))) ;; Is this not a simple array type? (:MAYBE means that we don't know.) (complexp :maybe :type (member t nil :maybe)) - ;; The element type as originally specified. + ;; the element type as originally specified (element-type (required-argument) :type ctype) - ;; The element type as it is specialized in this implementation. + ;; the element type as it is specialized in this implementation (specialized-element-type *wild-type* :type ctype)) -;;; The Member-Type represents uses of the MEMBER type specifier. We +;;; A MEMBER-TYPE represent a use of the MEMBER type specifier. We ;;; bother with this at this level because MEMBER types are fairly ;;; important and union and intersection are well defined. (defstruct (member-type (:include ctype (class-info (type-class-or-lose 'member)) (enumerable t)) #-sb-xc-host (:pure nil)) - ;; The things in the set, with no duplications. + ;; the things in the set, with no duplications (members nil :type list)) +;;; A COMPOUND-TYPE is a type defined out of a set of types, +;;; the common parent of UNION-TYPE and INTERSECTION-TYPE. +(defstruct (compound-type (:include ctype) + (:constructor nil)) + (types nil :type list :read-only t)) + ;;; 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. -(defstruct (union-type (:include ctype +(defstruct (union-type (:include compound-type (class-info (type-class-or-lose 'union))) - (:constructor %make-union-type (enumerable types))) - ;; The types in the union. - (types nil :type list)) + (:constructor %make-union-type (enumerable types)))) + +;;; An INTERSECTION-TYPE represents a use of the AND 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 INTERSECTION-TYPE or UNION-TYPE components. +(defstruct (intersection-type (:include compound-type + (class-info (type-class-or-lose + 'intersection))) + (:constructor %make-intersection-type + (enumerable types)))) ;;; Return TYPE converted to canonical form for a situation where the -;;; type '* is equivalent to type T. +;;; "type" '* (which SBCL still represents as a type even though ANSI +;;; CL defines it as a related but different kind of placeholder) is +;;; equivalent to type T. (defun type-*-to-t (type) (if (type= type *wild-type*) *universal-type* diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index edf7288..1b82525 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -1666,7 +1666,6 @@ (intersection-type-types type2))) (!define-type-method (intersection :simple-subtypep) (type1 type2) - (declare (type list type1 type2)) (/show0 "entering INTERSECTION :SIMPLE-SUBTYPEP") (let ((certain? t)) (dolist (t1 (intersection-type-types type1) (values nil certain?)) @@ -1722,28 +1721,29 @@ (!define-type-method (intersection :simple-intersection :complex-intersection) (type1 type2) (/show0 "entering INTERSECTION :SIMPLE-INTERSECTION :COMPLEX-INTERSECTION") - (let ((type1types (intersection-type-types type1)) - (type2types (if (intersection-type-p type2) - (intersection-type-types type2) - (list type2)))) + (flet ((type-components (type) + (typecase type + (intersection-type (intersection-type-types type)) + (t (list type))))) (make-intersection-type-or-something - (simplify-intersection-type-types - (append type1types type2types))))) + ;; FIXME: Here and in MAKE-UNION-TYPE and perhaps elsewhere we + ;; should be looking for simplifications and putting things into + ;; canonical form. + (append (type-components type1) + (type-components type2))))) -#| -(!def-type-translator and (&rest type-specifiers) +(!def-type-translator foo-type (&rest type-specifiers) ;; Note: Between the behavior of SIMPLIFY-INTERSECTION-TYPE (which ;; will reduce to a 1-element list any list of types which CMU CL ;; could've represented) and MAKE-INTERSECTION-TYPE-OR-SOMETHING ;; (which knows to treat a 1-element intersection as the element ;; itself) we should recover CMU CL's behavior for anything which it ;; could handle usefully (i.e. could without punting to HAIRY-TYPE). - (/show0 "entering type translator for AND") + (/show0 "entering type translator for AND/FOO-TYPE") (make-intersection-type-or-something - (simplify-types (mapcar #'specifier-type type-specifiers) - #'simplify2-intersection))) -|# + (mapcar #'specifier-type type-specifiers))) ;;; (REMOVEME once INTERSECTION-TYPE works.) + (!def-type-translator and (&whole spec &rest types) (let ((res *wild-type*)) (dolist (type types res) @@ -1987,13 +1987,13 @@ (make-union-type-or-something (res))))))) (!def-type-translator array (&optional (element-type '*) - (dimensions '*)) + (dimensions '*)) (specialize-array-type (make-array-type :dimensions (canonical-array-dimensions dimensions) :element-type (specifier-type element-type)))) (!def-type-translator simple-array (&optional (element-type '*) - (dimensions '*)) + (dimensions '*)) (specialize-array-type (make-array-type :dimensions (canonical-array-dimensions dimensions) :element-type (specifier-type element-type) diff --git a/src/code/loop.lisp b/src/code/loop.lisp index 1e9dbc6..018b656 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -1198,8 +1198,8 @@ a LET-like macro, and a SETQ-like macro, which perform LOOP-style destructuring. ;;;; value accumulation: LIST (defstruct (loop-collector - (:copier nil) - (:predicate nil)) + (:copier nil) + (:predicate nil)) name class (history nil) @@ -1579,8 +1579,8 @@ a LET-like macro, and a SETQ-like macro, which perform LOOP-style destructuring. ;;;; iteration paths (defstruct (loop-path - (:copier nil) - (:predicate nil)) + (:copier nil) + (:predicate nil)) names preposition-groups inclusive-permitted diff --git a/src/code/type-class.lisp b/src/code/type-class.lisp index d1dbb0b..5562e1a 100644 --- a/src/code/type-class.lisp +++ b/src/code/type-class.lisp @@ -144,8 +144,8 @@ ) ; EVAL-WHEN (defmacro !define-type-method ((class method &rest more-methods) - lambda-list &body body) - (let ((name (symbolicate CLASS "-" method "-TYPE-METHOD"))) + lambda-list &body body) + (let ((name (symbolicate class "-" method "-TYPE-METHOD"))) `(progn (defun ,name ,lambda-list ,@body) diff --git a/src/code/typep.lisp b/src/code/typep.lisp index a21ec02..7aa0448 100644 --- a/src/code/typep.lisp +++ b/src/code/typep.lisp @@ -117,9 +117,11 @@ #+sb-xc-host (ctypep object type) #-sb-xc-host (class-typep (layout-of object) type object)) (union-type - (dolist (type (union-type-types type)) - (when (%%typep object type) - (return t)))) + (some (lambda (typ) (%%typep object typ)) + (union-type-types type))) + (intersection-type + (every (lambda (typ) (%%typep object typ)) + (intersection-type-types type))) (cons-type (and (consp object) (%%typep (car object) (cons-type-car-type type)) diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 89a6cc4..9221be2 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -52,11 +52,8 @@ (+ (function-cost found) (function-cost 'eq)) nil)))) (typecase type - (union-type - (collect ((res 0 +)) - (dolist (mem (union-type-types type)) - (res (type-test-cost mem))) - (res))) + (compound-type + (reduce #'+ (compound-type-types type) :key 'type-test-cost)) (member-type (* (length (member-type-members type)) (function-cost 'eq))) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 7e6a983..2c78ce0 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -996,12 +996,10 @@ (t type-list))) -;;; Make-Canonical-Union-Type -;;; ;;; Take a list of types and return a canonical type specifier, -;;; combining any members types together. If both positive and -;;; negative members types are present they are converted to a float -;;; type. X This would be far simpler if the type-union methods could +;;; combining any MEMBER types together. If both positive and +;;; negative MEMBER types are present they are converted to a float +;;; type. XXX This would be far simpler if the type-union methods could ;;; handle member/number unions. (defun make-canonical-union-type (type-list) (let ((members '()) diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp index e1071a8..b6ea1d8 100644 --- a/src/compiler/typetran.lisp +++ b/src/compiler/typetran.lisp @@ -299,6 +299,12 @@ `(typep ,n-obj ',(type-specifier x))) types))))))) +;;; Do source transformation for TYPEP of a known intersection type. +(defun source-transform-intersection-typep (object type) + ;; FIXME: This is just a placeholder; we should define a better + ;; version by analogy with SOURCE-TRANSFORM-UNION-TYPEP. + nil) + ;;; If necessary recurse to check the cons type. (defun source-transform-cons-typep (object type) (let* ((car-type (cons-type-car-type type)) @@ -487,6 +493,8 @@ (source-transform-hairy-typep object type)) (union-type (source-transform-union-typep object type)) + (intersection-type + (source-transform-intersection-typep object type)) (member-type `(member ,object ',(member-type-members type))) (args-type diff --git a/version.lisp-expr b/version.lisp-expr index c3a6c3f..774c739 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; 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.11.8" +"0.6.11.9"