;; Copyright (C) 2002-2004, Yuji Minejima ;; 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))))))