0.7.8.9:

        primitive type of a subtype of FUNCTION is FUNCTION
        (TYPEP ... 'NIL) is optimized to NIL

diff --git a/BUGS b/BUGS
index 369b3f7..bc92e10 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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))
+
 \f
 ;;;; 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 (file)
--- 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"