From b956ed4f9cef685d1b49be28dcd2aec1e082d994 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Tue, 17 Jun 2003 03:12:43 +0000 Subject: [PATCH] 0.8.0.76: * Fix bug 15: enable emitting a style warning for redefining FTYPE in PROCLAIM; * fix bug 46c: uncomment the corresponding checks in COERCE; * NOTINLINE does not prevent using function type; * write SIMPLE-= method for functions; * signal STYLE-WARNING on IR1 transform redefinition; * combine conflicting tansformers for %CHECK-BOUND. --- BUGS | 21 ++++++++++++--------- src/code/coerce.lisp | 3 --- src/code/late-type.lisp | 39 +++++++++++++++++++++++++++++++++++---- src/compiler/array-tran.lisp | 16 ++++++++-------- src/compiler/knownfun.lisp | 14 ++++++++------ src/compiler/proclaim.lisp | 34 ++++++++++------------------------ tests/compiler.pure.lisp | 5 +++++ tests/type.pure.lisp | 4 ++++ version.lisp-expr | 2 +- 9 files changed, 83 insertions(+), 55 deletions(-) diff --git a/BUGS b/BUGS index 171061e..185c178 100644 --- a/BUGS +++ b/BUGS @@ -117,12 +117,6 @@ WORKAROUND: (during macroexpansion of IN-PACKAGE, during macroexpansion of DEFFOO) -15: - (SUBTYPEP '(FUNCTION (T BOOLEAN) NIL) - '(FUNCTION (FIXNUM FIXNUM) NIL)) => T, T - (Also, when this is fixed, we can enable the code in PROCLAIM which - checks for incompatible FTYPE redeclarations.) - 19: (I *think* this is a bug. It certainly seems like strange behavior. But the ANSI spec is scary, dark, and deep.. -- WHN) @@ -217,14 +211,13 @@ WORKAROUND: 46: type safety errors reported by Peter Van Eynde July 25, 2000: - c: (COERCE 'AND 'FUNCTION) returns something related to - (MACRO-FUNCTION 'AND), but ANSI says it should raise an error. k: READ-BYTE is supposed to signal TYPE-ERROR when its argument is not a binary input stream, but instead cheerfully reads from character streams, e.g. (MAKE-STRING-INPUT-STREAM "abc"). 60: The debugger LIST-LOCATIONS command doesn't work properly. + (How should it work properly?) 61: Compiling and loading @@ -703,6 +696,17 @@ WORKAROUND: (print (incf start 22)) (print (incf start 26)))))) + This example could be solved with clever enough constraint + propagation or with SSA, but consider + + (let ((x 0)) + (loop (if (random-boolean) + (incf x 2) + (incf x 5)))) + + The careful type of X is {2k+5n} :-(. Is it really important to be + able to work with unions of many intervals? + 190: "PPC/Linux pipe? buffer? bug" In sbcl-0.7.6, the run-program.test.sh test script sometimes hangs on the PPC/Linux platform, waiting for a zombie env process. This @@ -731,7 +735,6 @@ WORKAROUND: c. the examples in CLHS 7.6.5.1 (regarding generic function lambda lists and &KEY arguments) do not signal errors when they should. - 201: "Incautious type inference from compound types" a. (reported by APD sbcl-devel 2002-09-17) (DEFUN FOO (X) diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp index 1d05f63..f1dca41 100644 --- a/src/code/coerce.lisp +++ b/src/code/coerce.lisp @@ -116,7 +116,6 @@ ((csubtypep type (specifier-type 'character)) (character object)) ((csubtypep type (specifier-type 'function)) - #!+high-security (when (and (legal-fun-name-p object) (not (fboundp object))) (error 'simple-type-error @@ -129,7 +128,6 @@ :expected-type '(satisfies fboundp) :format-control "~S isn't fbound." :format-arguments (list object))) - #!+high-security (when (and (symbolp object) (sb!xc:macro-function object)) (error 'simple-type-error @@ -137,7 +135,6 @@ :expected-type '(not (satisfies sb!xc:macro-function)) :format-control "~S is a macro." :format-arguments (list object))) - #!+high-security (when (and (symbolp object) (special-operator-p object)) (error 'simple-type-error diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index da44cd4..dd6c403 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -279,10 +279,41 @@ ((type= type1 (specifier-type 'function)) type1) (t nil))) -;;; ### Not very real, but good enough for redefining transforms -;;; according to type: (!define-type-method (function :simple-=) (type1 type2) - (values (equalp type1 type2) t)) + (macrolet ((compare (comparator field) + (let ((reader (symbolicate '#:fun-type- field))) + `(,comparator (,reader type1) (,reader type2))))) + (and/type (compare type= returns) + (cond ((neq (fun-type-wild-args type1) (fun-type-wild-args type2)) + (values nil t)) + ((eq (fun-type-wild-args type1) t) + (values t t)) + (t (and/type + (cond ((null (fun-type-rest type1)) + (values (null (fun-type-rest type2)) t)) + ((null (fun-type-rest type2)) + (values nil t)) + (t + (compare type= rest))) + (labels ((type-list-= (l1 l2) + (cond ((null l1) + (values (null l2) t)) + ((null l2) + (values nil t)) + (t (multiple-value-bind (res winp) + (type= (first l1) (first l2)) + (cond ((not winp) + (values nil nil)) + ((not res) + (values nil t)) + (t + (type-list-= (rest l1) + (rest l2))))))))) + (and/type (and/type (compare type-list-= required) + (compare type-list-= optional)) + (if (or (fun-type-keyp type1) (fun-type-keyp type2)) + (values nil nil) + (values t t)))))))))) (!define-type-class constant :inherits values) @@ -402,7 +433,7 @@ ;;; If COUNT values are supplied, which types should they have? (defun values-type-start (type count) - (declare (ctype type) (unsigned-byte count)) + (declare (type ctype type) (type unsigned-byte count)) (if (eq type *wild-type*) (make-list count :initial-element *universal-type*) (collect ((res)) diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 07ab5d3..7afe2cd 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -558,14 +558,14 @@ ;;; Primitive used to verify indices into arrays. If we can tell at ;;; compile-time or we are generating unsafe code, don't bother with ;;; the VOP. -(deftransform %check-bound ((array dimension index)) - (unless (constant-continuation-p dimension) - (give-up-ir1-transform)) - (let ((dim (continuation-value dimension))) - `(the (integer 0 ,dim) index))) -(deftransform %check-bound ((array dimension index) * * - :policy (and (> speed safety) (= safety 0))) - 'index) +(deftransform %check-bound ((array dimension index) * * :node node) + (cond ((policy node (and (> speed safety) (= safety 0))) + 'index) + ((not (constant-continuation-p dimension)) + (give-up-ir1-transform)) + (t + (let ((dim (continuation-value dimension))) + `(the (integer 0 ,dim) index))))) ;;;; WITH-ARRAY-DATA diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index e47a03a..001c669 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -161,12 +161,14 @@ (string-equal (transform-note x) note) (eq (transform-important x) important))) (fun-info-transforms info)))) - (if old - (setf (transform-function old) fun - (transform-note old) note) - (push (make-transform :type ctype :function fun :note note - :important important) - (fun-info-transforms info))) + (cond (old + (style-warn "Overwriting ~S" old) + (setf (transform-function old) fun + (transform-note old) note)) + (t + (push (make-transform :type ctype :function fun :note note + :important important) + (fun-info-transforms info)))) name)) ;;; Make a FUN-INFO structure with the specified type, attributes diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp index 89af8fb..1609080 100644 --- a/src/compiler/proclaim.lisp +++ b/src/compiler/proclaim.lisp @@ -121,33 +121,19 @@ (unless (csubtypep ctype (specifier-type 'function)) (error "not a function type: ~S" (first args))) (dolist (name (rest args)) - - ;; KLUDGE: Something like the commented-out TYPE/= - ;; check here would be nice, but it has been - ;; commented out because TYPE/= doesn't support - ;; function types. It could probably be made to do - ;; so, but it might take some time, since function - ;; types involve values types, which aren't - ;; supported, and since the SUBTYPEP operator for - ;; FUNCTION types is rather broken, e.g. - ;; (SUBTYPEP '(FUNCTION (T BOOLEAN) NIL) - ;; '(FUNCTION (FIXNUM FIXNUM) NIL)) => T, T - ;; -- WHN 20000229 - #| - (when (eq (info :function :where-from name) :declared) - (let ((old-type (info :function :type name))) - (when (type/= ctype old-type) - (style-warn - "new FTYPE proclamation~@ - ~S~@ - for ~S does not match old FTYPE proclamation~@ - ~S" - (list ctype name old-type))))) - |# + (when (eq (info :function :where-from name) :declared) + (let ((old-type (info :function :type name))) + (when (type/= ctype old-type) + (style-warn + "new FTYPE proclamation~@ + ~S~@ + for ~S does not match old FTYPE proclamation~@ + ~S" + ctype name old-type)))) ;; Now references to this function shouldn't be warned ;; about as undefined, since even if we haven't seen a - ;; definition yet, we know one is planned. + ;; definition yet, we know one is planned. ;; ;; Other consequences of we-know-you're-a-function-now ;; are appropriate too, e.g. any MACRO-FUNCTION goes away. diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 1178ab8..60e30b6 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -440,3 +440,8 @@ (assert (nth-value 2 (compile nil `(lambda (x) (1+ (,fun #'print x))))))) + +(assert (nth-value 2 (compile nil + '(lambda () + (declare (notinline mapcar)) + (1+ (mapcar #'print '(1 2 3))))))) diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp index b97a0e9..90205bc 100644 --- a/tests/type.pure.lisp +++ b/tests/type.pure.lisp @@ -202,3 +202,7 @@ (assert (not (nth-value 1 (subtypep '(and null some-unknown-type) 'another-unknown-type)))) + +;;; bug 46c +(dolist (fun '(and if)) + (assert (raises-error? (coerce fun 'function) type-error))) diff --git a/version.lisp-expr b/version.lisp-expr index 288ac4e..2bafa9f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.0.75" +"0.8.0.76" -- 1.7.10.4