[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] CVS: sbcl/src/compiler ctype.lisp, 1.34,
From:       Nikodemus Siivola <demoss () users ! sourceforge ! net>
Date:       2008-02-18 19:14:13
Message-ID: E1JRBRN-0001Gn-Lp () sc8-pr-cvs8 ! sourceforge ! net
[Download RAW message or body]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv4844/src/compiler

Modified Files:
	ctype.lisp ir1opt.lisp 
Log Message:
1.0.14.35: lift MAKE-SINGLE-VALUE-TYPE calls from loops

 * Multiple places can use the same type, no need to cons
   a new one each time through the loop.


Index: ctype.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ctype.lisp,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -d -r1.34 -r1.35
--- ctype.lisp	14 Apr 2006 17:57:57 -0000	1.34
+++ ctype.lisp	18 Feb 2008 19:14:11 -0000	1.35
@@ -765,8 +765,9 @@
                                    (type-specifier type))))
                        (t
                         (setf (leaf-type var) type)
-                        (dolist (ref (leaf-refs var))
-                          (derive-node-type ref (make-single-value-type type))))))
+                        (let ((s-type (make-single-value-type type)))
+                          (dolist (ref (leaf-refs var))
+                            (derive-node-type ref s-type))))))
            t))))))
 
 ;;; FIXME: This is quite similar to ASSERT-NEW-DEFINITION.

Index: ir1opt.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v
retrieving revision 1.128
retrieving revision 1.129
diff -u -d -r1.128 -r1.129
--- ir1opt.lisp	4 Feb 2008 15:40:33 -0000	1.128
+++ ir1opt.lisp	18 Feb 2008 19:14:11 -0000	1.129
@@ -1240,12 +1240,13 @@
       (let ((int (type-approx-intersection2 var-type type)))
         (when (type/= int var-type)
           (setf (leaf-type leaf) int)
-          (dolist (ref (leaf-refs leaf))
-            (derive-node-type ref (make-single-value-type int))
-            ;; KLUDGE: LET var substitution
-            (let* ((lvar (node-lvar ref)))
-              (when (and lvar (combination-p (lvar-dest lvar)))
-                (reoptimize-lvar lvar))))))
+          (let ((s-int (make-single-value-type int)))
+            (dolist (ref (leaf-refs leaf))
+              (derive-node-type ref s-int)
+              ;; KLUDGE: LET var substitution
+              (let* ((lvar (node-lvar ref)))
+                (when (and lvar (combination-p (lvar-dest lvar)))
+                  (reoptimize-lvar lvar)))))))
       (values))))
 
 ;;; Iteration variable: exactly one SETQ of the form:


-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2008.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]