Warn when wrapping constants with THE of multiple value types

[sbcl.git] / src / compiler / ir1-translators.lisp

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index cd10e15..7bd2bfb 100644 (file)
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -42,7 +42,10 @@ otherwise evaluate ELSE and return its values. ELSE defaults to NIL."
     ;; IR1-CONVERT-MAYBE-PREDICATE requires DEST to be CIF, so the
     ;; order of the following two forms is important
     (setf (lvar-dest pred-lvar) node)
-    (ir1-convert start pred-ctran pred-lvar test)
+    (multiple-value-bind (context count) (possible-rest-arg-context test)
+      (if context
+          (ir1-convert start pred-ctran pred-lvar `(%rest-true ,test ,context ,count))
+          (ir1-convert start pred-ctran pred-lvar test)))
     (link-node-to-previous-ctran node pred-ctran)
 
     (let ((start-block (ctran-block pred-ctran)))
@@ -601,7 +604,7 @@ be a lambda expression."
         (cond (cname
                `(global-function ,cname))
               (give-up
-               (give-up-ir1-transform give-up))
+               (give-up-ir1-transform "not known to be a function"))
               (t
                `(%coerce-callable-to-fun ,lvar-name))))))
 \f
@@ -644,8 +647,9 @@ be a lambda expression."
 (define-source-transform funcall (function &rest args)
   `(%funcall ,(ensure-source-fun-form function) ,@args))
 
-(deftransform %coerce-callable-to-fun ((thing) * *)
-  (ensure-lvar-fun-form thing 'thing "optimize away possible call to FDEFINITION at runtime"))
+(deftransform %coerce-callable-to-fun ((thing) * * :node node)
+  "optimize away possible call to FDEFINITION at runtime"
+  (ensure-lvar-fun-form thing 'thing t))
 
 (define-source-transform %coerce-callable-to-fun (thing)
   (ensure-source-fun-form thing t))
@@ -908,6 +912,8 @@ other."
                     (values-subtypep (make-single-value-type (leaf-type value))
                                      type))
                (and (sb!xc:constantp value)
+                    (or (not (values-type-p type))
+                        (values-type-may-be-single-value-p type))
                     (ctypep (constant-form-value value)
                             (single-value-type type))))
            (ir1-convert start next result value))