From e511ed14d4a20cb9de2523f052b0f23a1dde1115 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Tue, 10 Jun 2003 11:08:09 +0000 Subject: [PATCH] 0.8.0.59: Make VALUES derive type optimizer accurate: ... since we have this nice interpretation of VALUES types, use it in the VALUES derive-type optimizer -- we will return exactly as many values as VALUES has arguments; ... fix the bugs that this reveals in sbcl; :-) ... enables us to detect more bogosity: test for some more type mismatches being caught. ... (relatedly) fix one more duplicate definition in sb-bsd-sockets Array initializer type warning fix: ... don't do (csubtypep (ctype-of x) eltype), because that's wrong for e.g. X = #\a and eltype being STANDARD-CHAR; use CTYPEP instead. --- NEWS | 2 ++ contrib/sb-bsd-sockets/constants.lisp | 4 ---- src/compiler/array-tran.lisp | 5 ++--- src/compiler/generic/vm-fndb.lisp | 10 +++++----- src/compiler/generic/vm-tran.lisp | 2 +- src/compiler/info-functions.lisp | 2 +- src/compiler/srctran.lisp | 3 ++- tests/compiler.test.sh | 21 ++++++++++++++++++++- version.lisp-expr | 2 +- 9 files changed, 34 insertions(+), 17 deletions(-) diff --git a/NEWS b/NEWS index 98e5991..b4e3018 100644 --- a/NEWS +++ b/NEWS @@ -1834,6 +1834,8 @@ changes in sbcl-0.8.1 relative to sbcl-0.8.0: ** FIND-METHOD signals an error if the lengths of the specializers is incompatible with the generic function, even if the ERRORP argument is true. + ** TYPE-OF returns recognizeable subtypes of all built-in-types of + which its argument is a member. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/contrib/sb-bsd-sockets/constants.lisp b/contrib/sb-bsd-sockets/constants.lisp index e52aab1..2629aef 100644 --- a/contrib/sb-bsd-sockets/constants.lisp +++ b/contrib/sb-bsd-sockets/constants.lisp @@ -167,10 +167,6 @@ (addr (* t)) (len integer) (af integer))) - (:structure hostent ("struct hostent" - ((* t) name "char *" "h_name") - (integer length "int" "h_length"))) - (:function setsockopt ("setsockopt" integer (socket integer) (level integer) diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 724440d..adca769 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -303,8 +303,7 @@ (when (constant-continuation-p initial-element) (let ((value (continuation-value initial-element))) (cond - ((not (csubtypep (ctype-of value) - (saetp-ctype saetp))) + ((not (ctypep value (saetp-ctype saetp))) ;; this case will cause an error at runtime, so we'd ;; better WARN about it now. (compiler-warn "~@<~S is not a ~S (which is the ~ @@ -312,7 +311,7 @@ value (type-specifier (saetp-ctype saetp)) eltype)) - ((not (csubtypep (ctype-of value) eltype-type)) + ((not (ctypep value eltype-type)) ;; this case will not cause an error at runtime, but ;; it's still worth STYLE-WARNing about. (compiler-style-warn "~S is not a ~S." diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 2a4857b..edfd9da 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -240,23 +240,23 @@ (defknown copy-to-system-area ((simple-unboxed-array (*)) index system-area-pointer index index) - null + (values) ()) (defknown copy-from-system-area (system-area-pointer index (simple-unboxed-array (*)) index index) - null + (values) ()) (defknown system-area-copy (system-area-pointer index system-area-pointer index index) - null + (values) ()) (defknown bit-bash-copy ((simple-unboxed-array (*)) index (simple-unboxed-array (*)) index index) - null + (values) ()) ;;; (not really a bit-bashing routine, but starting to take over from @@ -264,7 +264,7 @@ (defknown %byte-blt ((or (simple-unboxed-array (*)) system-area-pointer) index (or (simple-unboxed-array (*)) system-area-pointer) index index) - null + (values) ()) ;;;; code/function/fdefn object manipulation routines diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 7c4cc00..852a086 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -348,7 +348,7 @@ (memmove (sap+ (sapify dst) dst-start) (sap+ (sapify src) src-start) (- dst-end dst-start))) - nil)) + (values))) ;;;; transforms for EQL of floating point values diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp index a5abe11..b4f3c2e 100644 --- a/src/compiler/info-functions.lisp +++ b/src/compiler/info-functions.lisp @@ -258,7 +258,7 @@ (typecase x (structure-class (values (info :type :documentation (class-name x)))) (t (and (typep x 'symbol) (values (info :type :documentation x)))))) - (setf (info :setf :documentation x)) + (setf (values (info :setf :documentation x))) ((t) (typecase x (function (%fun-doc x)) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 124d841..ac6527a 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -2265,7 +2265,8 @@ (values-specifier-type `(values ,@(mapcar (lambda (x) (type-specifier (continuation-type x))) - values)))) + values) + &optional))) ;;;; byte operations ;;;; diff --git a/tests/compiler.test.sh b/tests/compiler.test.sh index 409e0b9..87ca1c1 100644 --- a/tests/compiler.test.sh +++ b/tests/compiler.test.sh @@ -155,7 +155,8 @@ cat > $tmpfilename < $tmpfilename < $tmpfilename < $tmpfilename < $tmpfilename <