Commit 4b57a491 authored by Andreas Fuchs's avatar Andreas Fuchs
Browse files

0.8.4.29: 

	LOOP fixups - whee, I love digging around in code from 1986

	* make SB-LOOP::LOOP-SEQUENCER no longer choke on NIL
	  as a name for for-as-arithmetic counters
	* also make it throw a PROGRAM-ERROR when it encounters
	  a list as a counter variable.
parent 0ba72140

NEWS

+3 −0
Original line number Diff line number Diff line
@@ -2126,6 +2126,9 @@ changes in sbcl-0.8.5 relative to sbcl-0.8.4: 
    with values NIL and :ERROR.  (thanks to Milan Zamazal)

  * fixed bug 191c: CLOS now does proper keyword argument checking as

    described in CLHS 7.6.5 and 7.6.5.1.

  * bug fix: LOOP forms using NIL as a for-as-arithmetic counter no

    longer raise an error; further, using a list as a for-as-arithmetic

    counter now raises a meaningful error.

  * compiler enhancement: SIGNUM is now better able to derive the type

    of its result.

  * type declarations inside WITH-SLOTS are checked.  (reported by

src/code/loop.lisp

+120 −107
Original line number Diff line number Diff line
@@ -1026,11 +1026,11 @@ code to be loaded. 


(defun loop-make-var (name initialization dtype &optional iteration-var-p)

  (cond ((null name)

	 (cond ((not (null initialization))

		(push (list (setq name (gensym "LOOP-IGNORE-"))

			    initialization)

		      *loop-vars*)

		(push `(ignore ,name) *loop-declarations*))))

	 (setq name (gensym "LOOP-IGNORE-"))

	 (push (list name initialization) *loop-vars*)

	 (if (null initialization)

	     (push `(ignore ,name) *loop-declarations*)

	     (loop-declare-var name dtype)))

	((atom name)

	 (cond (iteration-var-p

		(if (member name *loop-iteration-vars*)
@@ -1699,6 +1699,9 @@ code to be loaded. 
	 (limit-constantp nil)

	 (limit-value nil)

	 )

     (flet ((assert-index-for-arithmetic (index)

	      (unless (atom indexv)

		(loop-error "Arithmetic index must be an atom."))))

       (when variable (loop-make-iteration-var variable nil variable-type))

       (do ((l prep-phrases (cdr l)) (prep) (form) (odir)) ((null l))

	 (setq prep (caar l) form (cadar l))
@@ -1712,7 +1715,11 @@ code to be loaded. 
		  ((eq prep :upfrom) (setq dir ':up)))

	    (multiple-value-setq (form start-constantp start-value)

	      (loop-constant-fold-if-possible form indexv-type))

	  (loop-make-iteration-var indexv form indexv-type))

	    (assert-index-for-arithmetic indexv)

	    ;; KLUDGE: loop-make-var generates a temporary symbol for

	    ;; indexv if it is NIL. We have to use it to have the index

	    ;; actually count

	    (setq indexv (loop-make-iteration-var indexv form indexv-type)))

	   ((:upto :to :downto :above :below)

	    (cond ((loop-tequal prep :upto) (setq inclusive-iteration

						  (setq dir ':up)))
@@ -1762,11 +1769,17 @@ code to be loaded. 
		 (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

	   ;; the (:from :downfrom :upfrom) case

	   (progn

	     (assert-index-for-arithmetic indexv)

	     (setq indexv

		   (loop-make-iteration-var

		      indexv

		      (setq start-constantp t

			    start-value (or (loop-typed-init indexv-type) 0))

	  `(and ,indexv-type real)))

		      `(and ,indexv-type real)))))

       (cond ((member dir '(nil :up))

	      (when (or limit-given default-top)

		(unless limit-given
@@ -1801,7 +1814,7 @@ code to be loaded. 
				limit-value))

	     (setq remaining-tests t)))

	 `(() (,indexv ,step)

	 ,remaining-tests ,step-hack () () ,first-test ,step-hack))))

	   ,remaining-tests ,step-hack () () ,first-test ,step-hack)))))



;;;; interfaces to the master sequencer

tests/loop.pure.lisp

+24 −0
Original line number Diff line number Diff line
@@ -179,3 +179,27 @@ 
  (assert (= (loop for v fixnum being each hash-value in ht sum v) 18))

  (assert (raises-error? (loop for v float being each hash-value in ht sum v)

                         type-error)))



;; arithmetic indexes can be NIL or symbols.

(assert (equal (loop for nil from 0 to 2 collect nil)

	       '(nil nil nil)))

(assert (equal (loop for nil to 2 collect nil)

	       '(nil nil nil)))



;; although allowed by the loop syntax definition in 6.2/LOOP,

;; 6.1.2.1.1 says: "The variable var is bound to the value of form1 in

;; the first iteration[...]"; since we can't bind (i j) to anything,

;; we give a program error.

(multiple-value-bind (function warnings-p failure-p)

    (compile nil

	     `(lambda ()

		(loop for (i j) from 4 to 6 collect nil)))

  (assert failure-p))



;; ...and another for indexes without FROM forms (these are treated

;; differently by the loop code right now

(multiple-value-bind (function warnings-p failure-p)

    (compile nil

	     `(lambda ()

		(loop for (i j) to 6 collect nil)))

  (assert failure-p))

version.lisp-expr

+1 −1
Original line number Diff line number Diff line
@@ -17,4 +17,4 @@ 
;;; checkins which aren't released. (And occasionally for internal

;;; versions, especially for internal versions off the main CVS

;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)

"0.8.4.28"
 
"0.8.4.29"