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