0.9.12.12:

        * Fix bug 401: IR1-transform for TYPEP aborts transformation
          if invalid type is encountered.
        NOTE: reapplying changes lost in the sf.net CVS outage

diff --git a/BUGS b/BUGS
index 4b009c1..4860f07 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -2130,21 +2130,4 @@ WORKAROUND:
   (c-string :deport-gen) ...)  in host-c-call.lisp.
 
 401: "optimizer runaway on bad constant type specifiers in TYPEP"
-  In 0.9.12.3 (and probably many earlier versions), COMPILE-FILE on
-    (defun ouch401 ()
-      (etypecase (signum (- x y))
-        ((-1 nil))
-         ((0 1) (oops "shouldn't happen"))))
-  or just
-    (defun foo401 (x)
-      (typep x '(-1 nil)))
-  spins emitting what seems to be an endless series of compiler 
-  warnings like
-    ; --> TYPEP TYPEP TYPEP TYPEP TYPEP TYPEP TYPEP TYPEP TYPEP TYPEP 
-    ; --> TYPEP TYPEP TYPEP TYPEP TYPEP TYPEP TYPEP TYPEP TYPEP TYPEP 
-    ; --> TYPEP 
-    ; ==>
-    ;   (TYPEP SB-C::OBJECT '(-1 NIL))
-    ; 
-    ; caught WARNING:
-    ;   illegal type specifier for TYPEP: (-1 NIL)
+  (fixed in 0.9.12.12)

diff --git a/NEWS b/NEWS
index 5330664..c315a2f 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -3,6 +3,8 @@ changes in sbcl-0.9.13 relative to sbcl-0.9.12:
   * new feature: source path information is generated for macro-expansion
     errors for use in IDE's like Slime (thanks to Helmut Eller)
   * bug fix: calls to the compiler no longer modify *RANDOM-STATE*
+  * bug fix: compiler does not loop forever on an invalid type in
+    TYPEP.
   * improvement: compilation of most CLOS applications is significantly
     faster
 

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 584e86f..6405bdd 100644 (file)
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -57,10 +57,14 @@
 ;;; constant. At worst, it will convert to %TYPEP, which will prevent
 ;;; spurious attempts at transformation (and possible repeated
 ;;; warnings.)
-(deftransform typep ((object type))
+(deftransform typep ((object type) * * :node node)
   (unless (constant-lvar-p type)
     (give-up-ir1-transform "can't open-code test of non-constant type"))
-  `(typep object ',(lvar-value type)))
+  (multiple-value-bind (expansion fail-p)
+      (source-transform-typep 'object (lvar-value type))
+    (if fail-p
+        (abort-ir1-transform)
+        expansion)))
 
 ;;; If the lvar OBJECT definitely is or isn't of the specified
 ;;; type, then return T or NIL as appropriate. Otherwise quietly
@@ -488,6 +492,43 @@
 ;;; to that predicate. Otherwise, we dispatch off of the type's type.
 ;;; These transformations can increase space, but it is hard to tell
 ;;; when, so we ignore policy and always do them.
+(defun source-transform-typep (object type)
+  (let ((ctype (careful-specifier-type type)))
+    (or (when (not ctype)
+          (compiler-warn "illegal type specifier for TYPEP: ~S" type)
+          (return-from source-transform-typep (values nil t)))
+        (let ((pred (cdr (assoc ctype *backend-type-predicates*
+                                :test #'type=))))
+          (when pred `(,pred ,object)))
+        (typecase ctype
+          (hairy-type
+           (source-transform-hairy-typep object ctype))
+          (negation-type
+           (source-transform-negation-typep object ctype))
+          (union-type
+           (source-transform-union-typep object ctype))
+          (intersection-type
+           (source-transform-intersection-typep object ctype))
+          (member-type
+           `(if (member ,object ',(member-type-members ctype)) t))
+          (args-type
+           (compiler-warn "illegal type specifier for TYPEP: ~S" type)
+           (return-from source-transform-typep (values nil t)))
+          (t nil))
+        (typecase ctype
+          (numeric-type
+           (source-transform-numeric-typep object ctype))
+          (classoid
+           `(%instance-typep ,object ',type))
+          (array-type
+           (source-transform-array-typep object ctype))
+          (cons-type
+           (source-transform-cons-typep object ctype))
+          (character-set-type
+           (source-transform-character-set-typep object ctype))
+          (t nil))
+        `(%typep ,object ',type))))
+
 (define-source-transform typep (object spec)
   ;; KLUDGE: It looks bad to only do this on explicitly quoted forms,
   ;; since that would overlook other kinds of constants. But it turns
@@ -496,44 +537,7 @@
   ;; source transform another chance, so it all works out OK, in a
   ;; weird roundabout way. -- WHN 2001-03-18
   (if (and (consp spec) (eq (car spec) 'quote))
-      (let ((type (careful-specifier-type (cadr spec))))
-        (block bail
-          (or (when (not type)
-                (compiler-warn "illegal type specifier for TYPEP: ~S"
-                               (cadr spec))
-                (return-from bail (values nil t)))
-              (let ((pred (cdr (assoc type *backend-type-predicates*
-                                      :test #'type=))))
-                (when pred `(,pred ,object)))
-              (typecase type
-                (hairy-type
-                 (source-transform-hairy-typep object type))
-                (negation-type
-                 (source-transform-negation-typep object type))
-                (union-type
-                 (source-transform-union-typep object type))
-                (intersection-type
-                 (source-transform-intersection-typep object type))
-                (member-type
-                 `(if (member ,object ',(member-type-members type)) t))
-                (args-type
-                 (compiler-warn "illegal type specifier for TYPEP: ~S"
-                                (cadr spec))
-                 (return-from bail (values nil t)))
-                (t nil))
-              (typecase type
-                (numeric-type
-                 (source-transform-numeric-typep object type))
-                (classoid
-                 `(%instance-typep ,object ,spec))
-                (array-type
-                 (source-transform-array-typep object type))
-                (cons-type
-                 (source-transform-cons-typep object type))
-                (character-set-type
-                 (source-transform-character-set-typep object type))
-                (t nil))
-              `(%typep ,object ,spec))))
+      (source-transform-typep object (cadr spec))
       (values nil t)))
 \f
 ;;;; coercion

diff --git a/version.lisp-expr b/version.lisp-expr
index e9b2ce8..b3c76ae 100644 (file)
--- 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.9.12.11"
+"0.9.12.12"