;; Copyright (C) 2002-2004, Yuji Minejima <ggb01164@nifty.ne.jp>
;; ALL RIGHTS RESERVED.
;;
;; $Id: must-loop.l,v 1.2 2004/04/17 03:03:38 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.

;;; 概要:
;; Xyzzy用loop.lが正しく動作するかチェックするためのテスト式を詰め込んだ
;; ファイルです。

;;; 使用:
(progn
  (require "loop")
  (use-package "loop")
  (defun test-loop ()
    (interactive)
    (let ((count 0))
      (loop
	(forward-sexp)
	(when (eobp) (return))
	(unless (eval-last-sexp)
	  (error "test failed!"))
	(message "testing ~d" (incf count)))
      (message "test done."))))
;; loop.lのインストールをすました後で、この位置にカーソルを置いて、
;; `M-x eval-last-sexp' と入力してください。次にそのまま`M-x test-loop'
;; と入力すればテストが始まります。
;; `;;!'を検索すれば、Xyzzyで失敗してしまうため、コメントアウトしたテスト
;; を調べることができます。

;; 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)))




;; 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))
;; bit-vector is not supported in xyzzy 0.2.2.233
;;(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))




;; 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)))
(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))


;; 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)
(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

;; 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 () t)
  (: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) ; cl spec. says this must be a program-error
  (error () t)
  (: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)  ; cl spec. says this must be a program-error
  (error () t)
  (: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))




;; 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))



;; for-as-package
(subsetp '(lisp:car lisp:cdr lisp:list)
	 (let (bag)
	   (loop for sym being the external-symbols of '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 'lisp 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 'lisp
				     when (char= c (char (symbol-name s) 0))
				     collect s)
			       always (char= c (char (symbol-name s) 0))))))

