X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Floop.lisp;h=6b9a43aaaac49e4abef570e68dcff6c0b7f567ed;hb=1dc38285834db2d374a156a4f68b19096341deb3;hp=68f1741f44306e03cbd66e8edbd98ad45ee69585;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/loop.lisp b/src/code/loop.lisp
index 68f1741..6b9a43a 100644
--- a/src/code/loop.lisp
+++ b/src/code/loop.lisp
@@ -503,27 +503,21 @@ code to be loaded.
 ;;;; code analysis stuff
 
 (defun loop-constant-fold-if-possible (form &optional expected-type)
-  (let ((new-form form) (constantp nil) (constant-value nil))
-    (when (setq constantp (constantp new-form))
-      (setq constant-value (eval new-form)))
+  (let* ((constantp (sb!xc:constantp form))
+         (value (and constantp (sb!int:constant-form-value form))))
     (when (and constantp expected-type)
-      (unless (sb!xc:typep constant-value expected-type)
+      (unless (sb!xc:typep value expected-type)
         (loop-warn "~@<The form ~S evaluated to ~S, which was not of ~
                     the anticipated type ~S.~:@>"
-                   form constant-value expected-type)
-        (setq constantp nil constant-value nil)))
-    (values new-form constantp constant-value)))
-
-(defun loop-constantp (form)
-  (constantp form))
+                   form value expected-type)
+        (setq constantp nil value nil)))
+    (values form constantp value)))
 
 ;;;; LOOP iteration optimization
 
-(defvar *loop-duplicate-code*
-        nil)
+(defvar *loop-duplicate-code* nil)
 
-(defvar *loop-iteration-flag-var*
-        (make-symbol "LOOP-NOT-FIRST-TIME"))
+(defvar *loop-iteration-flag-var* (make-symbol "LOOP-NOT-FIRST-TIME"))
 
 (defun loop-code-duplication-threshold (env)
   (declare (ignore env))
@@ -923,10 +917,22 @@ code to be loaded.
 
 (defun loop-typed-init (data-type &optional step-var-p)
   (when (and data-type (sb!xc:subtypep data-type 'number))
-    (if (or (sb!xc:subtypep data-type 'float)
-            (sb!xc:subtypep data-type '(complex float)))
-        (coerce (if step-var-p 1 0) data-type)
-        (if step-var-p 1 0))))
+    (let ((init (if step-var-p 1 0)))
+      (flet ((like (&rest types)
+               (coerce init (find-if (lambda (type)
+                                       (sb!xc:subtypep data-type type))
+                                     types))))
+        (cond ((sb!xc:subtypep data-type 'float)
+               (like 'single-float 'double-float
+                     'short-float 'long-float 'float))
+              ((sb!xc:subtypep data-type '(complex float))
+               (like '(complex single-float)
+                     '(complex double-float)
+                     '(complex short-float)
+                     '(complex long-float)
+                     '(complex float)))
+              (t
+               init))))))
 
 (defun loop-optional-type (&optional variable)
   ;; No variable specified implies that no destructuring is permissible.
@@ -1052,7 +1058,9 @@ code to be loaded.
 (defun loop-declare-var (name dtype &optional step-var-p)
   (cond ((or (null name) (null dtype) (eq dtype t)) nil)
         ((symbolp name)
-         (unless (sb!xc:subtypep t dtype)
+         (unless (or (sb!xc:subtypep t dtype)
+                     (and (eq (find-package :cl) (symbol-package name))
+                          (eq :special (sb!int:info :variable :kind name))))
            (let ((dtype (let ((init (loop-typed-init dtype step-var-p)))
                           (if (sb!xc:typep init dtype)
                               dtype
@@ -1067,7 +1075,7 @@ code to be loaded.
         (t (error "invalid LOOP variable passed in: ~S" name))))
 
 (defun loop-maybe-bind-form (form data-type)
-  (if (loop-constantp form)
+  (if (constantp form)
       form
       (loop-make-var (gensym "LOOP-BIND-") form data-type)))
 
@@ -1726,7 +1734,8 @@ code to be loaded.
                                  `(and ,indexv-type real)))))
            (:by
             (multiple-value-setq (form stepby-constantp stepby)
-              (loop-constant-fold-if-possible form `(and ,indexv-type (real (0)))))
+              (loop-constant-fold-if-possible form
+                                              `(and ,indexv-type (real (0)))))
             (unless stepby-constantp
               (loop-make-var (setq stepby (gensym "LOOP-STEP-BY-"))
                  form
@@ -1737,7 +1746,8 @@ code to be loaded.
               maybe invalid prepositions were specified in iteration path descriptor?"
                  prep)))
          (when (and odir dir (not (eq dir odir)))
-           (loop-error "conflicting stepping directions in LOOP sequencing path"))
+           (loop-error
+             "conflicting stepping directions in LOOP sequencing path"))
          (setq odir dir))
        (when (and sequence-variable (not sequencep))
          (loop-error "missing OF or IN phrase in sequence path"))
@@ -1755,8 +1765,9 @@ code to be loaded.
                                   :key #'type-declaration-of
                                   :from-end t)))
                  (sb!int:aver (eq decl %decl))
-                 (setf (cadr decl)
-                       `(and real ,(cadr decl))))))
+                 (when decl
+                   (setf (cadr decl)
+                         `(and real ,(cadr decl)))))))
            ;; default start
            ;; DUPLICATE KLUDGE: loop-make-var generates a temporary
            ;; symbol for indexv if it is NIL. See also the comment in
@@ -1795,6 +1806,27 @@ code to be loaded.
          (setq step-hack
                `(,variable ,step-hack)))
        (let ((first-test test) (remaining-tests test))
+         ;; As far as I can tell, the effect of the following code is
+         ;; to detect cases where we know statically whether the first
+         ;; iteration of the loop will be executed. Depending on the
+         ;; situation, we can either:
+         ;;  a) save one jump and one comparison per loop (not per iteration)
+         ;;     when it will get executed
+         ;;  b) remove the loop body completely when it won't be executed
+         ;;
+         ;; Noble goals. However, the code generated in case a) will
+         ;; fool the loop induction variable detection, and cause
+         ;; code like (LOOP FOR I TO 10 ...) to use generic addition
+         ;; (bug #278a).
+         ;;
+         ;; Since the gain in case a) is rather minimal and Python is
+         ;; generally smart enough to handle b) without any extra
+         ;; support from the loop macro, I've disabled this code for
+         ;; now. The code and the comment left here in case somebody
+         ;; extends the induction variable bound detection to work
+         ;; with code where the stepping precedes the test.
+         ;; -- JES 2005-11-30
+         #+nil
          (when (and stepby-constantp start-constantp limit-constantp
                     (realp start-value) (realp limit-value))
            (when (setq first-test
@@ -1815,22 +1847,6 @@ code to be loaded.
     '((:from :upfrom :downfrom) (:to :upto :downto :above :below) (:by))
     nil (list (list kwd val)))))
 
-(defun loop-sequence-elements-path (variable data-type prep-phrases
-                                    &key
-                                    fetch-function
-                                    size-function
-                                    sequence-type
-                                    element-type)
-  (multiple-value-bind (indexv) (loop-named-var 'index)
-    (let ((sequencev (loop-named-var 'sequence)))
-      (list* nil nil                            ; dummy bindings and prologue
-             (loop-sequencer
-              indexv 'fixnum
-              variable (or data-type element-type)
-              sequencev sequence-type
-              `(,fetch-function ,sequencev ,indexv)
-              `(,size-function ,sequencev)
-              prep-phrases)))))
 
 ;;;; builtin LOOP iteration paths