diff --git a/compiler/ir1opt.lisp b/compiler/ir1opt.lisp
index df3a06de27d6e3603d7742d06ba8ada6400118e6..7503784f80e67d97b93abb5098995902ca44c926 100644
--- a/compiler/ir1opt.lisp
+++ b/compiler/ir1opt.lisp
@@ -311,13 +311,13 @@
 ;;;
 ;;; Note that we clear the node & block reoptimize flags *before* doing the
 ;;; optimization.  This ensures that the node or block will be reoptimized if
-;;; necessary.  We leave the NODE-OPTIMIZE flag set doing into
+;;; necessary.  We leave the NODE-OPTIMIZE flag set going into
 ;;; IR1-OPTIMIZE-RETURN, since it wants to clear the flag itself.
 ;;;
 (defun ir1-optimize-block (block)
   (declare (type cblock block))
   (setf (block-reoptimize block) nil)
-  (do-nodes (node cont block)
+  (do-nodes (node cont block :restart-p t)
     (when (node-reoptimize node)
       (setf (node-reoptimize node) nil)
       (typecase node
@@ -715,20 +715,40 @@
 ;;; then we set the combination kind to the function info of %Slot-Setter or
 ;;; %Slot-Accessor, as appropriate.
 ;;;
-(defun recognize-known-call (call)
+;;;    If convert-again is true, and the function has a source-transform or
+;;; inline-expansion, or if the function is conditional, and the destination of
+;;; the value is not an IF, then instead of making the existing call known, we
+;;; change it to be a call to a lambda that just re-calls the function.  This
+;;; gives IR1 transformation another go at the call, in the case where the call
+;;; wasn't obviously known during the initial IR1 conversion.
+;;;
+(defun recognize-known-call (call &optional convert-again)
   (declare (type combination call))
   (let* ((fun (basic-combination-fun call))
 	 (name (continuation-function-name fun)))
     (when name
       (let ((info (info function info name)))
-	(cond (info
-	       (setf (basic-combination-kind call) info))
-	      ((slot-accessor-p (ref-leaf (continuation-use fun)))
-	       (setf (basic-combination-kind call)
-		     (info function info
-			   (if (consp name)
-			       '%slot-setter
-			       '%slot-accessor))))))))
+	(cond
+	 ((and info convert-again
+	       (or (info function source-transform name)
+		   (info function inline-expansion name)
+		   (and (ir1-attributep (function-info-attributes info)
+					predicate)
+			(let ((dest (continuation-dest (node-cont call))))
+			  (and dest (not (if-p dest)))))))
+	  (let ((dums (loop repeat (length (combination-args call))
+			    collect (gensym))))
+	    (transform-call call
+			    `(lambda ,dums
+			       (,name ,@dums)))))
+	 (info
+	  (setf (basic-combination-kind call) info))
+	 ((slot-accessor-p (ref-leaf (continuation-use fun)))
+	  (setf (basic-combination-kind call)
+		(info function info
+		      (if (consp name)
+			  '%slot-setter
+			  '%slot-accessor))))))))
   (undefined-value))
 
 
@@ -769,7 +789,7 @@
 			       :error-function #'compiler-warning
 			       :warning-function #'compiler-note)
 	   (assert-call-type call type)
-	   (recognize-known-call call))
+	   (recognize-known-call call t))
 	  (t
 	   (setf (ref-inlinep use) :notinline))))
 
@@ -821,7 +841,7 @@
 	(flame (policy node (> speed brevity)))
 	(*compiler-error-context* node))
     (cond ((or (not constrained)
-	       (valid-function-use node type))
+	       (valid-function-use node type :strict-result t))
 	   (multiple-value-bind
 	       (severity args)
 	       (catch 'give-up
@@ -939,7 +959,15 @@
 	    (setf (continuation-next cont) next)
 	    (when (eq call (block-last block))
 	      (setf (block-last block) node))
-	    (reoptimize-continuation cont)))))))
+	    (reoptimize-continuation cont))))
+       (t
+	(let ((dummies (loop repeat (length args)
+			     collect (gensym))))
+	  (transform-call
+	   call
+	   `(lambda ,dummies
+	      (declare (ignore ,@dummies))
+	      (values ,@(mapcar #'(lambda (x) `',x) values)))))))))
   
   (undefined-value))
 
@@ -1051,6 +1079,25 @@
       t)))
 
 
+;;; DELETE-LET  --  Interface
+;;;
+;;;    Delete a Let, removing the call and bind nodes, and warning about any
+;;; unreferenced variables.  Note that FLUSH-DEAD-CODE will come along right
+;;; away and delete the REF and then the lambda, since we flush the FUN
+;;; continuation. 
+;;;
+(defun delete-let (fun)
+  (declare (type clambda fun))
+  (assert (eq (functional-kind fun) :let))
+  (note-unreferenced-vars fun)
+  (let ((call (let-combination fun)))
+    (flush-dest (combination-fun call))
+    (unlink-node call)
+    (unlink-node (lambda-bind fun))
+    (setf (lambda-bind fun) nil))
+  (undefined-value))
+
+
 ;;; Propagate-Let-Args  --  Internal
 ;;;
 ;;;    This function is called when one of the arguments to a LET changes.  We
@@ -1064,34 +1111,38 @@
 ;;; being defeated, and also ensures that the best representation for the
 ;;; variable can be used.
 ;;;
+;;;    If all of the variables are deleted (have no references) when we are
+;;; done, then we delete the let.
+;;;
 ;;;    Note that we are responsible for clearing the Continuation-Reoptimize
 ;;; flags.
 ;;;
 (defun propagate-let-args (call fun)
   (declare (type combination call) (type clambda fun))
-  (mapc #'(lambda (arg var)
-	    (when (and arg
-		       (continuation-reoptimize arg))
-	      (setf (continuation-reoptimize arg) nil)
-	      (cond
-	       ((lambda-var-sets var)
-		(propagate-from-sets var (continuation-type arg)))
-	       ((let ((use (continuation-use arg)))
-		  (when (ref-p use)
-		    (let ((leaf (ref-leaf use)))
-		      (when (and (constant-reference-p use)
-				 (values-subtypep
-				  (leaf-type leaf)
-				  (continuation-asserted-type arg)))
-			(propagate-to-refs var (continuation-type arg))
-			(substitute-leaf leaf var)
-			t)))))
-	       ((and (null (rest (leaf-refs var)))
-		     (substitute-single-use-continuation arg var)))
-	       (t
-		(propagate-to-refs var (continuation-type arg))))))
-	(basic-combination-args call)
-	(lambda-vars fun))
+  (loop for arg in (combination-args call)
+        and var in (lambda-vars fun) do
+    (when (and arg (continuation-reoptimize arg))
+      (setf (continuation-reoptimize arg) nil)
+      (cond
+       ((lambda-var-sets var)
+	(propagate-from-sets var (continuation-type arg)))
+       ((let ((use (continuation-use arg)))
+	  (when (ref-p use)
+	    (let ((leaf (ref-leaf use)))
+	      (when (and (constant-reference-p use)
+			 (values-subtypep (leaf-type leaf)
+					  (continuation-asserted-type arg)))
+		(propagate-to-refs var (continuation-type arg))
+		(substitute-leaf leaf var)
+		t)))))
+       ((and (null (rest (leaf-refs var)))
+	     (substitute-single-use-continuation arg var)))
+       (t
+	(propagate-to-refs var (continuation-type arg))))))
+  
+  (when (every #'null (combination-args call))
+    (delete-let fun))
+
   (undefined-value))
 
 
@@ -1146,6 +1197,8 @@
   (undefined-value))
 
 
+;;;; Multiple values optimization:
+
 ;;; IR1-OPTIMIZE-MV-BIND  --  Internal
 ;;;
 ;;;    Propagate derived type info from the values continuation to the vars.
@@ -1169,6 +1222,82 @@
     (setf (continuation-reoptimize arg) nil))
   (undefined-value))
 
+
+;;; VALUES IR1 optimizer  --  Internal
+;;;
+;;; If we see:
+;;;    (multiple-value-bind (x y)
+;;;                         (values xx yy)
+;;;      ...)
+;;; Convert to:
+;;;    (let ((x xx)
+;;;          (y yy))
+;;;      ...)
+;;;
+;;; What we actually do is convert the VALUES combination into a normal let
+;;; combination calling the orignal :MV-LET lambda.  If there are extra args to
+;;; VALUES, discard the corresponding continuations.  If there are insufficient
+;;; args, insert references to NIL.
+;;;
+(defoptimizer (values optimizer) ((&rest ignore) node)
+  (declare (ignore ignore))
+  (let ((dest (continuation-dest (node-cont node))))
+    (when (and (mv-combination-p dest)
+	       (eq (basic-combination-kind dest) :local)
+	       (eq (continuation-use (first (basic-combination-args dest)))
+		   node))
+      (let* ((fun (combination-lambda dest))
+	     (vars (lambda-vars fun))
+	     (vals (combination-args node))
+	     (nvars (length vars))
+	     (nvals (length vals)))
+	(cond ((> nvals nvars)
+	       (mapc #'flush-dest (subseq vals nvars))
+	       (setq vals (subseq vals 0 nvars)))
+	      ((< nvals nvars)
+	       (with-ir1-environment node
+		 (let ((node-prev (node-prev node)))
+		   (setf (node-prev node) nil)
+		   (setf (continuation-next node-prev) nil)
+		   (collect ((res vals))
+		     (loop as cont = (make-continuation node)
+			   and prev = node-prev then cont
+			   repeat (- nvars nvals)
+			   do (reference-constant prev cont nil)
+			      (res cont))
+		     (setq vals (res)))
+		   (prev-link node (car (last vals)))))))
+	(setf (combination-args node) vals)
+	(flush-dest (combination-fun node))
+	(let ((fun-cont (basic-combination-fun dest)))
+	  (setf (continuation-dest fun-cont) node)
+	  (setf (combination-fun node) fun-cont))
+	(setf (combination-kind node) :local)
+	(setf (functional-kind fun) :let)
+	(flush-dest (first (basic-combination-args dest)))
+	(unlink-node dest)
+	(propagate-to-args node fun)
+	(when vals
+	  (reoptimize-continuation (first vals))))
+      t)))
+
+
+;;; VALUES IR1 transform  --  Internal
+;;;
+;;;    If VALUES appears in a non-MV context, then effectively convert it to a
+;;; PROG1.  This allows the computation of the additional values to become dead
+;;; code.
+;;;
+(deftransform values ((&rest vals) * * :node node)
+  (when (typep (continuation-dest (node-cont node))
+	       '(or creturn exit mv-combination))
+    (give-up))
+  (let ((dummies (loop repeat (1- (length vals))
+		       collect (gensym))))
+    `(lambda (val ,@dummies)
+       (declare (ignore ,@dummies))
+       val)))
+
 
 ;;; Flush-Dead-Code  --  Internal
 ;;;