CVS: sbcl/src/compiler ir1opt.lisp,1.72,1.73 srctran.lisp,1.77,1.78

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1:/tmp/cvs-serv9866/src/compiler

Modified Files:
        ir1opt.lisp srctran.lisp 
Log Message:
0.8.3.2:
        * SB-SIMPLE-STREAMS:
        ... implement WRITE-SEQUENCE for single channel streams;
        ... fix bug in tests, causing random test failures;
        * add declarations to SCALE-EXPONENT;
        * remove obsolete type declarations in MIX;
        * change type inference for iteration-like variables: if
          interval type is successfuly derived, ignore other inferred
          information.


Index: ir1opt.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -d -r1.72 -r1.73
--- ir1opt.lisp 18 Aug 2003 07:53:35 -0000      1.72
+++ ir1opt.lisp 26 Aug 2003 08:58:31 -0000      1.73
@@ -1273,20 +1273,22 @@
                         (and (ref-p first)
                              (eq (ref-leaf first) var))))
                :exit-if-null)
-             (step-type (continuation-type (second +-args))))
+             (step-type (continuation-type (second +-args)))
+             (set-type (continuation-type (set-value set))))
     (when (and (numeric-type-p initial-type)
                (numeric-type-p step-type)
-               (eq (numeric-type-class initial-type)
-                   (numeric-type-class step-type))
-               (eq (numeric-type-format initial-type)
-                   (numeric-type-format step-type))
-               (eq (numeric-type-complexp initial-type)
-                   (numeric-type-complexp step-type)))
+               (numeric-type-equal initial-type step-type))
       (multiple-value-bind (low high)
           (cond ((csubtypep step-type (specifier-type '(real 0 *)))
-                 (values (numeric-type-low initial-type) nil))
+                 (values (numeric-type-low initial-type)
+                         (when (and (numeric-type-p set-type)
+                                    (numeric-type-equal set-type initial-type))
+                           (numeric-type-high set-type))))
                 ((csubtypep step-type (specifier-type '(real * 0)))
-                 (values nil (numeric-type-high initial-type)))
+                 (values (when (and (numeric-type-p set-type)
+                                    (numeric-type-equal set-type initial-type))
+                           (numeric-type-low set-type))
+                         (numeric-type-high initial-type)))
                 (t
                  (values nil nil)))
         (modified-numeric-type initial-type
@@ -1317,7 +1319,7 @@
           (setf (node-reoptimize set) nil))))
     (let ((res (res)))
       (awhen (maybe-infer-iteration-var-type var initial-type)
-        (setq res (type-intersection res it)))
+        (setq res it))
       (propagate-to-refs var res)))
   (values))
 

Index: srctran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -d -r1.77 -r1.78
--- srctran.lisp        18 Aug 2003 16:46:29 -0000      1.77
+++ srctran.lisp        26 Aug 2003 08:58:31 -0000      1.78
@@ -3677,5 +3677,5 @@
       (format t "/(CONTINUATION-VALUE X)=~S~%" (continuation-value x)))
     (format t "/MESSAGE=~S~%" (continuation-value message))
     (give-up-ir1-transform "not a real transform"))
-  (defun /report-continuation (&rest rest)
-    (declare (ignore rest))))
+  (defun /report-continuation (x message)
+    (declare (ignore x message))))



-------------------------------------------------------
This SF.net email is sponsored by: VM Ware
With VMware you can run multiple operating systems on a single machine.
WITHOUT REBOOTING! Mix Linux / Windows / Novell virtual machines
at the same time. Free trial click here:http://www.vmware.com/wl/offer/358/0