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