From 160e306dcbc66d4e857ae98f2a54b5a7ebbb7b21 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Tue, 19 Nov 2002 07:28:53 +0000 Subject: [PATCH] 0.7.9.56: Fix miscellaneous bugs in LOOP REPEAT: * incorrect type inference * REPEAT is a `main clause' * semantics change during constant folding --- src/code/loop.lisp | 40 +++++++++++++++++++--------------------- tests/loop.pure.lisp | 11 +++++++++++ version.lisp-expr | 2 +- 3 files changed, 31 insertions(+), 22 deletions(-) diff --git a/src/code/loop.lisp b/src/code/loop.lisp index 59504a9..9f0612d 100644 --- 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 --- 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 --- 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" -- 1.7.10.4