From 14cee007844293f57b4808d51b718b41b922eb29 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Wed, 9 May 1990 11:32:40 +0000
Subject: [PATCH] Merged in MV-BIND type inference from the mips branch, and
 fixed to handle set variables correctly.

---
 compiler/ir1opt.lisp | 32 ++++++++++++++++++++++++++++++--
 1 file changed, 30 insertions(+), 2 deletions(-)

diff --git a/compiler/ir1opt.lisp b/compiler/ir1opt.lisp
index a431cdf4f..8208d6e7f 100644
--- a/compiler/ir1opt.lisp
+++ b/compiler/ir1opt.lisp
@@ -340,6 +340,11 @@
 	(creturn
 	 (setf (node-reoptimize node) t)
 	 (ir1-optimize-return node))
+	(mv-combination
+	 (when (and (eq (basic-combination-kind node) :local)
+		    (continuation-reoptimize
+		     (first (basic-combination-args node))))
+	   (ir1-optimize-mv-bind node)))
 	(exit
 	 (let ((value (exit-value node)))
 	   (when value
@@ -944,8 +949,7 @@
 ;;; a PROPAGATE-TO-REFS with this type.
 ;;;
 (defun propagate-from-sets (var type)
-  (collect ((res *empty-type* type-union))
-    (res type)
+  (collect ((res type type-union))
     (dolist (set (basic-var-sets var))
       (res (continuation-type (set-value set)))
       (setf (node-reoptimize set) nil))
@@ -1065,6 +1069,30 @@
   
   (undefined-value))
 
+
+;;; IR1-OPTIMIZE-MV-BIND  --  Internal
+;;;
+;;;    Propagate derived type info from the values continuation to the vars.
+;;;
+(defun ir1-optimize-mv-bind (node)
+  (declare (type mv-combination node))
+  (let ((arg (first (basic-combination-args node)))
+	(vars (lambda-vars (combination-lambda node))))
+    (multiple-value-bind (types nvals)
+			 (values-types (continuation-derived-type arg))
+      (unless (eq nvals :unknown)
+	(mapc #'(lambda (var type)
+		  (if (basic-var-sets var)
+		      (propagate-from-sets var type)
+		      (propagate-to-refs var type)))
+		vars
+		(append types
+			(make-list (max (- (length vars) nvals) 0)
+				   :initial-element *null-type*)))))
+
+    (setf (continuation-reoptimize arg) nil))
+  (undefined-value))
+
 
 ;;; Flush-Dead-Code  --  Internal
 ;;;
-- 
GitLab