0.7.9.56:

        Fix miscellaneous bugs in LOOP REPEAT:
        * incorrect type inference
        * REPEAT is a `main clause'
        * semantics change during constant folding

diff --git a/src/code/loop.lisp b/src/code/loop.lisp
index 59504a9..9f0612d 100644 (file)
--- a/src/code/loop.lisp
+++ b/src/code/loop.lisp
@@ -1247,6 +1247,22 @@ code to be loaded.
   (loop-disallow-conditional kwd)
   (loop-pseudo-body `(,(if negate 'when 'unless) ,form (go end-loop))))
 
+(defun loop-do-repeat ()
+  (loop-disallow-conditional :repeat)
+  (let ((form (loop-get-form))
+       (type 'real))
+    (let ((var (loop-make-var (gensym "LOOP-REPEAT-") form type)))
+      (push `(when (minusp (decf ,var)) (go end-loop)) *loop-before-loop*)
+      (push `(when (minusp (decf ,var)) (go end-loop)) *loop-after-body*)
+      ;; FIXME: What should
+      ;;   (loop count t into a
+      ;;         repeat 3
+      ;;         count t into b
+      ;;         finally (return (list a b)))
+      ;; return: (3 3) or (4 3)? PUSHes above are for the former
+      ;; variant, L-P-B below for the latter.
+      #+nil (loop-pseudo-body `(when (minusp (decf ,var)) (go end-loop))))))
+
 (defun loop-do-with ()
   (loop-disallow-conditional :with)
   (do ((var) (val) (dtype)) (nil)
@@ -1348,24 +1364,6 @@ code to be loaded.
                  keyword))
     (apply (car tem) var first-arg data-type (cdr tem))))
 
-(defun loop-do-repeat ()
-  (let ((form (loop-get-form))
-       (type (loop-check-data-type (loop-optional-type)
-                                   'real)))
-    (when (and (consp form)
-              (eq (car form) 'the)
-              (sb!xc:subtypep (second form) type))
-      (setq type (second form)))
-    (multiple-value-bind (number constantp value)
-       (loop-constant-fold-if-possible form type)
-      (cond ((and constantp (<= value 1)) `(t () () () ,(<= value 0) () () ()))
-           (t (let ((var (loop-make-var (gensym "LOOP-REPEAT-") number type)))
-                (if constantp
-                    `((not (plusp (setq ,var (1- ,var))))
-                      () () () () () () ())
-                    `((minusp (setq ,var (1- ,var)))
-                      () () ()))))))))
-
 (defun loop-when-it-var ()
   (or *loop-when-it-var*
       (setq *loop-when-it-var*
@@ -1883,7 +1881,8 @@ code to be loaded.
                         (when (loop-do-if when nil))   ; Normal, do when
                         (if (loop-do-if if nil))       ; synonymous
                         (unless (loop-do-if unless t)) ; Negate test on when
-                        (with (loop-do-with)))
+                        (with (loop-do-with))
+                         (repeat (loop-do-repeat)))
             :for-keywords '((= (loop-ansi-for-equals))
                             (across (loop-for-across))
                             (in (loop-for-in))
@@ -1899,8 +1898,7 @@ code to be loaded.
                             (by (loop-for-arithmetic :by))
                             (being (loop-for-being)))
             :iteration-keywords '((for (loop-do-for))
-                                  (as (loop-do-for))
-                                  (repeat (loop-do-repeat)))
+                                  (as (loop-do-for)))
             :type-symbols '(array atom bignum bit bit-vector character
                             compiled-function complex cons double-float
                             fixnum float function hash-table integer

diff --git a/tests/loop.pure.lisp b/tests/loop.pure.lisp
index 73c45e3..f282dea 100644 (file)
--- a/tests/loop.pure.lisp
+++ b/tests/loop.pure.lisp
@@ -92,3 +92,14 @@
            count t))
   (assert (null result))
   (assert (typep error 'package-error)))
+
+(assert (equal (loop for i from 1 repeat (the (integer 7 7) 7) collect i)
+               '(1 2 3 4 5 6 7)))
+
+(multiple-value-bind (result error)
+    (ignore-errors (eval '(loop for i from 1 repeat 7 of-type fixnum collect i)))
+  (assert (null result))
+  (assert (typep error 'program-error)))
+
+(assert (equal (ignore-errors (loop for i from 1 repeat 6.5 collect i))
+               (ignore-errors (loop for i from 1 repeat (eval '6.5) collect i))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 9be2bff..fc037a8 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.9.55"
+"0.7.9.56"