Add Sacla to the repository.

1 files changed, 3605 insertions, 0 deletions

diff --git a/Sacla/tests/must-loop.lisp b/Sacla/tests/must-loop.lisp
new file mode 100644
index 0000000..bb28d00
--- /dev/null
+++ b/Sacla/tests/must-loop.lisp
@@ -0,0 +1,3605 @@
+;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
+;; ALL RIGHTS RESERVED.
+;;
+;; $Id: must-loop.lisp,v 1.16 2004/09/28 01:52:16 yuji Exp $
+;; 
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions
+;; are met:
+;; 
+;;  * Redistributions of source code must retain the above copyright
+;;    notice, this list of conditions and the following disclaimer.
+;;  * Redistributions in binary form must reproduce the above copyright
+;;    notice, this list of conditions and the following disclaimer in
+;;    the documentation and/or other materials provided with the
+;;    distribution.
+;; 
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+;; simple loop
+(null (loop (return)))
+(loop (return-from nil t))
+(null (let ((stack '(0 1 2))) (loop (unless (pop stack) (return))) stack))
+(equal (multiple-value-list (loop (return (values 0 1 2)))) '(0 1 2))
+(= 100 (let ((i 0)) (loop (incf i) (when (>= i 100) (return i)))))
+(eq (let (x) (tagbody (loop (go end)) end (setq x t)) x) t)
+(eq t (catch 'end (loop (throw 'end t))))
+(eq t (block here (loop (return-from here t))))
+(= 3 (let ((i 0)) (loop (incf i) (if (= i 3) (return i)))))
+(= 9 (let ((i 0)(j 0))
+       (tagbody
+	  (loop (incf j 3) (incf i) (if (= i 3) (go exit)))
+	exit)
+       j))
+
+
+;; loop keyword identity
+(equal (let (stack) (loop :for a :from 1 :to 3 :by 1 :do (push a stack)) stack)
+       '(3 2 1))
+(let ((for (make-symbol "FOR"))
+      (from (make-symbol "FROM"))
+      (to (make-symbol "TO"))
+      (by (make-symbol "BY"))
+      (do (make-symbol "DO")))
+  (equal (eval `(let (stack)
+		 (loop ,for a ,from 1 ,to 3 ,by 1 ,do (push a stack))
+		 stack))
+	 '(3 2 1)))
+(let ((for (make-symbol "FOR")))
+  (equal (eval `(let (stack) (loop ,for a :from 1 :to 3 :by 1 :do (push a stack))
+		 stack))
+	 '(3 2 1)))
+
+(progn
+  (when (find-package "LOOP-KEY-TEST")
+    (delete-package "LOOP-KEY-TEST"))
+  (let* ((pkg (defpackage "LOOP-KEY-TEST"))
+         (for (intern "FOR" pkg))
+         (in (intern "IN" pkg))
+         (by (progn (import 'by pkg) (intern "BY" pkg)))
+         (collect (progn (import 'collect pkg) (intern "COLLECT" pkg))))
+    (export collect pkg)
+    (and (equal (eval `(loop ,for elt ,in '(1 2 3 4 5) ,by #'cddr
+                        ,collect elt))
+                '(1 3 5))
+         (delete-package pkg))))
+
+
+;; for-as-arithmetic-up with 3 forms
+(equal (let (stack) (loop for a from 1 to 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a from 1 by 1 to 3 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a to 3 by 1 from 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a to 3 from 1 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 to 3 from 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 from 1 to 3 do (push a stack)) stack)
+       '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 to 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a upfrom 1 by 1 to 3 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a to 3 by 1 upfrom 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a to 3 upfrom 1 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 to 3 upfrom 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 upfrom 1 to 3 do (push a stack)) stack)
+       '(3 2 1))
+
+
+(equal (let (stack) (loop for a from 1 upto 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a from 1 by 1 upto 3 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a upto 3 by 1 from 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a upto 3 from 1 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 upto 3 from 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 from 1 upto 3 do (push a stack)) stack)
+       '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 upto 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a upfrom 1 by 1 upto 3 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a upto 3 by 1 upfrom 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a upto 3 upfrom 1 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 upto 3 upfrom 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 upfrom 1 upto 3 do (push a stack)) stack)
+       '(3 2 1))
+
+
+(equal (let (stack) (loop for a from 1 below 4 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a from 1 by 1 below 4 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a below 4 by 1 from 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a below 4 from 1 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 below 4 from 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 from 1 below 4 do (push a stack)) stack)
+       '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 below 4 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a upfrom 1 by 1 below 4 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a below 4 by 1 upfrom 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a below 4 upfrom 1 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 below 4 upfrom 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a by 1 upfrom 1 below 4 do (push a stack)) stack)
+       '(3 2 1))
+
+
+;; for-as-arithmetic-up with 2 forms
+(equal (let (stack) (loop for a from 1 to 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop for a to 3 from 1 do (push a stack)) stack) '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 to 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop for a to 3 upfrom 1 do (push a stack)) stack) '(3 2 1))
+
+
+(equal (let (stack) (loop for a from 1 upto 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop for a upto 3 from 1 do (push a stack)) stack) '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 upto 3 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a upto 3 upfrom 1 do (push a stack)) stack)
+       '(3 2 1))
+
+
+(equal (let (stack) (loop for a from 1 below 4 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop for a below 4 from 1 do (push a stack)) stack) '(3 2 1))
+
+(equal (let (stack) (loop for a upfrom 1 below 4 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a below 4 upfrom 1 do (push a stack)) stack)
+       '(3 2 1))
+
+
+(equal (let (stack) (loop for a to 3 by 1 do (push a stack)) stack) '(3 2 1 0))
+(equal (let (stack) (loop for a by 1 to 3 do (push a stack)) stack) '(3 2 1 0))
+
+(equal (let (stack) (loop for a upto 3 by 1 do (push a stack)) stack) '(3 2 1 0))
+(equal (let (stack) (loop for a by 1 upto 3 do (push a stack)) stack) '(3 2 1 0))
+
+(equal (let (stack) (loop for a below 4 by 1 do (push a stack)) stack)
+       '(3 2 1 0))
+(equal (let (stack) (loop for a by 1 below 4 do (push a stack)) stack)
+       '(3 2 1 0))
+
+
+(= 4 (let ((stack '(1 2 3)))
+       (loop for a from 1 by 1 do (unless (pop stack) (return a)))))
+(= 4 (let ((stack '(1 2 3)))
+       (loop for a by 1 from 1 do (unless (pop stack) (return a)))))
+
+(= 4 (let ((stack '(1 2 3)))
+       (loop for a upfrom 1 by 1 do (unless (pop stack) (return a)))))
+(= 4 (let ((stack '(1 2 3)))
+       (loop for a by 1 upfrom 1 do (unless (pop stack) (return a)))))
+
+
+;; for-as-arithmetic-up with 1 form
+(= 4 (let ((stack '(1 2 3)))
+       (loop for a from 1 do (unless (pop stack) (return a)))))
+(= 4 (let ((stack '(1 2 3)))
+       (loop for a upfrom 1 do (unless (pop stack) (return a)))))
+
+(equal (let (stack) (loop for a to 3 do (push a stack)) stack)
+       '(3 2 1 0))
+(equal (let (stack) (loop for a upto 3 do (push a stack)) stack)
+       '(3 2 1 0))
+(equal (let (stack) (loop for a below 4 do (push a stack)) stack)
+       '(3 2 1 0))
+
+(= 3 (let ((stack '(1 2 3)))
+       (loop for a by 1 do (unless (pop stack) (return a)))))
+
+
+;; for-as-arithmetic-downto with 3 forms
+(equal (let (stack) (loop for a from 3 downto 1 by 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a from 3 by 1 downto 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a downto 1 by 1 from 3 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a downto 1 from 3 by 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a by 1 from 3 downto 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a by 1 downto 1 from 3 do (push a stack)) stack)
+       '(1 2 3))
+
+(equal (let (stack) (loop for a from 3 above 0 by 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a from 3 by 1 above 0 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a above 0 by 1 from 3 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a above 0 from 3 by 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a by 1 from 3 above 0 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a by 1 above 0 from 3 do (push a stack)) stack)
+       '(1 2 3))
+
+
+;; for-as-arithmetic-downto with 2 forms
+(equal (let (stack) (loop for a from 3 downto 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a downto 1 from 3 do (push a stack)) stack)
+       '(1 2 3))
+
+(equal (let (stack) (loop for a from 3 above 0 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a above 0 from 3 do (push a stack)) stack)
+       '(1 2 3))
+
+
+;; for-as-arithmetic-downfrom with 3 forms
+(equal (let (stack) (loop for a downfrom 3 to 1 by 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a downfrom 3 by 1 to 1 do (push a stack)) stack)
+       '(1 2 3))
+
+(equal (let (stack) (loop for a to 1 by 1 downfrom 3 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a to 1 downfrom 3 by 1 do (push a stack)) stack)
+       '(1 2 3))
+
+(equal (let (stack) (loop for a by 1 to 1 downfrom 3 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a by 1 downfrom 3 to 1 do (push a stack)) stack)
+       '(1 2 3))
+
+
+(equal (let (stack) (loop for a downfrom 3 downto 1 by 1 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a downfrom 3 by 1 downto 1 do (push a stack))
+	    stack)
+       '(1 2 3))
+
+(equal (let (stack) (loop for a downto 1 by 1 downfrom 3 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a downto 1 downfrom 3 by 1 do (push a stack))
+	    stack)
+       '(1 2 3))
+
+(equal (let (stack) (loop for a by 1 downto 1 downfrom 3 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a by 1 downfrom 3 downto 1 do (push a stack))
+	    stack)
+       '(1 2 3))
+
+
+(equal (let (stack) (loop for a downfrom 3 above 0 by 1 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a downfrom 3 by 1 above 0 do (push a stack))
+	    stack)
+       '(1 2 3))
+
+(equal (let (stack) (loop for a above 0 by 1 downfrom 3 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a above 0 downfrom 3 by 1 do (push a stack))
+	    stack)
+       '(1 2 3))
+
+(equal (let (stack) (loop for a by 1 above 0 downfrom 3 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a by 1 downfrom 3 above 0 do (push a stack))
+	    stack)
+       '(1 2 3))
+
+
+;; for-as-arithmetic-downfrom with 2 forms
+(equal (let (stack) (loop for a downfrom 3 to 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a to 1 downfrom 3 do (push a stack)) stack)
+       '(1 2 3))
+
+(equal (let (stack) (loop for a downfrom 3 downto 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a downto 1 downfrom 3 do (push a stack)) stack)
+       '(1 2 3))
+
+(equal (let (stack) (loop for a downfrom 3 above 0 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop for a above 0 downfrom 3 do (push a stack)) stack)
+       '(1 2 3))
+
+
+(zerop (let ((stack '(0 1 2)))
+	 (loop for a downfrom 3 by 1 do (unless (pop stack) (return a)))))
+(zerop (let ((stack '(0 1 2)))
+	 (loop for a by 1 downfrom 3 do (unless (pop stack) (return a)))))
+
+;; for-as-arithmetic-downfrom with 1 form
+(zerop (let ((stack '(0 1 2)))
+	 (loop for a downfrom 3 do (unless (pop stack) (return a)))))
+
+;; for-as-arithmetic form evaluation
+(equal (let (stack)
+	 (loop for a from (+ 1 1) upto (+ 4 6) by (1+ 1) do (push a stack))
+	 stack)
+       '(10 8 6 4 2))
+
+;; for-as-arithmetic form evaluation order
+(equal (let ((x 0)
+	     stack)
+	 (loop for a from (incf x) upto (+ (incf x) 10) by x do (push a stack))
+	 stack)
+       '(11 9 7 5 3 1))
+
+(equal (let ((x 0)
+	     stack)
+	 (loop for a from (incf x) by (incf x) upto (+ x 10) do (push a stack))
+	 stack)
+       '(11 9 7 5 3 1))
+
+(equal (let ((x 0)
+	     stack)
+	 (loop for a by (incf x) from (incf x) upto (+ x 10) do (push a stack))
+	 stack)
+       '(12 11 10 9 8 7 6 5 4 3 2))
+
+(equal (let ((x 0)
+	     stack)
+	 (loop for a by (incf x) upto (+ (incf x) 10) from (incf x)
+	       do (push a stack))
+	 stack)
+       '(12 11 10 9 8 7 6 5 4 3))
+
+;; for-as-arithmetic type
+(equal (let (stack) (loop for a t from 1 to 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+
+(equal (let (stack) (loop for a fixnum from 1 to 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+
+(equal (let (stack) (loop for a float from 1.0 to 3.0 by 1.0 do (push a stack))
+	    stack)
+       '(3.0 2.0 1.0))
+
+
+(equal (let (stack) (loop for a of-type t from 1 to 3 by 1 do (push a stack))
+	    stack)
+       '(3 2 1))
+
+(equal (let (stack)
+	 (loop for a of-type fixnum from 1 to 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+
+(equal (let (stack)
+	 (loop for a of-type float from 1.0 to 3.0 by 1.0 do (push a stack))
+	 stack)
+       '(3.0 2.0 1.0))
+
+(equal (let (stack)
+	 (loop for a of-type number from 1 to 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+
+(equal (let (stack)
+	 (loop for a of-type integer from 1 to 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+
+
+
+
+;; for-as-arithmetic misc
+(equal (let ((stack)) (loop for a from 0 upto 10 by 5 do (push a stack)) stack)
+       '(10 5 0))
+
+(equal (let ((stack)) (loop for a from 0 upto 10 by 3 do (push a stack)) stack)
+       '(9 6 3 0))
+
+(equal (let ((stack)) (loop for a from -3 upto 0 do (push a stack)) stack)
+       '(0 -1 -2 -3))
+
+(equal (let ((stack)) (loop for a downfrom 0 to -3 do (push a stack)) stack)
+       '(-3 -2 -1 0))
+(equal (let (stack) (loop as a from 1 to 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 to 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop as a from 1 upto 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 upto 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop as a from 1 below 4 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 below 4 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop as a from 1 to 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 to 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop as a from 1 upto 3 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 upto 3 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop as a from 1 below 4 do (push a stack)) stack) '(3 2 1))
+(equal (let (stack) (loop as a upfrom 1 below 4 do (push a stack)) stack)
+       '(3 2 1))
+(equal (let (stack) (loop as a to 3 by 1 do (push a stack)) stack) '(3 2 1 0))
+(equal (let (stack) (loop as a upto 3 by 1 do (push a stack)) stack) '(3 2 1 0))
+(equal (let (stack) (loop as a below 4 by 1 do (push a stack)) stack)
+       '(3 2 1 0))
+(= 4 (let ((stack '(1 2 3)))
+       (loop as a from 1 by 1 do (unless (pop stack) (return a)))))
+(= 4 (let ((stack '(1 2 3)))
+       (loop as a upfrom 1 by 1 do (unless (pop stack) (return a)))))
+(= 4 (let ((stack '(1 2 3)))
+       (loop as a from 1 do (unless (pop stack) (return a)))))
+(equal (let (stack) (loop as a to 3 do (push a stack)) stack) '(3 2 1 0))
+(= 3 (let ((stack '(1 2 3)))
+       (loop as a by 1 do (unless (pop stack) (return a)))))
+(equal (let (stack) (loop as a from 3 downto 1 by 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a from 3 above 0 by 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a from 3 downto 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a from 3 above 0 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 to 1 by 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a to 1 by 1 downfrom 3 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a by 1 to 1 downfrom 3 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 downto 1 by 1 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a downto 1 by 1 downfrom 3 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a by 1 downto 1 downfrom 3 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 above 0 by 1 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a above 0 by 1 downfrom 3 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a by 1 above 0 downfrom 3 do (push a stack))
+	    stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 to 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 downto 1 do (push a stack)) stack)
+       '(1 2 3))
+(equal (let (stack) (loop as a downfrom 3 above 0 do (push a stack)) stack)
+       '(1 2 3))
+(zerop (let ((stack '(0 1 2)))
+	 (loop as a downfrom 3 by 1 do (unless (pop stack) (return a)))))
+(zerop (let ((stack '(0 1 2)))
+	 (loop as a downfrom 3 do (unless (pop stack) (return a)))))
+(equal (let (stack) (loop for a from 0 upto 0 do (push a stack)) stack) '(0))
+(null (loop for a upfrom 0 below 0))
+(null (loop for a upfrom 10 to -10 collect a))
+(equal (let (stack)
+	 (loop for a from 1/3 upto 1 by 1/3 do (push a stack))
+	 stack)
+       '(1 2/3 1/3))
+(equal (let (stack)
+	 (loop for a of-type rational from 1/3 upto 5/3 by 1/3 do (push a stack))
+	 stack)
+       '(5/3 4/3 1 2/3 1/3))
+(equal (let(stack) (loop for a fixnum below 3 do (push a stack)) stack)
+       '(2 1 0))
+(equal (let(stack) (loop for a of-type fixnum below 3 do (push a stack)) stack)
+       '(2 1 0))
+(equal (let(stack) (loop for a of-type (integer 0 2)
+			 below 3 do (push a stack)) stack)
+       '(2 1 0))
+
+
+;; for-as-in-list
+(null (loop for a in '()))
+(equal (let (stack) (loop for a in '(0 1 2) do (push a stack)) stack)
+       '(2 1 0))
+(equal (let (stack)
+	 (loop for a in (let ((i 0)) (list (incf i) (incf i) (incf i)))
+	       do (push a stack))
+	 stack)
+       '(3 2 1))
+(handler-case (loop for a in '(0 1 . 2))
+  (type-error ()
+    t)
+  (error () nil)
+  (:no-error (&rest rest)
+    (declare (ignore rest))	     
+    nil))				; check must be done by endp
+(equal (let (stack)
+	 (loop for a in '(0 1 2 3) by #'cdr do (push a stack))
+	 stack)
+       '(3 2 1 0))
+(equal (let (stack)
+	 (loop for a in '(0 1 2 3) by #'cddr do (push a stack))
+	 stack)
+       '(2 0))
+(equal (let (stack)
+	 (loop for a in '(0 1 2 3) by #'cdddr do (push a stack))
+	 stack)
+       '(3 0))
+(equal (let (stack)
+	 (loop for a in '(0 1 2 3) by #'cddddr do (push a stack))
+	 stack)
+       '(0))
+(equal (let (stack) (loop for a t in '(0 1 2) do (push a stack)) stack) '(2 1 0))
+(equal (let (stack) (loop for a of-type t in '(0 1 2) do (push a stack)) stack)
+       '(2 1 0))
+(equal (let (stack) (loop for a fixnum in '(0 1 2) do (push a stack))
+	    stack) '(2 1 0))
+(equal (let (stack) (loop for a of-type fixnum in '(0 1 2) do (push a stack))
+	    stack) '(2 1 0))
+(equal (let (stack) (loop for a of-type t in '(0 1 2) do (push a stack))
+	    stack) '(2 1 0))
+(equal (let (stack) (loop for a float in '(0.0 1.0 2.0) do (push a stack))
+	    stack) '(2.0 1.0 0.0))
+(equal (let (stack) (loop for a of-type float in '(0.0 1.0 2.0)
+			  do (push a stack))
+	    stack) '(2.0 1.0 0.0))
+
+
+      
+
+
+;; for-as-on-list
+(null (loop for a on '()))
+(equal (let (stack) (loop for a on '(0 1 2) do (push a stack)) stack)
+       '((2) (1 2) (0 1 2)))
+(equal (let (stack)
+	 (loop for a on (let ((i 0)) (list (incf i) (incf i) (incf i)))
+	       do (push (car a) stack))
+	 stack)
+       '(3 2 1))
+(equal (let (stack) (loop for a on '(0 1 . 2) do (push a stack)) stack)
+       '((1 . 2) (0 1 . 2)))		; check must be done by atom
+(equal (let (stack)
+	 (loop for a on '(0 1 2 3) by #'cdr do (push a stack))
+	 stack)
+       '((3) (2 3) (1 2 3) (0 1 2 3)))
+(equal (let (stack)
+	 (loop for a on '(0 1 2 3) by #'cddr do (push a stack))
+	 stack)
+       '((2 3) (0 1 2 3)))
+(equal (let (stack)
+	 (loop for a on '(0 1 2 3) by #'cdddr do (push a stack))
+	 stack)
+       '((3) (0 1 2 3)))
+(equal (let (stack)
+	 (loop for a on '(0 1 2 3) by #'cddddr do (push a stack))
+	 stack)
+       '((0 1 2 3)))
+(equal (let (stack) (loop for a t on '(0 1 2) do (push a stack)) stack)
+       '((2) (1 2) (0 1 2)))
+(equal (let (stack) (loop for a of-type t on '(0 1 2) do (push a stack)) stack)
+       '((2) (1 2) (0 1 2)))
+(equal (let (stack) (loop for a of-type list on '(0 1 2) do (push a stack))
+	    stack)
+       '((2) (1 2) (0 1 2)))
+
+(equal (let (stack)
+	 (loop for a on '(0 1 2 3) by #'(lambda (arg) (cddddr arg))
+               do (push a stack))
+	 stack)
+       '((0 1 2 3)))
+
+
+;; for-as-across
+(null (loop for a across ""))
+(null (let (stack) (loop for a across "" do (push a stack)) stack))
+(equal (let (stack) (loop for a across "abc" do (push a stack)) stack)
+       '(#\c #\b #\a))
+(equal (let (stack) (loop for a across #(x y z) do (push a stack)) stack)
+       '(z y x))
+(equal (let (stack) (loop for a across #*0101 do (push a stack)) stack)
+       '(1 0 1 0))
+(equal (let (stack) (loop for a t across "abc" do (push a stack)) stack)
+       '(#\c #\b #\a))
+(equal (let (stack) (loop for a of-type t across "abc" do (push a stack)) stack)
+       '(#\c #\b #\a))
+(equal (let (stack) (loop for a of-type character across "abc"
+			  do (push a stack)) stack)
+       '(#\c #\b #\a))
+(equal (let (stack) (loop for a of-type base-char across "abc"
+			  do (push a stack)) stack)
+       '(#\c #\b #\a))
+(equal (let (stack) (loop for a float across #(0.0 1.0 2.0)
+			  do (push a stack)) stack)
+       '(2.0 1.0 0.0))
+(equal (let (stack) (loop for a of-type float across #(0.0 1.0 2.0)
+			  do (push a stack)) stack)
+       '(2.0 1.0 0.0))
+(equal (let (stack) (loop for a fixnum across #(0 1 2)
+			  do (push a stack)) stack)
+       '(2 1 0))
+(equal (let (stack) (loop for a of-type fixnum across #(0 1 2)
+			  do (push a stack)) stack)
+       '(2 1 0))
+
+
+
+
+
+
+;; for-as-equals-then
+(= (let ((i 3)) (loop for a = 0 then (1+ a)
+		      do (when (zerop (decf i)) (return a))))
+   2)
+(equal (let (stack) (loop for a = '(0 1 2) then (cdr a)
+			  do (if a (push (car a) stack) (return stack))))
+       '(2 1 0))
+(equal (let (stack) (loop with i = 0 for x = i
+			  do (when (= i 3) (return))
+			  (push x stack) (incf i)) stack)
+       '(2 1 0))
+(equal (let (stack)
+	 (loop for i = 0 then (1+ i) do (push i stack) when (= i 3) return t)
+	 stack)
+       '(3 2 1 0))
+(equal (let (stack)
+	 (loop for i fixnum = 0 then (1+ i) do (push i stack)
+	       when (= i 3) return t)
+	 stack)
+       '(3 2 1 0))
+(equal (let (stack)
+	 (loop for i of-type fixnum = 0 then (1+ i) do (push i stack)
+	       when (= i 3) return t)
+	 stack)
+       '(3 2 1 0))
+(equal (let (stack)
+	 (loop for i float = 0.0 then (1+ i) do (push i stack)
+	       when (= i 3.0) return t)
+	 stack)
+       '(3.0 2.0 1.0 0.0))
+(equal (let (stack)
+	 (loop for i of-type float = 0.0 then (1+ i) do (push i stack)
+	       when (= i 3.0) return t)
+	 stack)
+       '(3.0 2.0 1.0 0.0))
+(equal (let (stack)
+	 (loop for i t = 0.0 then (1+ i) do (push i stack)
+	       when (= i 3.0) return t)
+	 stack)
+       '(3.0 2.0 1.0 0.0))
+(equal (let (stack)
+	 (loop for i of-type t = 0.0 then (1+ i) do (push i stack)
+	       when (= i 3.0) return t)
+	 stack)
+       '(3.0 2.0 1.0 0.0))
+(let ((chars '(#\a #\b #\c #\d)))
+  (eq t (loop for c = (pop chars) unless chars return t)))
+(let ((chars '(#\a #\b #\c #\d)))
+  (eq t (loop for c of-type character = (pop chars) unless chars return t)))
+(let ((chars '(#\a #\b #\c #\d)))
+  (eq t (loop for c of-type base-char = (pop chars) unless chars return t)))
+(equal (let (stack)
+	 (loop for i of-type (integer 0 3) = 0 then (1+ i) do (push i stack)
+	       when (= i 3) return t)
+	 stack)
+       '(3 2 1 0))
+
+(flet ((triple (n) (values n (+ n 1) (+ n 2))))
+  (equal (loop for i from 0 upto 2
+               for (a b c) = (multiple-value-list (triple i))
+               append `(,a ,b ,c))
+         '(0 1 2 1 2 3 2 3 4)))
+(flet ((triple (n) (values n `(,(+ n 1)) `((,(+ n 2))))))
+  (equal (loop for i from 0 upto 2
+               for (a (b) ((c))) = (multiple-value-list (triple i))
+               append `(,a ,b ,c))
+         '(0 1 2 1 2 3 2 3 4)))
+(flet ((triple (n) (values n
+                           `(,(+ n 10) ,(+ n 11) ,(+ n 12) ,(+ n 13))
+                           `(,(+ n 20) ,(+ n 21) ,(+ n 22)))))
+  (equal (loop for i from 0 upto 2
+               for (a (b0 b1 b2 b3) (c0 c1 c2)) = (multiple-value-list (triple i))
+               append `(,a ,b0 ,b1 ,b2 ,b3 ,c0 ,c1 ,c2))
+         '(0 10 11 12 13 20 21 22 1 11 12 13 14 21 22 23 2 12 13 14 15 22 23 24)))
+         
+(flet ((triple (n) (values n
+                           `(,(+ n 10) ,(+ n 11) ,(+ n 12) ,(+ n 13))
+                           `(,(+ n 200)
+                             (,(+ n 210) ,(+ n 211) ,(+ n 212) ,(+ n 213))
+                             ,(+ n 220)))))
+  (equal (loop for i from 0 upto 2
+               for (a (b0 b1 b2 b3) (c0 (c10 c11 c12) c2)) =
+               (multiple-value-list (triple i))
+               append `(,a ,b0 ,b1 ,b2 ,b3 ,c0 ,c10 ,c11 ,c12 ,c2))
+         '(0 10 11 12 13 200 210 211 212 220
+           1 11 12 13 14 201 211 212 213 221
+           2 12 13 14 15 202 212 213 214 222)))
+  
+
+
+
+
+
+
+;; for-as-hash
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being each hash-key of table do (push k stack))
+  (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being the hash-key of table do (push k stack))
+  (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being each hash-keys of table do (push k stack))
+  (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being the hash-keys of table do (push k stack))
+  (null (set-difference stack '(k0 k1 k2))))
+
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being each hash-key in table do (push k stack))
+  (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being the hash-key in table do (push k stack))
+  (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being each hash-keys in table do (push k stack))
+  (null (set-difference stack '(k0 k1 k2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being the hash-keys in table do (push k stack))
+  (null (set-difference stack '(k0 k1 k2))))
+
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being each hash-key of table using (hash-value v)
+	do (push (list k v) stack))
+  (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being the hash-key of table using (hash-value v)
+	do (push (list k v) stack))
+  (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being each hash-keys of table using (hash-value v)
+	do (push (list k v) stack))
+  (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being the hash-keys of table using (hash-value v)
+	do (push (list k v) stack))
+  (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being each hash-key in table using (hash-value v)
+	do (push (list k v) stack))
+  (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being the hash-key in table using (hash-value v)
+	do (push (list k v) stack))
+  (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being each hash-keys in table using (hash-value v)
+	do (push (list k v) stack))
+  (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k being the hash-keys in table using (hash-value v)
+	do (push (list k v) stack))
+  (null (set-difference stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+
+
+
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being each hash-value of table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being the hash-value of table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being each hash-values of table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being the hash-values of table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being each hash-value in table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being the hash-value in table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being each hash-values in table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being the hash-values in table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being each hash-value of table using (hash-key k)
+	do (push (list k v) stack))
+  (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being the hash-value of table using (hash-key k)
+	do (push (list k v) stack))
+  (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being each hash-values of table using (hash-key k)
+	do (push (list k v) stack))
+  (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being the hash-values of table using (hash-key k)
+	do (push (list k v) stack))
+  (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being each hash-value in table using (hash-key k)
+	do (push (list k v) stack))
+  (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being the hash-value in table using (hash-key k)
+	do (push (list k v) stack))
+  (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being each hash-values in table using (hash-key k)
+	do (push (list k v) stack))
+  (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v being the hash-values in table using (hash-key k)
+	do (push (list k v) stack))
+  (null (set-exclusive-or stack '((k0 v0) (k1 v1) (k2 v2)) :test #'equal)))
+
+(let ((table (make-hash-table :test 'equal))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v))
+	'((k0 k00) (k1 k11) (k2 k22)) '((v0 v00) (v1 v11) (v2 v22)))
+  (loop for (k kk) being each hash-key of table do (push (list k kk) stack))
+  (null (set-exclusive-or stack '((k0 k00) (k1 k11) (k2 k22)) :test #'equal)))
+
+(let ((table (make-hash-table :test 'equal))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v))
+	'((k0 k00) (k1 k11) (k2 k22)) '((v0 v00) (v1 v11) (v2 v22)))
+  (loop :for (k kk) :being :each :hash-key :of table :using (hash-value (v vv))
+	do (push (list k kk v vv) stack))
+  (null (set-exclusive-or stack
+			'((k0 k00 v0 v00) (k1 k11 v1 v11) (k2 k22 v2 v22))
+			:test #'equal)))
+
+(let ((table (make-hash-table :test 'equal))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v))
+	'((k0 k00) (k1 k11) (k2 k22)) '((v0 v00) (v1 v11) (v2 v22)))
+  (loop :for (v vv) :being :each :hash-value :of table :using (hash-key (k kk))
+	do (push (list k kk v vv) stack))
+  (null (set-exclusive-or stack
+			'((k0 k00 v0 v00) (k1 k11 v1 v11) (k2 k22 v2 v22))
+			:test #'equal)))
+
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for k of-type symbol being each hash-key of table do (push k stack))
+  (null (set-exclusive-or stack '(k0 k1 k2))))
+
+(let ((table (make-hash-table :test 'equal))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v))
+	'((k0 k00) (k1 k11) (k2 k22)) '((v0 v00) (v1 v11) (v2 v22)))
+  (loop for (k kk) of-type symbol being each hash-key of table
+	do (push (list k kk) stack))
+  (null (set-exclusive-or stack '((k0 k00) (k1 k11) (k2 k22)) :test #'equal)))
+
+(let ((table (make-hash-table :test 'equal))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v))
+	'((k0 k00) (k1 k11) (k2 k22)) '((v0 v00) (v1 v11) (v2 v22)))
+  (loop for (k kk) of-type (symbol symbol) being each hash-key of table
+	do (push (list k kk) stack))
+  (null (set-exclusive-or stack '((k0 k00) (k1 k11) (k2 k22)) :test #'equal)))
+
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0 1 2) '(v0 v1 v2))
+  (loop for k fixnum being each hash-key of table do (push k stack))
+  (null (set-exclusive-or stack '(0 1 2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0 1 2) '(v0 v1 v2))
+  (loop for k of-type fixnum being each hash-key of table do (push k stack))
+  (null (set-exclusive-or stack '(0 1 2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0.0 1.0 2.0) '(v0 v1 v2))
+  (loop for k float being each hash-key of table do (push k stack))
+  (null (set-exclusive-or stack '(0.0 1.0 2.0))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0.0 1.0 2.0) '(v0 v1 v2))
+  (loop for k of-type float being each hash-key of table do (push k stack))
+  (null (set-exclusive-or stack '(0.0 1.0 2.0))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0.0 1.0 2.0) '(v0 v1 v2))
+  (loop for k t being each hash-key of table do (push k stack))
+  (null (set-exclusive-or stack '(0.0 1.0 2.0))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(0.0 1.0 2.0) '(v0 v1 v2))
+  (loop for k of-type t being each hash-key of table do (push k stack))
+  (null (set-exclusive-or stack '(0.0 1.0 2.0))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(#\a #\b #\c) '(v0 v1 v2))
+  (loop for k of-type character being each hash-key of table do (push k stack))
+  (null (set-exclusive-or stack '(#\a #\b #\c))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v t being each hash-value of table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v of-type t being each hash-value of table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(v0 v1 v2))
+  (loop for v of-type symbol being each hash-value of table do (push v stack))
+  (null (set-exclusive-or stack '(v0 v1 v2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(0 1 2))
+  (loop for v fixnum being each hash-value of table do (push v stack))
+  (null (set-exclusive-or stack '(0 1 2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(0 1 2))
+  (loop for v of-type (integer 0 2) being each hash-value of table
+	do (push v stack))
+  (null (set-exclusive-or stack '(0 1 2))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(0.0 1.0 2.0))
+  (loop for v float being each hash-value of table do (push v stack))
+  (null (set-exclusive-or stack '(0.0 1.0 2.0))))
+(let ((table (make-hash-table))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v)) '(k0 k1 k2) '(#\a #\b #\c))
+  (loop for v of-type base-char being each hash-value of table do (push v stack))
+  (null (set-exclusive-or stack '(#\a #\b #\c))))
+
+
+
+
+;; for-as and preposition
+(equal (let (stack)
+	 (loop for a from 1 upto 3 and x = 0 then a
+	       do (push x stack))
+	 stack)
+       '(2 1 0))
+(equal (let (stack)
+	 (loop for a from 0 upto 3
+	       for x = 0 then a
+	       do (push x stack))
+	 stack)
+       '(3 2 1 0))
+(equal (let ((i 4)
+	     stack)
+	 (loop for a = 0 then (1+ a)
+	       for b = 0 then a
+	       for c = 0 then b
+	       do (when (zerop (decf i)) (return))
+	       (push (list a b c) stack))
+	 stack)
+       '((2 2 2) (1 1 1) (0 0 0)))
+(equal (let ((i 5)
+	     stack)
+	 (loop for a = 0 then (1+ a) and b = 0 then a and c = 0 then b
+	       do (when (zerop (decf i)) (return))
+	       (push (list a b c) stack))
+	 stack)
+       '((3 2 1) (2 1 0) (1 0 0) (0 0 0)))
+(equal (let (stack) (loop for a in '(0 1 2 3) for x = a do (push x stack)) stack)
+       '(3 2 1 0))
+(equal (let (stack) (loop for a in '(0 1 2 3) and x = 100 then a
+			  do (push x stack)) stack)
+       '(2 1 0 100))
+(equal (let (stack) (loop for a on '(0 1 2 3) for x = (car a)
+			  do (push x stack)) stack)
+       '(3 2 1 0))
+(equal (let (stack) (loop for a on '(0 1 2 3) and x = 100 then (car a)
+			  do (push x stack)) stack)
+       '(2 1 0 100))
+(equal (let (stack) (loop for a across #(0 1 2 3) for x = a
+			  do (push x stack)) stack)
+       '(3 2 1 0))
+(equal (let (stack) (loop for a across #(0 1 2 3) and x = 100 then a
+			  do (push x stack)) stack)
+       '(2 1 0 100))
+(equal (loop for x from 1 to 10 
+	     for y = nil then x 
+	     collect (list x y))
+       '((1 NIL) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9) (10 10)))
+(equal (loop for x from 1 to 10 
+	     and y = nil then x 
+	     collect (list x y))
+       '((1 NIL) (2 1) (3 2) (4 3) (5 4) (6 5) (7 6) (8 7) (9 8) (10 9)))
+(= 280 (loop for a upfrom 0 upto 9
+	     and b downfrom 9 downto 0
+	     and c from 0 to 9
+	     and d from 10 above 0
+	     and e below 10
+	     and f to 9
+	     summing (+ a b c d e f)))
+(equal (loop for a from 1 upto 9
+	     as b = 0 then a
+	     as c = -1 then b
+	     as d = -2 then c
+	     as e = -3 then d
+	     as f = -4 then e
+	     collecting (list a b c d e f))
+       '((1 0 -1 -2 -3 -4) (2 2 2 2 2 2) (3 3 3 3 3 3) (4 4 4 4 4 4)
+	 (5 5 5 5 5 5) (6 6 6 6 6 6) (7 7 7 7 7 7) (8 8 8 8 8 8) (9 9 9 9 9 9)))
+(equal (loop for a from 1 upto 9
+	     and b = 0 then a
+	     and c = -1 then b
+	     and d = -2 then c
+	     and e = -3 then d
+	     and f = -4 then e
+	     collecting (list a b c d e f))
+       '((1 0 -1 -2 -3 -4) (2 1 0 -1 -2 -3) (3 2 1 0 -1 -2) (4 3 2 1 0 -1)
+	 (5 4 3 2 1 0) (6 5 4 3 2 1) (7 6 5 4 3 2) (8 7 6 5 4 3) (9 8 7 6 5 4)))
+(equal (loop for a from 1 upto 9
+	     and b = 0 then a
+	     and c = -1 then b
+	     and d = -2 then c
+	     and e = -3 then d
+	     and f = -4 then e
+	     for i from 9 downto 1
+	     and j = 8 then i
+	     and k = 7 then j
+	     and l = 6 then k
+	     and m = 5 then l
+	     and n = 4 then m
+	     collecting (list a b c d e f)
+	     collecting (list i j k l m n))
+       '((1 0 -1 -2 -3 -4) (9 8 7 6 5 4) (2 1 0 -1 -2 -3) (8 9 8 7 6 5)
+	 (3 2 1 0 -1 -2)
+	 (7 8 9 8 7 6) (4 3 2 1 0 -1) (6 7 8 9 8 7) (5 4 3 2 1 0) (5 6 7 8 9 8)
+	 (6 5 4 3 2 1) (4 5 6 7 8 9) (7 6 5 4 3 2) (3 4 5 6 7 8) (8 7 6 5 4 3)
+	 (2 3 4 5 6 7) (9 8 7 6 5 4) (1 2 3 4 5 6)))
+
+(let (stack)
+  (loop for a on (progn (push 1 stack) '(0 1 2))
+        and b across (progn (push 2 stack) "abc"))
+  (equal '(2 1) stack))
+
+
+
+;; ambiguous cases
+(equal (let ((a 5))
+         (loop for a from 0 upto 5
+               and b from a downto 0
+               collect (list a b)))
+       '((0 5) (1 4) (2 3) (3 2) (4 1) (5 0)))
+(equal (let ((a :outer))
+         (loop for a from 0 upto 5
+               and b in (list a)
+               collect (list a b)))
+       '((0 :outer)))
+(equal (let ((b 0))
+         (loop for a from b upto 5
+               and b in '(a b c)
+               collecting (list a b)))
+       '((0 a) (1 b) (2 c)))
+
+
+;; with-clause
+(zerop (loop with x = 0 do (return x)))
+(equal (let (stack)
+	 (loop with x = 1 for a from x to 3 by 1 do (push a stack)) stack)
+       '(3 2 1))
+(equal (loop with a = 1 
+	     with b = (+ a 2) 
+	     with c = (+ b 3)
+	     return (list a b c))
+       '(1 3 6))
+(equal (loop with a = 1 
+	     and b = 2 
+	     and c = 3
+	     return (list a b c))
+       '(1 2 3))
+(let ((a 5)
+      (b 10))
+  (equal (loop with a = 1
+	       and b = (+ a 2)
+	       and c = (+ b 3)
+	       return (list a b c))
+	 '(1 7 13)))
+(equal (loop with (a b c) of-type (float integer float)
+	     return (list a b c))
+       '(0.0 0 0.0))
+(equal (loop with (a b c) of-type float 
+	     return (list a b c))
+       '(0.0 0.0 0.0))
+(flet ((triple () (values 0 1 2)))
+  (equal (loop with (a b c) = (multiple-value-list (triple))
+               do (return (list a b c)))
+         '(0 1 2)))
+(flet ((triple () (values 0 '(1) 2)))
+  (equal (loop with (a (b) c) = (multiple-value-list (triple))
+               do (return (list a b c)))
+         '(0 1 2)))
+(flet ((triple () (values 0 '(0 1 2) 2)))
+  (equal (loop with (a (nil b) c d) = (multiple-value-list (triple))
+               do (return (list a b c d)))
+         '(0 1 2 nil)))
+
+(flet ((triple () (values 0 1 2)))
+  (equal (loop with (a b c) fixnum = (multiple-value-list (triple))
+               do (return (list a b c)))
+         '(0 1 2)))
+(flet ((triple () (values 0 '(1) 2)))
+  (equal (loop with (a (b) c) of-type (fixnum (fixnum) fixnum) =
+               (multiple-value-list (triple))
+               do (return (list a b c)))
+         '(0 1 2)))
+
+
+
+;; binding (preferable)
+(equal (loop for a from 0 upto 5
+             for b from a downto -5
+             collect (list a b))
+       '((0 0) (1 -1) (2 -2) (3 -3) (4 -4) (5 -5)))
+(equal (loop for a from 0 upto 5
+             with x = a
+             collect (list a x))
+       '((0 0) (1 0) (2 0) (3 0) (4 0) (5 0)))
+
+
+;; initial-final-clause
+(zerop (loop initially (return 0)))
+(zerop (loop repeat 2 finally (return 0)))
+(= (loop with x = 0 initially (incf x) return x) 1)
+(= (loop with x = 0 for a from 0 below 3
+	 initially (incf x) finally (return (incf x)))
+   2)
+(= (loop with x = 0 for a from 0 below 3
+	 initially (incf x) (incf x) finally (return (incf x)))
+   3)
+(= (loop with x = 0 for a from 0 upto 3
+	 initially (incf x) finally (incf x) (return (incf x)))
+   3)
+(= (loop with x = 0 for a from 0 upto 3
+	 initially (incf x) (incf x) finally (incf x) (return (incf x)))
+   4)
+(= (loop with x = 0 for a from 0 below 3
+	 do (incf x)
+	 initially (incf x) (incf x) finally (incf x) (return (incf x)))
+   7)
+
+; #-CLISP
+; ;;Bruno: unfounded expectations about the value of for-as iteration
+; ;;variables in INITIALLY and FINALLY clauses
+; ;;(See http://www.cliki.net/Proposed%20ANSI%20Revisions%20and%20Clarifications
+; ;;for a discussion of this spec weakness.)
+; (equal (let (val) (loop for a downto 3 from 100
+; 			for b in '(x y z) and c = 50 then (1+ c)
+; 			initially (setq val (list a b c))
+; 			finally (setq val (append (list a b c) val)))
+; 	    val)
+;        '(97 z 52 100 x 50))
+(= 33 (loop with x = 2
+	    initially (setq x (* x 3))
+	    for i below 3
+	    initially (setq x (* x 5))
+	    do (incf x i)
+	    finally (return x)))
+(equal (loop with x = nil
+	     repeat 2
+	     initially (push 'initially0 x)
+	     finally (push 'finally0 x)
+	     initially (push 'initially1 x)
+	     finally (push 'finally1 x)
+	     do (push 'body0 x)
+	     finally (push 'finally2 x) (push 'finally3 x)
+	     finally (return (reverse x))
+	     initially (push 'initially2 x) (push 'initially3 x)
+	     do (push 'body1 x))
+       '(initially0 initially1 initially2 initially3
+	 body0 body1 body0 body1
+	 finally0 finally1 finally2 finally3))
+
+
+
+;; do-clause
+(equal (loop with i = 3
+	     with stack = nil
+	     do (when (zerop i) (loop-finish))
+	     (decf i)
+	     (push i stack)
+	     finally (return stack))
+       '(0 1 2))
+(equal (loop with i = 3
+	     with stack = nil
+	     doing (when (zerop i) (loop-finish))
+	     (decf i)
+	     (push i stack)
+	     finally (return stack))
+       '(0 1 2))
+(= (loop with x = 10 do (return x)) 10)
+(= (loop with x = 10 doing (return x)) 10)
+(= (loop with x = 0 do (incf x) doing (incf x) (return x)) 2)
+(= (loop with x = 0 do (incf x) doing (incf x) do (return x)) 2)
+(= (loop with x = 0 do (incf x) (incf x) doing (return x)) 2)
+(= (loop with x = 0 do (incf x) (incf x) (incf x) doing (incf x) (return x)) 4)
+
+
+
+;; conditional-clauses
+(let ((odd 0)
+      (even 0))
+  (and (null (loop for a from 1 upto 10
+		   if (oddp a) do (incf odd) else do (incf even) end))
+       (= 5 odd even)))
+(let ((odd+ 0) (even+ 0) (odd- 0) (even- 0))
+  (and (null (loop for a from -10 upto 10
+		   if (oddp a) if (> a 0) do (incf odd+) else do (incf odd-) end
+		   else if (> a 0) do (incf even+) else do (incf even-)))
+       (= 5 odd+ even+ odd-)
+       (= even- 6)))
+(let ((odd+ 0) (even+ 0) (odd- 0) (even- 0))
+  (and (null (loop for a from -10 upto 10
+		   unless (zerop a)
+		     if (oddp a)
+		       if (> a 0) do (incf odd+) else do (incf odd-) end
+		     else
+		       if (> a 0) do (incf even+) else do (incf even-)))
+       (= 5 odd+ even+ odd- even-)))
+(let ((odd+ 0) (even+ 0) (odd- 0) (even- 0))
+  (and (null (loop for a from -10 upto 10
+		   if (not (zerop a))
+		     when (oddp a)
+		       unless (< a 0) do (incf odd+) else do (incf odd-) end
+		     else
+		       unless (<= a 0) do (incf even+) else do (incf even-)))
+       (= 5 odd+ even+ odd- even-)))
+(handler-bind ((simple-error #'(lambda (c) (declare (ignore c)) (continue))))
+  (eq 'continued
+      (loop for item in '(1 2 3 a 4 5)
+	    when (not (numberp item))
+	    return (or (cerror "ignore this error" "non-numeric value: ~s" item)
+		       'continued))))
+(equal (loop for i in '(1 324 2345 323 2 4 235 252)
+	     when (oddp i) collect i into odd-numbers
+	     else			; I is even.
+	     collect i into even-numbers
+	     finally
+	     (return (list odd-numbers even-numbers)))
+       '((1 2345 323 235) (324 2 4 252)))
+(equal (loop for i in '(1 2 3 4 5 6)
+	     when (and (> i 3) i)
+	     collect it)
+       '(4 5 6))
+(= 4 (loop for i in '(1 2 3 4 5 6)
+	   when (and (> i 3) i)
+	   return it))
+(equal (let ((list '(0 3.0 apple 4 5 9.8 orange banana)))
+	 (loop for i in list
+	       when (numberp i)
+	       when (floatp i)
+	       collect i into float-numbers
+	       else			; Not (floatp i)
+	       collect i into other-numbers
+	       else			; Not (numberp i)
+	       when (symbolp i) 
+	       collect i into symbol-list
+	       else			; Not (symbolp i)
+	       do (error "found a funny value in list ~S, value ~S~%" list i)
+	       finally (return (list float-numbers other-numbers symbol-list))))
+       '((3.0 9.8) (0 4 5) (APPLE ORANGE BANANA)))
+(equal (loop for i below 5 if (oddp i) collecting i) '(1 3))
+(equal (loop for i below 5 when (oddp i) collecting i) '(1 3))
+(equal (loop for i below 5
+	     if (oddp i) collecting i else collecting (list i))
+       '((0) 1 (2) 3 (4)))
+(equal (loop for i below 5
+	     when (oddp i) collecting i else collecting (list i))
+       '((0) 1 (2) 3 (4)))
+(equal (loop for i below 5 unless (evenp i) collecting i) '(1 3))
+(equal (loop for i below 5
+	     unless (evenp i) collecting i else collecting (list i))
+       '((0) 1 (2) 3 (4)))
+
+(equal (loop for i below 5 if (oddp i) collecting i end) '(1 3))
+(equal (loop for i below 5 when (oddp i) collecting i end) '(1 3))
+(equal (loop for i below 5
+	     if (oddp i) collecting i else collecting (list i) end)
+       '((0) 1 (2) 3 (4)))
+(equal (loop for i below 5
+	     when (oddp i) collecting i else collecting (list i) end)
+       '((0) 1 (2) 3 (4)))
+(equal (loop for i below 5 unless (evenp i) collecting i end) '(1 3))
+(equal (loop for i below 5
+	     unless (evenp i) collecting i else collecting (list i) end)
+       '((0) 1 (2) 3 (4)))
+
+(equal (loop for (a b) in '((0 0) (0 1))
+	     if (zerop a) if (zerop b) collect '0-0 else collect '0-1)
+       '(|0-0| |0-1|))
+(equal (loop for (a b) in '((0 0) (0 1))
+	     when (zerop a) if (zerop b) collect '0-0 else collect '0-1)
+       '(|0-0| |0-1|))
+(equal (loop for (a b) in '((0 0) (0 1) (1 0) (1 1))
+	     if (zerop a) if (= b 1) collect '0-1 end
+	     else collect '1-X)
+       '(|0-1| |1-X| |1-X|))
+(equal (loop for (a b) in '((0 0) (0 1) (1 0) (1 1))
+	     when (zerop a) if (= b 1) collect '0-1 end
+	     else collect '1-X)
+       '(|0-1| |1-X| |1-X|))
+(equal (loop for (a b) in '((0 0) (0 1))
+	     unless (not (zerop a)) if (zerop b) collect '0-0 else collect '0-1)
+       '(|0-0| |0-1|))
+(equal (loop for (a b) in '((0 0) (0 1) (1 0) (1 1))
+	     unless (not (zerop a)) if (= b 1) collect '0-1 end
+	     else collect '1-X)
+       '(|0-1| |1-X| |1-X|))
+
+(equal (loop for (a b c) in '((0 0 0) (0 0 1)
+			      (0 1 0) (0 1 1)
+			      (1 0 0) (1 0 1)
+			      (1 1 0) (1 1 1))
+	     if (zerop a)
+	       if (zerop b)
+	         if (zerop c) collect 'x0-0-0 else collect 'x0-0-1
+		 else if (zerop c) collect 'x0-1-0 else collect 'x0-1-1
+             else if (zerop b)
+	         if (zerop c) collect 'x1-0-0 else collect 'x1-0-1
+		 else if (zerop c) collect 'x1-1-0 else collect 'x1-1-1)
+       '(x0-0-0 x0-0-1 x0-1-0 x0-1-1 x1-0-0 x1-0-1 x1-1-0 x1-1-1))
+
+(equal (loop for a below 10
+	     if (oddp a) collect a into bag and sum a into odd
+	     else collect (list a) into bag and sum a into even
+	     finally (return (list bag odd even)))
+       '(((0) 1 (2) 3 (4) 5 (6) 7 (8) 9) 25 20))
+
+(equal (loop for a below 10
+	     if (oddp a)
+	       collect a and collect (list a) and collect (list (list a))
+	     else collect a)
+       '(0 1 (1) ((1)) 2 3 (3) ((3)) 4 5 (5) ((5)) 6 7 (7) ((7)) 8 9 (9) ((9))))
+
+(let ((c0 0) (c1 0))
+  (and (equal (loop for a below 10
+		    when (oddp a)
+		      collect a and do (incf c0) (decf c1) and collect (list a))
+	      '(1 (1) 3 (3) 5 (5) 7 (7) 9 (9)))
+       (= c0 5)
+       (= c1 -5)))
+
+
+
+
+
+
+;; return-clause
+(zerop (loop return 0))
+(= (loop for a from 0 below 3 when (and (oddp a) a) return it) 1)
+(eq (loop for a in '(nil nil ok nil ok2) when a return it) 'ok)
+(eq 'ok (loop with a = 'ok if a return it else return it))
+(equal (multiple-value-list (loop return (values 0 1 2))) '(0 1 2))
+(let ((flag nil))
+  (and (eq t (loop for a below 3 when (oddp a) return t finally (setq flag t)))
+       (not flag)))
+(equal (loop for a in '(0 1 2 3) and b in '(3 2 1 0)
+	     if (and (oddp a) a)
+	     if (and (evenp b) b)
+	     when (and (= (* a b) 0) (list a b)) return it)
+       '(3 0))
+
+
+;;; list-accumulation-clauses
+
+;; collect
+(equal (loop for a from 0 below 3 collect a) '(0 1 2))
+(equal (loop for a from 0 below 3 collecting a) '(0 1 2))
+(equal (loop for a in '(nil 0 nil nil 1 2 nil 3 nil 4)
+	     when a collect it) '(0 1 2 3 4))
+(equal (loop for a in '(nil 0 nil nil 1 2 nil 3 nil 4)
+	     when a collecting it) '(0 1 2 3 4))
+(equal (loop for a in '(nil 0 nil nil 1 2 nil 3 nil 4)
+	     when a collect it into bag
+	     finally (return bag))
+       '(0 1 2 3 4))
+(equal (loop for a in '(nil 0 nil nil 1 2 nil 3 nil 4)
+	     when a collecting it into bag
+	     finally (return bag))
+       '(0 1 2 3 4))
+(equal (loop for a below 10
+	     if (oddp a) collect a into odd else collect a into even end
+	     finally (return (list odd even)))
+       '((1 3 5 7 9) (0 2 4 6 8)))
+(equal (loop for a below 3
+	     for b on '(2 1 0)
+	     collecting a
+	     appending b)
+       '(0 2 1 0 1 1 0 2 0))
+
+
+
+(= 15 (loop for i of-type fixnum in '(1 2 3 4 5) sum i))
+(= 22.4 (let ((series '(1.2 4.3 5.7))) (loop for v in series sum (* 2.0 v))))
+(equal (loop for a below 10
+	     if (oddp a) collect a into odd and sum a into sum
+	     finally (return (list odd sum)))
+       '((1 3 5 7 9) 25))
+
+(equal (loop for a below 10
+	     if (oddp a) collect a into odd and sum a into odd-sum
+	     else collect a into even and sum a into even-sum
+	     end
+	     finally (return (list odd odd-sum even even-sum)))
+       '((1 3 5 7 9) 25 (0 2 4 6 8) 20))
+(equal (loop for i in '(bird 3 4 turtle (1 . 4) horse cat)
+	     when (symbolp i) collect i)
+       '(BIRD TURTLE HORSE CAT))
+(equal (loop for i below 3
+	     for j upto 2
+	     collecting i
+	     collecting j)
+       '(0 0 1 1 2 2))
+(equal (loop for a from -10 upto 0
+             collecting a)
+       '(-10 -9 -8 -7 -6 -5 -4 -3 -2 -1 0))
+(null (loop for a from -10 upto 0
+            collecting a into list))    ;; not return automatically
+
+
+;; append
+(let* ((zero (list 0))
+       (one (list 1))
+       (two (list 2))
+       (list (list zero one two)))
+  (and (equal (loop for a in list append a) '(0 1 2))
+       (equal zero '(0))
+       (equal one '(1))
+       (equal two '(2))))
+(equal (loop for a in '(nil (1) nil (2)) when a append a) '(1 2))
+(equal (loop for a in '(nil (1) nil (2)) when a appending a) '(1 2))
+(null (loop for a in '(nil (1) nil (2)) when a append a into x))
+(null (loop for a in '(nil (1) nil (2)) when a appending a into x))
+(equal (loop for a in '(nil (1) nil (2)) when a append a into x
+	     finally (return x)) '(1 2))
+(equal (loop for a in '(nil (1) nil (2)) when a appending a into x
+	     finally (return x)) '(1 2))
+(equal (loop for a in '(nil (1) nil (2)) when a append it) '(1 2))
+(equal (loop for a in '(nil (1) nil (2)) when a appending it) '(1 2))
+(equal (loop for a on (list 0 1 2 3 4) when (oddp (car a)) append a)
+       '(1 2 3 4 3 4))
+(equal (loop for a on (list 0 1 2 3 4) when (oddp (car a)) appending a)
+       '(1 2 3 4 3 4))
+(equal (loop for x in '((a) (b) ((c))) append x) '(A B (C)))
+
+;; nconc
+(let ((list (list (list 0) (list 1) (list 2) (list 3))))
+  (and (equal (loop for a in list nconc a) '(0 1 2 3))
+       (equal list '((0 1 2 3) (1 2 3) (2 3) (3)))))
+(let ((list (list (list 0) (list 1) (list 2) (list 3))))
+  (and (equal (loop for a in list nconcing a) '(0 1 2 3))
+       (equal list '((0 1 2 3) (1 2 3) (2 3) (3)))))
+(let ((list (list nil (list 0) nil nil (list 1) (list 2) nil (list 3) nil)))
+  (and (equal (loop for a in list when a nconc it) '(0 1 2 3))
+       (equal list '(nil (0 1 2 3) nil nil (1 2 3) (2 3) nil (3) nil))))
+(let ((list (list nil (list 0) nil nil (list 1) (list 2) nil (list 3) nil)))
+  (and (equal (loop for a in list when a nconcing it) '(0 1 2 3))
+       (equal list '(nil (0 1 2 3) nil nil (1 2 3) (2 3) nil (3) nil))))
+(null (loop for a in (list (list (list 0) (list 1) (list 2) (list 3)))
+	    nconc a into x))
+(null (loop for a in (list (list (list 0) (list 1) (list 2) (list 3)))
+	    nconcing a into x))
+(let ((list (list (list 0) (list 1) (list 2) (list 3))))
+  (and (equal (loop for a in list nconc a into x finally (return x)) '(0 1 2 3))
+       (equal list '((0 1 2 3) (1 2 3) (2 3) (3)))))
+(let ((list (list (list 0) (list 1) (list 2) (list 3))))
+  (and (equal (loop for a in list nconcing a into x finally (return x)) '(0 1 2 3))
+       (equal list '((0 1 2 3) (1 2 3) (2 3) (3)))))
+(equal (loop for i upfrom 0 as x in '(a b (c))
+	     nconc (if (evenp i) (list x) nil))
+       '(A (C)))
+
+
+(equal (loop for a in '(0 3 6)
+	     for b in '((1) (4) (7))
+	     for c in (copy-tree '((2) (5) (8)))
+	     collecting a
+	     appending b
+	     nconcing c)
+       '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in '(0 3 6)
+	     for b in (copy-tree '((1) (4) (7)))
+	     for c in (list (list 2) (list 5) (list 8))
+	     collecting a
+	     nconcing b
+	     appending c)
+       '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in '((0) (3) (6))
+	     for b in (copy-tree '((1) (4) (7)))
+	     for c in '(2 5 8)
+	     appending a
+	     nconcing b
+	     collecting c)
+       '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in '((0) (3) (6))
+	     for b in '(1 4 7)
+	     for c in (copy-tree '((2) (5) (8)))
+	     appending a
+	     collecting b
+	     nconcing c)
+       '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in (copy-tree '((0) (3) (6)))
+	     for b in '(1 4 7)
+	     for c in '((2) (5) (8))
+	     nconcing a
+	     collecting b
+	     appending c)
+       '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in (copy-tree '((0) (3) (6)))
+	     for b in '((1) (4) (7))
+	     for c in '(2 5 8)
+	     nconcing a
+	     appending b
+	     collecting c)
+       '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in '(0 6)
+	     for b in '((1 2 3) (7 8 9))
+	     for c in (copy-tree '((4 5) (10)))
+	     collect a
+	     append b
+	     nconc c)
+       '(0 1 2 3 4 5 6 7 8 9 10))
+(null (loop for a in '()
+	    for b in '((1 2 3) (7 8 9))
+	    for c in (copy-tree '((4 5) (10)))
+	    collect a
+	    append b
+	    nconc c))
+(equal (loop for a in '(0 3 6)
+	     for b in '((1) (4) (7))
+	     for c in (copy-tree '((2) (5) (8)))
+	     collecting a into list
+	     appending b into list
+	     nconcing c into list
+	     finally (return list))
+       '(0 1 2 3 4 5 6 7 8))
+(equal (loop for a in '(0 3 6)
+	     for b in '(1 4 7)
+	     for c in (copy-tree '((2) (5) (8)))
+	     collect a collect b nconc c)
+       '(0 1 2 3 4 5 6 7 8))
+
+(= 60 (loop for a upto 10 summing a when (oddp a) counting it))
+(= 220 (loop for a upto 10
+	     for b downfrom 20
+	     sum a
+	     summing b))
+(= 60 (loop for a upto 10
+	    summing a into sum
+	    when (oddp a) counting it into sum
+	    finally (return sum)))
+(= 21 (loop for a in '(a 1 b 3 c 4 5 x 2 y z)
+	    if (and (numberp a) a) summing it
+	    else counting 1))
+
+
+(= 5 (loop for a from 3 to 5 maximizing a minimizing a))
+(= 3 (loop for a upto 3 for b from 6 downto 3 maximize a minimize b))
+(equal (loop for a in '(0 -1 1 -2 2 -3 3)
+	     maximize a into plus
+	     minimize a into minus
+	     finally (return (list minus plus)))
+       '(-3 3))
+
+(equal (let (val)
+	 (list (loop for a below 10
+		     collecting a
+		     summing a into sum
+		     counting a into count
+		     maximizing a into max
+		     minimizing a into min
+		     finally (setq val (list sum count max min)))
+	       val))
+       '((0 1 2 3 4 5 6 7 8 9) (45 10 9 0)))
+(eq 'ok (loop for a below 3 collecting a
+	      finally (return 'ok)))
+(let ((flag nil))
+  (and (equal (loop for a below 3 collecting a
+		    finally (setq flag t))
+	      '(0 1 2))
+       flag))
+(eq 'ok (loop for a below 3 appending (list a)
+	      finally (return 'ok)))
+(eq 'ok (loop for a below 3 nconcing (list a)
+	      finally (return 'ok)))
+
+
+      
+
+
+
+
+;; numeric-accumulation-clauses
+;; count
+(= 5 (loop for a from 1 upto 10
+           counting (evenp a)))
+(= (loop for a downfrom 10 above 0 count a) 10)
+(= (loop for a downfrom 10 above 0 counting a) 10)
+(null (loop for a downfrom 10 above 0 count a into x))
+(null (loop for a downfrom 10 above 0 counting a into x))
+(= (loop for a downfrom 10 above 0 count a into x finally (return x)) 10)
+(= (loop for a downfrom 10 above 0 counting a into x finally (return x)) 10)
+(= (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+	 when a count it) 6)
+(= (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+	 when a counting it) 6)
+(null (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+	    when a count it into x))
+(null (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+	    when a counting it into x))
+(= (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+	 when a count it into x finally (return x)) 6)
+(= (loop for a in '(nil a nil nil b nil c d e nil nil nil nil f)
+	 when a counting it into x finally (return x)) 6)
+(= 5 (loop for i in '(a b nil c nil d e) count i))
+
+;; sum
+(= (loop for a to 10 sum a) 55)
+(= (loop for a to 10 summing a) 55)
+(= (loop for a in '(0 nil 1 nil 2 3 nil 4 5 6 7 nil 8 9 10 nil)
+	 if a sum it) 55)
+(= (loop for a in '(0 nil 1 nil 2 3 nil 4 5 6 7 nil 8 9 10 nil)
+	 if a summing it) 55)
+(loop for a to 10
+      sum a into sum
+      if (oddp a) sum a into odd
+      else sum a into even
+      finally (return (= sum (+ odd even))))
+(loop for a to 10
+      summing a into sum
+      if (oddp a) sum a into odd
+      else summing a into even
+      finally (return (= sum (+ odd even))))
+(= 15 (loop for a downfrom 5 to 1
+            summing a))
+(null (loop for a downfrom 5 to 1
+            summing a into n))    ;; not return automatically
+
+(= (loop for i from 1 to 4
+         sum i fixnum
+         count t fixnum)
+   14)
+
+
+;; maximize
+(= 5 (loop for i in '(2 1 5 3 4) maximize i))
+(= (loop for a in '(0 5 9) maximize a) 9)
+(= (loop for a in '(0 5 9) maximizing a) 9)
+(= (loop for a in '(0 9 5) maximize a) 9)
+(= (loop for a in '(0 9 5) maximizing a) 9)
+(= (loop for a in '(9 0 5) maximize a) 9)
+(= (loop for a in '(9 0 5) maximizing a) 9)
+(= (loop for a in '(9 0 9 5) maximize a) 9)
+(= (loop for a in '(9 0 9 5) maximizing a) 9)
+(let (list)
+  (loop (when (= (first (push (random 10) list)) 9) (return)))
+  (= (loop for a in list maximize a) 9))
+(let (list)
+  (loop (when (= (first (push (random 10) list)) 9) (return)))
+  (= (loop for a in list maximizing a) 9))
+(let (list)
+  (loop (when (= (first (push (random 100) list)) 99) (return)))
+  (= (loop for a in list maximize a) 99))
+(let (list)
+  (loop (when (= (first (push (random 100) list)) 99) (return)))
+  (= (loop for a in list maximizing a) 99))
+(let (list)
+  (loop (when (= (first (push (random 1000) list)) 999) (return)))
+  (= (loop for a in list maximize a) 999))
+(let (list)
+  (loop (when (= (first (push (random 1000) list)) 999) (return)))
+  (= (loop for a in list maximizing a) 999))
+(null (loop for a in '(0 5 9) maximize a into max))
+(null (loop for a in '(0 5 9) maximizing a into max))
+(= (loop for a in '(0 5 9) maximize a into max finally (return max)) 9)
+(= (loop for a in '(0 5 9) maximizing a into max finally (return max)) 9)
+(= (loop for a in '(0 5 9) maximize a into max of-type integer
+	 finally (return max)) 9)
+(= (loop for a in '(0 5 9) maximizing a into max of-type integer
+	 finally (return max)) 9)
+(= (loop for a in '(0.0 5.0 9.0) maximize a into max float
+	 finally (return max)) 9.0)
+(= (loop for a in '(0.0 5.0 9.0) maximizing a into max float
+	 finally (return max)) 9.0)
+(let ((series '(1.2 4.3 5.7)))
+  (= 6 (loop for v in series maximize (round v) of-type fixnum)))
+
+;; minimize
+(= 1 (loop for i in '(2 1 5 3 4) minimize i))
+(= (loop for a in '(0 5 9) minimize a) 0)
+(= (loop for a in '(0 5 9) minimizing a) 0)
+(= (loop for a in '(9 5 0) minimize a) 0)
+(= (loop for a in '(9 5 0) minimizing a) 0)
+(= (loop for a in '(9 0 5) minimize a) 0)
+(= (loop for a in '(9 0 5) minimizing a) 0)
+(= (loop for a in '(9 0 9 0 5 0) minimizing a) 0)
+(= (loop for a in '(9 0 9 0 5 0) minimizing a) 0)
+(= (loop for a in '(1 5 9) minimize a) 1)
+(= (loop for a in '(1 5 9) minimizing a) 1)
+(= (loop for a in '(9 5 1) minimize a) 1)
+(= (loop for a in '(9 5 1) minimizing a) 1)
+(= (loop for a in '(9 1 5) minimize a) 1)
+(= (loop for a in '(9 1 5) minimizing a) 1)
+(= (loop for a in '(9 1 9 1 5 1) minimizing a) 1)
+(= (loop for a in '(9 1 9 1 5 1) minimizing a) 1)
+(let (list)
+  (loop (when (zerop (first (push (random 10) list))) (return)))
+  (zerop (loop for a in list minimize a)))
+(let (list)
+  (loop (when (zerop (first (push (random 10) list))) (return)))
+  (zerop (loop for a in list minimizing a)))
+(let (list)
+  (loop (when (zerop (first (push (random 100) list))) (return)))
+  (zerop (loop for a in list minimize a)))
+(let (list)
+  (loop (when (zerop (first (push (random 100) list))) (return)))
+  (zerop (loop for a in list minimizing a)))
+(let (list)
+  (loop (when (zerop (first (push (random 1000) list))) (return)))
+  (zerop (loop for a in list minimize a)))
+(let (list)
+  (loop (when (zerop (first (push (random 1000) list))) (return)))
+  (zerop (loop for a in list minimizing a)))
+(null (loop for a in '(0 5 9) minimize a into min))
+(null (loop for a in '(0 5 9) minimizing a into min))
+(zerop (loop for a in '(0 5 9) minimize a into min finally (return min)))
+(zerop (loop for a in '(0 5 9) minimizing a into min finally (return min)))
+(zerop (loop for a in '(0 5 9) minimize a into min of-type integer
+	 finally (return min)))
+(zerop (loop for a in '(0 5 9) minimizing a into min of-type integer
+	 finally (return min)))
+(= (loop for a in '(0.0 5.0 9.0) minimize a into min float
+	 finally (return min)) 0.0)
+(= (loop for a in '(0.0 5.0 9.0) minimizing a into min float
+	 finally (return min)) 0.0)
+(= 1 (let ((series '(1.2 4.3 5.7)))
+       (loop for v of-type float in series
+	     minimize (round v) into result of-type fixnum
+	     finally (return result))))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing it fixnum))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing it of-type fixnum))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	    when a summing it float))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	    when a summing it of-type float))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing it of-type number))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing it of-type (integer 0)))
+
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing a fixnum))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing a of-type fixnum))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	    when a summing a float))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	    when a summing a of-type float))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing a of-type number))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing a of-type (integer 0)))
+
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing a into sum fixnum finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing a into sum of-type fixnum finally (return sum)))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	      when a summing a into sum float finally (return sum)))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	      when a summing a into sum of-type float finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing a into sum of-type number finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a summing a into sum of-type (integer 0) finally (return sum)))
+
+
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum it fixnum))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum it of-type fixnum))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	    when a sum it float))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	    when a sum it of-type float))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum it of-type number))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum it of-type (integer 0)))
+
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum a fixnum))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum a of-type fixnum))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	    when a sum a float))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	    when a sum a of-type float))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum a of-type number))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum a of-type (integer 0)))
+
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum a into sum fixnum finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum a into sum of-type fixnum finally (return sum)))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	      when a sum a into sum float finally (return sum)))
+(= 10.0 (loop for a in '(nil 1.0 nil 2.0 nil 3.0 nil 4.0)
+	      when a sum a into sum of-type float finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum a into sum of-type number finally (return sum)))
+(= 10 (loop for a in '(nil 1 nil 2 nil 3 nil 4)
+	    when a sum a into sum of-type (integer 0) finally (return sum)))
+
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+	   counting a fixnum))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+	   counting a of-type fixnum))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+	   counting a of-type integer))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+	   counting a of-type (integer 0)))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+	   counting a of-type number))
+
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+	   counting a into x fixnum finally (return x)))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+	   counting a into x of-type fixnum finally (return x)))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+	   counting a into x of-type integer finally (return x)))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+	   counting a into x of-type (integer 0) finally (return x)))
+(= 7 (loop for a in '(nil a nil b nil c nil d e nil f g nil nil nil nil)
+	   counting a into x of-type number finally (return x)))
+
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximize a fixnum))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximize a of-type fixnum))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+	      maximize a float))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+	      maximize a of-type float))
+(= 99.0 (loop for a in '(3.0 5.0 2.2 8.0 0 3/5 7.0 7 99 3.0)
+	      maximize a of-type real))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximize a of-type (integer 0)))
+
+
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximize a into max fixnum
+	    finally (return max)))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximize a into max of-type fixnum
+	    finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+	      maximize a into max float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+	      maximize a into max of-type float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 2.2 8.0 0 3/5 7.0 7 99 3.0)
+	      maximize a into max of-type real finally (return max)))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3)
+	    maximize a into max of-type (integer 0)
+	    finally (return max)))
+
+(= 99 (loop for a in '(3 nil 5 8 nil 0 nil 7 7 99 3) when a maximize it fixnum))
+(= 99 (loop for a in '(nil 3 nil 5 nil 8 0 7 7 nil 99 nil 3)
+	    when a maximize it of-type fixnum))
+(= 99.0 (loop for a in '(3.0 nil 5.0 8.0 0.0 nil nil nil nil 7.0 nil 7.0 99.0
+			 nil 3.0 nil nil nil)
+	      when a maximize it float))
+(= 99.0 (loop for a in '(nil nil nil nil nil 3.0 nil 5.0 8.0 0.0
+			 nil nil nil 7.0 7.0 nil nil 99.0 3.0)
+	      when a maximize it of-type float))
+(= 99.0 (loop for a in '(3.0 5.0 nil nil 2.2 nil nil 8.0 0
+			 nil nil 3/5 nil nil 7.0 7 99 3.0)
+	      when a maximize it of-type real))
+(= 99 (loop for a in '(3 nil nil 5 8 0 nil nil 7 7 99 nil nil 3)
+	    when a maximize a of-type (integer 0)))
+
+(= 99 (loop for a in '(3 nil 5 8 nil 0 nil 7 7 99 3)
+	    when a maximize it into max fixnum
+	    finally (return max)))
+(= 99 (loop for a in '(nil 3 nil 5 nil 8 0 7 7 nil 99 nil 3)
+	    when a maximize it into max of-type fixnum finally (return max)))
+(= 99.0 (loop for a in '(3.0 nil 5.0 8.0 0.0 nil nil nil nil 7.0 nil 7.0 99.0
+			 nil 3.0 nil nil nil)
+	      when a maximize it into max float finally (return max)))
+(= 99.0 (loop for a in '(nil nil nil nil nil 3.0 nil 5.0 8.0 0.0
+			 nil nil nil 7.0 7.0 nil nil 99.0 3.0)
+	      when a maximize it into max of-type float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 nil nil 2.2 nil nil 8.0 0
+			 nil nil 3/5 nil nil 7.0 7 99 3.0)
+	      when a maximize it into max of-type real finally (return max)))
+(= 99 (loop for a in '(3 nil nil 5 8 0 nil nil 7 7 99 nil nil 3)
+	    when a maximize it into max of-type (integer 0)
+	    finally (return max)))
+
+
+
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximizing a fixnum))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximizing a of-type fixnum))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+	      maximizing a float))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+	      maximizing a of-type float))
+(= 99.0 (loop for a in '(3.0 5.0 2.2 8.0 0 3/5 7.0 7 99 3.0)
+	      maximizing a of-type real))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximizing a of-type (integer 0)))
+
+
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximizing a into max fixnum
+	    finally (return max)))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3) maximizing a into max of-type fixnum
+	    finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+	      maximizing a into max float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 8.0 0.0 7.0 7.0 99.0 3.0)
+	      maximizing a into max of-type float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 2.2 8.0 0 3/5 7.0 7 99 3.0)
+	      maximizing a into max of-type real finally (return max)))
+(= 99 (loop for a in '(3 5 8 0 7 7 99 3)
+	    maximizing a into max of-type (integer 0)
+	    finally (return max)))
+
+(= 99 (loop for a in '(3 nil 5 8 nil 0 nil 7 7 99 3) when a maximizing it fixnum))
+(= 99 (loop for a in '(nil 3 nil 5 nil 8 0 7 7 nil 99 nil 3)
+	    when a maximizing it of-type fixnum))
+(= 99.0 (loop for a in '(3.0 nil 5.0 8.0 0.0 nil nil nil nil 7.0 nil 7.0 99.0
+			 nil 3.0 nil nil nil)
+	      when a maximizing it float))
+(= 99.0 (loop for a in '(nil nil nil nil nil 3.0 nil 5.0 8.0 0.0
+			 nil nil nil 7.0 7.0 nil nil 99.0 3.0)
+	      when a maximizing it of-type float))
+(= 99.0 (loop for a in '(3.0 5.0 nil nil 2.2 nil nil 8.0 0
+			 nil nil 3/5 nil nil 7.0 7 99 3.0)
+	      when a maximizing it of-type real))
+(= 99 (loop for a in '(3 nil nil 5 8 0 nil nil 7 7 99 nil nil 3)
+	    when a maximizing a of-type (integer 0)))
+
+(= 99 (loop for a in '(3 nil 5 8 nil 0 nil 7 7 99 3)
+	    when a maximizing it into max fixnum
+	    finally (return max)))
+(= 99 (loop for a in '(nil 3 nil 5 nil 8 0 7 7 nil 99 nil 3)
+	    when a maximizing it into max of-type fixnum finally (return max)))
+(= 99.0 (loop for a in '(3.0 nil 5.0 8.0 0.0 nil nil nil nil 7.0 nil 7.0 99.0
+			 nil 3.0 nil nil nil)
+	      when a maximizing it into max float finally (return max)))
+(= 99.0 (loop for a in '(nil nil nil nil nil 3.0 nil 5.0 8.0 0.0
+			 nil nil nil 7.0 7.0 nil nil 99.0 3.0)
+	      when a maximizing it into max of-type float finally (return max)))
+(= 99.0 (loop for a in '(3.0 5.0 nil nil 2.2 nil nil 8.0 0
+			 nil nil 3/5 nil nil 7.0 7 99 3.0)
+	      when a maximizing it into max of-type real finally (return max)))
+(= 99 (loop for a in '(3 nil nil 5 8 0 nil nil 7 7 99 nil nil 3)
+	    when a maximizing it into max of-type (integer 0)
+	    finally (return max)))
+
+
+(= 3 (loop for a in '(3 5 8 4 7 7 99 3) minimize a fixnum))
+(= 3 (loop for a in '(3 5 8 4 7 7 99 3) minimize a of-type fixnum))
+(= 3.0 (loop for a in '(5.0 8.0 7.0 3.0 7.0 99.0) minimize a float))
+(= 3.0 (loop for a in '(5.0 8.0 7.0 3.0 7.0 99.0) minimize a of-type float))
+(= 3.0 (loop for a in '(5.0 8 7 3 7.0 3.0 99.0 1000) minimize a of-type real))
+(= 5 (loop for a in '(6 5 8 7 7 99) minimize a of-type (integer 0)))
+
+(= 3 (loop for a in '(5 8 4 7 7 99 3) minimize a into min fixnum
+	   finally (return min)))
+(= 3 (loop for a in '(5 8 4 7 7 99 3) minimize a into min of-type fixnum
+	   finally (return min)))
+(= 3.0 (loop for a in '(5.0 8.0 4.0 7.0 7.0 99.0 3.0) minimize a into min float
+	     finally (return min)))
+(= 3.0 (loop for a in '(5.0 8.0 4.0 7.0 7.0 99.0 3.0)
+	     minimize a into min of-type float finally (return min)))
+(= 3.0 (loop for a in '(5.0 8 4.0 31/3 7.0 7 99.0 3.0)
+	     minimize a into min of-type real finally (return min)))
+(= 5 (loop for a in '(6 5 8 7 7 99) minimize a into min of-type (integer 0)
+	   finally (return min)))
+
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3) when a minimize it fixnum))
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3)
+	   when a minimize it of-type fixnum))
+(= 3.0 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+	     when a minimize it float))
+(= 3.0 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+	     when a minimize it of-type float))
+(= 3 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+	   when a minimize it of-type real))
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3)
+	   when a minimize it of-type (integer 0)))
+(= -99 (loop for a in '(nil -5 8 nil nil 7 7 nil -99 3)
+	   when a minimize it of-type (integer)))
+
+
+(= 3 (loop for a in '(3 5 8 4 7 7 99 3) minimizing a fixnum))
+(= 3 (loop for a in '(3 5 8 4 7 7 99 3) minimizing a of-type fixnum))
+(= 3.0 (loop for a in '(5.0 8.0 7.0 3.0 7.0 99.0) minimizing a float))
+(= 3.0 (loop for a in '(5.0 8.0 7.0 3.0 7.0 99.0) minimizing a of-type float))
+(= 3.0 (loop for a in '(5.0 8 7 3 7.0 3.0 99.0 1000) minimizing a of-type real))
+(= 5 (loop for a in '(6 5 8 7 7 99) minimizing a of-type (integer 0)))
+
+(= 3 (loop for a in '(5 8 4 7 7 99 3) minimizing a into min fixnum
+	   finally (return min)))
+(= 3 (loop for a in '(5 8 4 7 7 99 3) minimizing a into min of-type fixnum
+	   finally (return min)))
+(= 3.0 (loop for a in '(5.0 8.0 4.0 7.0 7.0 99.0 3.0) minimizing a into min float
+	     finally (return min)))
+(= 3.0 (loop for a in '(5.0 8.0 4.0 7.0 7.0 99.0 3.0)
+	     minimizing a into min of-type float finally (return min)))
+(= 3.0 (loop for a in '(5.0 8 4.0 31/3 7.0 7 99.0 3.0)
+	     minimizing a into min of-type real finally (return min)))
+(= 5 (loop for a in '(6 5 8 7 7 99) minimizing a into min of-type (integer 0)
+	   finally (return min)))
+
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3) when a minimizing it fixnum))
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3)
+	   when a minimizing it of-type fixnum))
+(= 3.0 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+	     when a minimizing it float))
+(= 3.0 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+	     when a minimizing it of-type float))
+(= 3 (loop for a in '(nil 5.0 8.0 nil nil 7.0 7.0 nil 99.0 3.0)
+	   when a minimizing it of-type real))
+(= 3 (loop for a in '(nil 5 8 nil nil 7 7 nil 99 3)
+	   when a minimizing it of-type (integer 0)))
+(= -99 (loop for a in '(nil -5 8 nil nil 7 7 nil -99 3)
+	   when a minimizing it of-type (integer)))
+(eq 'ok (loop for i from 0 upto 10 summing i finally (return 'ok)))
+(eq 'ok (loop for i in '(nil nil 3 nil 5 nil 6)
+	      counting i finally (return 'ok)))
+(eq 'ok (loop for i in '(nil nil 3 nil 5 nil 6)
+	      when i maximizing it finally (return 'ok)))
+(eq 'ok (loop for i in '(nil nil 3 nil 5 nil 6)
+	      when i minimizing it finally (return 'ok)))
+
+
+
+
+;; termination-test-clauses
+(null (loop with x = '(a b c d) while x do (pop x)))
+(equal (loop with stack = nil and x = '(0 1 2 3)
+	     while x do (push (pop x) stack) finally (return stack))
+       '(3 2 1 0))
+(equal (loop with stack = nil and x = '(0 1 2 3)
+	     until (null x) do (push (pop x) stack) finally (return stack))
+       '(3 2 1 0))
+(equal (let ((stack '(a b c d e f)))
+	 (loop for item = (length stack) then (pop stack)
+	       collect item
+	       while stack))
+       '(6 A B C D E F))
+(equal (loop for i fixnum from 3
+	     when (oddp i) collect i
+	     while (< i 5))
+       '(3 5))
+(equal (loop for a below 10
+	     when (and (evenp a) a) collect it
+	     while (< a 6)
+	     collect a)
+       '(0 0 1 2 2 3 4 4 5 6))
+(equal (loop for a below 10
+	     when (and (evenp a) a) collect it
+	     until (>= a 6)
+	     collect a)
+       '(0 0 1 2 2 3 4 4 5 6))
+(equal (loop for a below 10
+	     when (and (evenp a) a) collect it
+	     while (< a 6)
+	     collect a
+	     until (>= a 4)
+	     collect a)
+       '(0 0 0 1 1 2 2 2 3 3 4 4))
+
+;; repeat
+(= 3 (loop with x = 0 repeat 3 do (incf x) finally (return x)))
+(= 1000 (loop repeat 1000 counting 1))
+(null (loop repeat 3))
+(null (loop repeat 0))
+(let ((body-flag nil))
+  (and (null (loop repeat 0 do (setq body-flag t))) (null body-flag)))
+(= 1 (let ((x 0)) (loop repeat (incf x) sum x)))
+(= 4 (let ((x 1)) (loop repeat (incf x) sum x)))
+(= 9 (let ((x 2)) (loop repeat (incf x) sum x)))
+(= 16 (let ((x 3)) (loop repeat (incf x) sum x)))
+(null (loop repeat -15 return t))
+(let ((body-flag nil))
+  (and (null (loop repeat -10 do (setq body-flag t))) (null body-flag)))
+(let ((eval-count 0)
+      (loop-count 0))
+  (loop repeat (progn (incf eval-count) 2) do (incf loop-count))
+  (and (= 1 eval-count)
+       (= 2 loop-count)))
+(let ((eval-count 0)
+      (loop-count 0))
+  (loop repeat (progn (incf eval-count) 0) do (incf loop-count))
+  (and (= 1 eval-count)
+       (zerop loop-count)))
+(let ((eval-count 0)
+      (loop-count 0))
+  (loop repeat (progn (incf eval-count) -100) do (incf loop-count))
+  (and (= 1 eval-count)
+       (zerop loop-count)))
+
+;; always
+(eq t (loop for i from 0 to 10 always (< i 11)))
+(eq t (loop for a in '() always (oddp a)))
+(null (loop for a in '(0 1 2) always (oddp a)))
+(eq t (loop for a in '(1 3 5) always (oddp a)))
+(let ((flag nil))
+  (and (null (loop for i from 0 to 10 always (< i 5)
+		   finally (setq flag t) (return t)))
+       (not flag)))
+(eq 'ok (loop for i below 3 always (numberp i) finally (return 'ok)))
+(eq t (loop repeat 3 always t))
+(handler-case (macroexpand '(loop for i from 0 upto 10
+                             always (integerp i)
+                             collect i))
+  (program-error () t)
+  (error () nil)
+  (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+;; never
+(eq t (loop for i from 0 to 10 never (> i 11)))
+(eq t (loop for a in '() never (oddp a)))
+(null (loop for a in '(0 1 2) never (oddp a)))
+(eq t (loop for a in '(1 3 5) never (evenp a)))
+(null (loop never t finally (return t)))
+(let ((flag nil))
+  (and (null (loop for a below 3 never (oddp a)
+		   finally (setq flag t) (return t)))
+       (null flag)))
+(eq 'ok (loop for i below 3 never (consp i) finally (return 'ok)))
+(eq t (loop repeat 3 never nil))
+(handler-case (macroexpand '(loop for i from 0 upto 10
+                             never (integerp i)
+                             append (list i)))
+  (program-error () t)
+  (error () nil)
+  (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+;; thereis
+(null (loop for a in '(0 2 4) thereis (oddp a)))
+(= 11 (loop for i from 0 thereis (when (> i 10) i)))
+(eq (loop thereis 'someone) 'someone)
+(eq (loop for i from 1 to 10
+	  thereis (> i 11)
+	  finally (return 'got-here))
+    'got-here)
+(let ((count 0))
+  (and (null (loop for a below 10 for b in '(nil nil nil nil c)
+		   always (< a 8)
+		   never b
+		   do (incf count)))
+       (= count 4)))
+(eq (loop for a in '(nil nil nil found-it! nil nil)
+	  for b from 10 downto 0
+	  never (< b 0)
+	  thereis a) 'found-it!)
+(= 4 (loop for i in '(1 2 3 4 5 6)
+	   thereis (and (> i 3) i)))
+(let ((flag nil))
+  (loop for a below 3
+	thereis (and (oddp a) a)
+	finally (setq flag t))
+  (null flag))
+(eq 'ok (loop for i below 3 thereis (consp i) finally (return 'ok)))
+(null (loop repeat 3 thereis nil))
+(handler-case (macroexpand '(loop for i from 0 upto 10
+                             thereis (integerp i)
+                             nconc (list i)))
+  (program-error () t)
+  (error () nil)
+  (:no-error (&rest rest) (declare (ignore rest)) nil))
+
+
+
+;; name-clause
+(loop named bar do (return-from bar t))
+(eq t (loop named outer do (loop named inner do (return-from outer t))))
+
+
+
+
+
+
+;; destructuring
+(equal (loop for (a b c) of-type (integer integer float) in
+	     '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+	     collect (list c b a))
+       '((4.0 2 1) (8.3 6 5) (10.4 9 8)))
+
+(equal (loop for (a b c) of-type float in
+	     '((1.0 2.0 4.0) (5.0 6.0 8.3) (8.0 9.0 10.4))
+	     collect (list c b a))
+       '((4.0 2.0 1.0) (8.3 6.0 5.0) (10.4 9.0 8.0)))
+
+(equal (loop with (a b) of-type float = '(1.0 2.0)
+	     and (c d) of-type integer = '(3 4)
+	     and (e f)
+	     return (list a b c d e f))
+       '(1.0 2.0 3 4 NIL NIL))
+(equal (let (stack)
+	 (loop for (a (b) ((c))) in '((0 (1) ((2))) (3 (4) ((5))) (6 (7) ((8))))
+	       do (push (list a b c) stack))
+	 stack)
+       '((6 7 8) (3 4 5) (0 1 2)))
+(equal (let (stack)
+	 (loop for (a nil ((b))) in '((0 (1) ((2))) (3 (4) ((5))) (6 (7) ((8))))
+	       do (push (list a b) stack))
+	 stack)
+       '((6 8) (3 5) (0 2)))
+(equal (let (stack)
+	 (loop for (a nil ((((b))))) in
+	       '((0 (1) ((((2))))) (3 (4) ((((5))))) (6 (7) ((((8))))))
+	       do (push (list a b) stack))
+	 stack)
+       '((6 8) (3 5) (0 2)))
+(equal (let (stack)
+	 (loop for (a . b) in '((0 . 1) (2 . 3)) do (push (cons a b) stack))
+	 stack)
+       '((2 . 3) (0 . 1)))
+(equal (let (stack)
+	 (loop for (a . (b)) in '((0 1) (2 3)) do (push (list a b) stack))
+	 stack)
+       '((2 3) (0 1)))
+(equal (let (stack)
+	 (loop for (a) on '(0 1 2 3) do (push a stack)) stack)
+       '(3 2 1 0))
+(equal (let (stack)
+	 (loop for (a . b) on '(0 1 2 3 4) do (push (list a b) stack))
+	 stack)
+       '((4 nil) (3 (4)) (2 (3 4)) (1 (2 3 4)) (0 (1 2 3 4))))
+(equal (let (stack) (loop for (a b) across #((0 1) (2 3) (4 5))
+			  do (push (list a b) stack))
+	    stack)
+       '((4 5) (2 3) (0 1)))
+(equal (let (stack) (loop for (a ((b))) across #((0 ((1))) (2 ((3))) (4 ((5))))
+			  do (push (list a b) stack))
+	    stack)
+       '((4 5) (2 3) (0 1)))
+(equal (loop with (a b) = '(0 1) return (list a b)) '(0 1))
+(equal (loop with (a b c) = '(0) return (list a b c)) '(0 nil nil))
+(= 2 (loop with (nil nil x) = '(0 1 2) return x))
+(equal (loop for (a b c) in '((0) (1) (2))
+	     collect (list a b c))
+       '((0 nil nil) (1 nil nil) (2 nil nil)))
+(equal (loop for (a nil b) in '((0 1 2) (1 2 3) (2 3 4))
+	     collect (list a b))
+       '((0 2) (1 3) (2 4)))
+
+(equal (loop for (a . b) t in '((0 . x) (1 . y) (2 . z)) collecting (cons a b))
+       '((0 . x) (1 . y) (2 . z)))
+(equal (loop for (a . b) of-type t in '((0 . x) (1 . y) (2 . z))
+	     collecting (cons a b))
+       '((0 . x) (1 . y) (2 . z)))
+(equal (loop for (a . b) of-type (fixnum . symbol) in '((0 . x) (1 . y) (2 . z))
+	     collecting (cons a b))
+       '((0 . x) (1 . y) (2 . z)))
+(equal (loop for (a ((b))) of-type (fixnum ((symbol))) in
+	     '((0 ((x))) (1 ((y))) (2 ((z))))
+	     collecting (cons a b))
+       '((0 . x) (1 . y) (2 . z)))
+(equal (loop for (a ((b))) of-type (fixnum symbol) in
+	     '((0 ((x))) (1 ((y))) (2 ((z))))
+	     collecting (cons a b))
+       '((0 . x) (1 . y) (2 . z)))
+(equal (loop for (a ((b))) fixnum in '((0 ((10))) (1 ((11))) (2 ((12))))
+	     collecting (cons a b))
+       '((0 . 10) (1 . 11) (2 . 12)))
+(equal (loop for (a ((b)) c (((d)))) fixnum in
+	     '((0 ((10)) 20 (((30))))
+	       (1 ((11)) 21 (((31))))
+	       (2 ((12)) 22 (((32)))))
+	     collecting (list a b c d))
+       '((0 10 20 30) (1 11 21 31) (2 12 22 32)))
+(equal (loop for (a ((b)) c (((d))))
+	     of-type (fixnum ((fixnum)) fixnum (((fixnum)))) in
+	     '((0 ((10)) 20 (((30))))
+	       (1 ((11)) 21 (((31))))
+	       (2 ((12)) 22 (((32)))))
+	     collecting (list a b c d))
+       '((0 10 20 30) (1 11 21 31) (2 12 22 32)))
+(equal (loop for (a nil nil (((b)))) of-type (fixnum nil nil (((fixnum)))) in
+	     '((0 ((10)) 20 (((30))))
+	       (1 ((11)) 21 (((31))))
+	       (2 ((12)) 22 (((32)))))
+	     collecting (list a b))
+       '((0 30) (1 31) (2 32)))
+
+(equal (loop for (a) fixnum on '(0 1 2) collecting a) '(0 1 2))
+(equal (loop for (a) of-type fixnum on '(0 1 2) collecting a) '(0 1 2))
+(equal (loop for (a) float on '(0.3 1.3 2.3) collecting a) '(0.3 1.3 2.3))
+(equal (loop for (a) of-type float on '(0.3 1.3 2.3) collecting a)
+       '(0.3 1.3 2.3))
+(equal (loop for (a) t on '(0 1 2) collecting a) '(0 1 2))
+(equal (loop for (a) of-type t on '(0 1 2) collecting a) '(0 1 2))
+(equal (loop for (a) of-type real on '(0 1.0 2/3) collecting a) '(0 1.0 2/3))
+(equal (loop for (a nil b) fixnum on '(0 1 2) collecting (list a b))
+       '((0 2) (1 nil) (2 nil)))
+(equal (loop for (a nil b) of-type (fixnum nil fixnum) on '(0 1 2)
+	     collecting (list a b))
+       '((0 2) (1 nil) (2 nil)))
+(equal (loop for (nil . tail) t on '(0 1 2 3) append tail)
+       '(1 2 3 2 3 3))
+(equal (loop for (nil . tail) of-type t on '(0 1 2 3) append tail)
+       '(1 2 3 2 3 3))
+(equal (loop for (nil . tail) of-type list on '(0 1 2 3) append tail)
+       '(1 2 3 2 3 3))
+
+(equal (loop for (a b) t across #((x 0) (y 1) (z 2)) collecting (list b a))
+       '((0 x) (1 y) (2 z)))
+(equal (loop for (a b) of-type t across #((x 0) (y 1) (z 2))
+	     collecting (list b a))
+       '((0 x) (1 y) (2 z)))
+(equal (loop for (a b) of-type ((member x y z) (member 0 1 2))
+	     across #((x 0) (y 1) (z 2))
+	     collecting (list b a))
+       '((0 x) (1 y) (2 z)))
+
+
+(eq t (loop for (a) t := '(0) then (list (1+ a))
+	    when (= a 3) return t))
+(eq t (loop for (a) of-type t := '(0) then (list (1+ a))
+	    when (= a 3) return t))
+(eq t (loop for (a) of-type (t) := '(0) then (list (1+ a))
+	    when (= a 3) return t))
+(eq t (loop for (a) fixnum := '(0) then (list (1+ a))
+	    when (= a 3) return t))
+(eq t (loop for (a) of-type fixnum := '(0) then (list (1+ a))
+	    when (= a 3) return t))
+(eq t (loop for (a) of-type (fixnum) := '(0) then (list (1+ a))
+	    when (= a 3) return t))
+(eq t (loop for (a) float := '(0.0) then (list (1+ a))
+	    when (= a 3.0) return t))
+(eq t (loop for (a) of-type float := '(0.0) then (list (1+ a))
+	    when (= a 3.0) return t))
+(eq t (loop for (a) of-type (float) := '(0.0) then (list (1+ a))
+	    when (= a 3.0) return t))
+(equal (loop for (a b) t := '(0 1) then (list (1+ b) (+ b 2))
+	     when (> a 5) do (loop-finish)
+	     collect (list a b))
+       '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) of-type t := '(0 1) then (list (1+ b) (+ b 2))
+	     when (> a 5) do (loop-finish)
+	     collect (list a b))
+       '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) of-type (t t) := '(0 1) then (list (1+ b) (+ b 2))
+	     when (> a 5) do (loop-finish)
+	     collect (list a b))
+       '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) fixnum := '(0 1) then (list (1+ b) (+ b 2))
+	     when (> a 5) do (loop-finish)
+	     collect (list a b))
+       '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) of-type fixnum := '(0 1) then (list (1+ b) (+ b 2))
+	     when (> a 5) do (loop-finish)
+	     collect (list a b))
+       '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) of-type (fixnum fixnum) := '(0 1)
+	     then (list (1+ b) (+ b 2))
+	     when (> a 5) do (loop-finish)
+	     collect (list a b))
+       '((0 1) (2 3) (4 5)))
+(equal (loop for (a b) float := '(0.0 1.0) then (list (1+ b) (+ b 2.0))
+	     when (> a 5) do (loop-finish)
+	     collect (list a b))
+       '((0.0 1.0) (2.0 3.0) (4.0 5.0)))
+(equal (loop for (a b) of-type float := '(0.0 1.0) then (list (1+ b) (+ b 2.0))
+	     when (> a 5) do (loop-finish)
+	     collect (list a b))
+       '((0.0 1.0) (2.0 3.0) (4.0 5.0)))
+(equal (loop for (a b) of-type (float float) := '(0.0 1.0)
+	     then (list (1+ b) (+ b 2.0))
+	     when (> a 5) do (loop-finish)
+	     collect (list a b))
+       '((0.0 1.0) (2.0 3.0) (4.0 5.0)))
+(equal (loop for (a b) of-type (fixnum float) := '(0 1.0)
+	     then (list (+ a 2) (+ b 2.0))
+	     when (> a 5) do (loop-finish)
+	     collect (list a b))
+       '((0 1.0) (2 3.0) (4 5.0)))
+
+(let ((table (make-hash-table :test 'equal))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v))
+	'((k0 0) (k1 1) (k2 2)) '(v0 v1 v2))
+  (loop for (k kn) t being each hash-key of table do (push (list k kn) stack))
+  (null (set-exclusive-or stack '((k0 0) (k1 1) (k2 2)) :test #'equal)))
+(let ((table (make-hash-table :test 'equal))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v))
+	'((k0 0) (k1 1) (k2 2)) '(v0 v1 v2))
+  (loop for (k kn) of-type t being each hash-key of table
+	do (push (list k kn) stack))
+  (null (set-exclusive-or stack '((k0 0) (k1 1) (k2 2)) :test #'equal)))
+(let ((table (make-hash-table :test 'equal))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v))
+	'((k0 0) (k1 1) (k2 2)) '(v0 v1 v2))
+  (loop for (k kn) of-type (symbol fixnum) being each hash-key of table
+	do (push (list k kn) stack))
+  (null (set-exclusive-or stack '((k0 0) (k1 1) (k2 2)) :test #'equal)))
+(let ((table (make-hash-table :test 'equal))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v))
+	'((k0 0) (k1 1) (k2 2)) '(v0 v1 v2))
+  (loop for (k kn) of-type t being each hash-key of table
+	do (push (list k kn) stack))
+  (null (set-exclusive-or stack '((k0 0) (k1 1) (k2 2)) :test #'equal)))
+(let ((table (make-hash-table :test 'equal))
+      stack)
+  (mapc #'(lambda (k v) (setf (gethash k table) v))
+	'((k0 0) (k1 1) (k2 2)) '(v0 v1 v2))
+  (loop for (k kn) of-type (t t) being each hash-key of table
+	do (push (list k kn) stack))
+  (null (set-exclusive-or stack '((k0 0) (k1 1) (k2 2)) :test #'equal)))
+
+
+
+
+;; double binding
+(handler-case
+    (macroexpand '(loop with a = 0 for a downfrom 10 to 0 do (print a)))
+  (program-error () t)
+  (error () nil)
+  (:no-error (&rest rest)
+    (declare (ignore rest))	     
+    nil))
+(handler-case
+    (macroexpand '(loop for a from 0 upto 10 collect t into a))
+  (program-error () t)
+  (error () nil)
+  (:no-error (&rest rest)
+    (declare (ignore rest))	     
+    nil))
+  
+
+
+
+;; misc
+(= 4 (loop for (item . x) of-type (t . fixnum) in '((A . 1) (B . 2) (C . 3))
+	   unless (eq item 'B) sum x))
+(equal (loop for sublist on '(a b c d) collect sublist)
+       '((A B C D) (B C D) (C D) (D)))
+(equal (loop for (item) on '(1 2 3) collect item) '(1 2 3))
+(equal (loop for item = 1 then (+ item 10)
+	     for iteration from 1 to 5
+	     collect item)
+       '(1 11 21 31 41))
+(equal (loop for i below 3 collecting (loop for j below 2 collecting (list i j)))
+       '(((0 0) (0 1)) ((1 0) (1 1)) ((2 0) (2 1))))
+(zerop (loop for i from -10 upto 0 maximizing i))
+(equal (loop for i from -10 upto 0 maximizing i into max minimizing i into min
+	     finally (return (list max min)))
+       '(0 -10))
+(equal (loop for c across "aBcDeFg" when (and (upper-case-p c) c) collecting it)
+       '(#\B #\D #\F))
+(equal (loop named my-loop for i below 3 collect i into x
+	     finally (return-from my-loop x))
+       '(0 1 2))
+(equal (loop named nil for i below 3 collect i into x
+	     finally (return-from nil x))
+       '(0 1 2))
+(equal (loop for i below 3 collect i into x
+	     finally (return-from nil x))
+       '(0 1 2))
+(equal (loop for i below 3 collect i into x
+	     finally (return x))
+       '(0 1 2))
+(equal (loop for a from 10 above 0
+	     for b in '(1 2 3 4 5 6 7 8 9 10)
+	     for c on '(j k l m n o p q r s)
+	     for d = 100 then (1- d)
+	     collect (list a b (first c) d))
+       '((10 1 j 100) (9 2 k 99) (8 3 l 98) (7 4 m 97) (6 5 n 96)
+	 (5 6 o 95)   (4 7 p 94) (3 8 q 93) (2 9 r 92) (1 10 s 91)))
+
+(equal (loop with e = 0
+	     for a from 10 above 0
+	     for b in '(1 2 3 4 5 6 7 8 9 10)
+	     for c on '(j k l m n o p q r s)
+	     for d = 100 then (1- d)
+	     append (list a b (first c) d) into values
+	     initially (setq e 1000)
+	     repeat 1
+	     finally (return (cons e values)))
+       '(1000 10 1 j 100))
+(equal (loop with e = 0
+	     for a from 10 above 0
+	     for b in '(1 2 3 4 5 6 7 8 9 10)
+	     for c on '(j k l m n o p q r s)
+	     for d = 100 then (1- d)
+	     append (list a b (first c) d) into values
+	     initially (setq e 1000)
+	     repeat 2
+	     finally (return (cons e values)))
+       '(1000 10 1 j 100 9 2 k 99))
+
+(equal (loop for a from 0 upto 100 by 2
+	     repeat 1000
+	     when (zerop (mod a 10)) collect a)
+       '(0 10 20 30 40 50 60 70 80 90 100))
+
+
+;; it
+(let ((it '0))
+  (equal (loop for a in '(nil x y nil z) when a collect it and collect it)
+         '(x 0 y 0 z 0)))
+  
+(let ((it '0))
+  (equal (loop for a in '(x nil y nil z nil)
+               if a collect it end
+               collect it)
+         '(X 0 0 Y 0 0 Z 0 0)))
+
+
+
+;; for-as-package
+(subsetp '(cl:car cl:cdr cl:list)
+	 (let (bag)
+	   (loop for sym being the external-symbols of 'common-lisp
+		 do (push sym bag))
+	   bag))
+
+(progn
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use nil))
+	bag)
+    (and (null (loop for sym being the symbols of pkg do (push sym bag)))
+	 (null bag))))
+(progn
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use nil))
+	bag)
+    (and (null (loop for sym being the external-symbols of pkg
+		     do (push sym bag)))
+	 (null bag))))
+(progn
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use nil))
+	bag)
+    (and (null (loop for sym being the present-symbols of pkg
+		     do (push sym bag)))
+	 (null bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the present-symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each present-symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the present-symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each present-symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the present-symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each present-symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the present-symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each present-symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the external-symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each external-symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the external-symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each external-symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the external-symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each external-symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being the external-symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop for sym being each external-symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (push (intern name "TB-BAR-TO-USE") bag0)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the present-symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each present-symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the present-symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each present-symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the present-symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each present-symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the present-symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (push (intern name pkg) bag0)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each present-symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+
+
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the external-symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each external-symbols of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the external-symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each external-symbol of pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the external-symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each external-symbols in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being the external-symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym being each external-symbol in pkg do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(eq t (loop for symbol being the symbols of 'cl finally (return t)))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym of-type symbol being the external-symbols of pkg
+	  do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym t being the external-symbols of pkg
+	  do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+(progn
+  (when (find-package "TB-BAR-TO-USE")
+    (mapcan #'delete-package (package-used-by-list "TB-BAR-TO-USE"))
+    (delete-package "TB-BAR-TO-USE"))
+  (make-package "TB-BAR-TO-USE")
+  (when (find-package "TB-FOO") (delete-package "TB-FOO"))
+  (let ((pkg (make-package "TB-FOO" :use '("TB-BAR-TO-USE")))
+	bag0 bag)
+    (mapc #'(lambda (name)
+	      (export (intern name "TB-BAR-TO-USE") "TB-BAR-TO-USE"))
+	  '("J" "K" "L"))
+    (mapc #'(lambda (name) (intern name pkg)) '("A" "B" "C"))
+    (mapc #'(lambda (name)
+	      (push (intern name pkg) bag0)
+	      (export (intern name pkg) pkg)) '("X" "Y" "Z"))
+    (loop as sym of-type t being the external-symbols of pkg
+	  do (push sym bag))
+    (null (set-exclusive-or bag0 bag))))
+
+(eq t (loop for c in '(#\A #\S #\Z #\a)
+	    always (eq t (loop for s in
+			       (loop for s being the external-symbols of 'cl
+				     when (char= c (char (symbol-name s) 0))
+				     collect s)
+			       always (char= c (char (symbol-name s) 0))))))
+