From cae594ffb04c80cfa70abce4a6a35a9ba5a27e8c Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Wed, 2 Oct 2002 15:24:16 +0000 Subject: [PATCH] 0.7.8.9: primitive type of a subtype of FUNCTION is FUNCTION (TYPEP ... 'NIL) is optimized to NIL --- BUGS | 6 +++++- src/compiler/generic/primtype.lisp | 4 +++- src/compiler/tn.lisp | 6 ++---- src/compiler/typetran.lisp | 2 ++ tests/compiler.impure.lisp | 13 +++++++++++++ version.lisp-expr | 2 +- 6 files changed, 26 insertions(+), 7 deletions(-) diff --git a/BUGS b/BUGS index 369b3f7..bc92e10 100644 --- a/BUGS +++ b/BUGS @@ -948,13 +948,15 @@ WORKAROUND: In sbcl-0.7.4.24, compiling (defun bug178 (x) (funcall (the function (the standard-object x)))) - gives + gives failed AVER: "(AND (EQ (IR2-CONTINUATION-PRIMITIVE-TYPE 2CONT) FUNCTION-PTYPE) (EQ CHECK T))" This variant compiles OK, though: (defun bug178alternative (x) (funcall (the nil x))) + (since 0.7.8.9 it does not signal an error; see also bug 199) + 183: "IEEE floating point issues" Even where floating point handling is being dealt with relatively well (as of sbcl-0.7.5, on sparc/sunos and alpha; see bug #146), the @@ -1198,6 +1200,8 @@ WORKAROUND: APD further reports that this bug is not present in CMUCL. + (this case was fixed in 0.7.8.9; see also bug 178) + 201: "Incautious type inference from compound CONS types" (reported by APD sbcl-devel 2002-09-17) (DEFUN FOO (X) diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp index 7310a2d..c2df398 100644 --- a/src/compiler/generic/primtype.lisp +++ b/src/compiler/generic/primtype.lisp @@ -383,6 +383,8 @@ (part-of function) (part-of instance))) (ctype - (any)))))) + (if (csubtypep type (specifier-type 'function)) + (part-of function) + (any))))))) (/show0 "primtype.lisp end of file") diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp index 11a8334..18e9ca6 100644 --- a/src/compiler/tn.lisp +++ b/src/compiler/tn.lisp @@ -427,10 +427,8 @@ ;;; Return a list of N normal TNs of the specified primitive type. (defun make-n-tns (n ptype) (declare (type unsigned-byte n) (type primitive-type ptype)) - (collect ((res)) - (dotimes (i n) - (res (make-normal-tn ptype))) - (res))) + (loop repeat n + collect (make-normal-tn ptype))) ;;; Return true if X and Y are packed in the same location, false otherwise. ;;; This is false if either operand is constant. diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp index 6de64ea..a63f23a 100644 --- a/src/compiler/typetran.lisp +++ b/src/compiler/typetran.lisp @@ -72,6 +72,8 @@ nil) ((csubtypep otype type) t) + ((eq type *empty-type*) + nil) (t (give-up-ir1-transform))))) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 98837d1..294bfc8 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -426,6 +426,19 @@ BUG 48c, not yet fixed: (declaim (ftype (function () null) bug202)) (defun bug202 () t) + +;;; bugs 178, 199: compiler failed to compile a call of a function +;;; with a hairy type +(defun bug178 (x) + (funcall (the function (the standard-object x)))) + +(defun bug199-aux (f) + (eq nil (funcall f))) + +(defun bug199 (f x) + (declare (type (and function (satisfies bug199-aux)) f)) + (funcall f x)) + ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/version.lisp-expr b/version.lisp-expr index 862f12f..9ce07fa 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; internal versions off the main CVS branch, it gets hairier, e.g. ;;; "0.pre7.14.flaky4.13".) -"0.7.8.8" +"0.7.8.9" -- 1.7.10.4