(loop for x from 1 to 9
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))
(loop for x from 1 to 9
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))
(with-output-to-string (*standard-output*)
(loop as i from 1 to 5
do (print i)
) )
"
1
2
3
4
5 "
(with-output-to-string (*standard-output*)
(loop for i from 10 downto 1 by 3
do (print i)
) )
"
10
7
4
1 "
(with-output-to-string (*standard-output*)
(loop as i below 5
do (print i)
) )
"
0
1
2
3
4 "
(with-output-to-string (*standard-output*)
(loop for item in '(1 2 3 4 5)
do (print item)
) )
"
1
2
3
4
5 "
(with-output-to-string (*standard-output*)
(loop for item in '(1 2 3 4 5) by #'cddr
do (print item)
) )
"
1
3
5 "
(loop for (item . x) (t . fixnum) in '((A . 1) (B . 2) (C . 3))
unless (eq item 'B) sum x
)
4
(loop for sublist on '(a b c d)
collect sublist
)
((A B C D) (B C D) (C D) (D))
(with-output-to-string (*standard-output*)
(loop for (item) on '(1 2 3)
do (print item)
) )
"
1
2
3 "
(with-output-to-string (*standard-output*)
(loop for item in '(1 2 3)
do (print item)
) )
"
1
2
3 "
(loop for i below 5
for j = 10 then i
collect j
)
(10 1 2 3 4)
(loop for i below 5
for j = i
collect j
)
(0 1 2 3 4)
(loop for item = 1 then (+ item 10)
repeat 5
collect item
)
(1 11 21 31 41)
(loop for char across (the simple-string "Hello")
collect char
)
(#\H #\e #\l #\l #\o)
(with-output-to-string (*standard-output*)
(loop repeat 3
do (write-line "What I say three times is true")
) )
"What I say three times is true
What I say three times is true
What I say three times is true
"
(with-output-to-string (*standard-output*)
(loop repeat -15
do (write-line "What you see is what you expect")
) )
""
#| ;; FOR clauses should come before WHILE clauses
(let ((stack '(a b c d e f)))
(loop while stack
for item = (length stack) then (pop stack)
collect item
) )
(6 A B C D E F)
|#
(loop for i fixnum from 3
when (oddp i) collect i
while (< i 5)
)
(3 5)
(loop for i from 0 to 10
always (< i 11)
)
T
(loop for i from 0 to 10
never (> i 11)
)
T
(loop for i from 0
thereis (when (> i 10) i)
)
11
(with-output-to-string (*standard-output*)
(loop for i from 0 to 10
always (< i 9)
finally (print "You won't see this")
) )
""
(with-output-to-string (*standard-output*)
(loop never t
finally (print "You won't see this")
) )
""
(with-output-to-string (*standard-output*)
(loop thereis "Here is my value"
finally (print "You won't see this")
) )
""
(loop thereis "Here is my value"
finally (print "You won't see this")
)
"Here is my value"
(with-output-to-string (*standard-output*)
(loop for i from 1 to 10
thereis (> i 11)
finally (print i)
) )
"
11 "
(let (everest chocorua sahara)
(defstruct mountain height difficulty (why "because it is there"))
(setq everest (make-mountain :height '(2.86e-13 parsecs)))
(setq chocorua (make-mountain :height '(1059180001 microns)))
(defstruct desert area (humidity 0))
(setq sahara (make-desert :area '(212480000 square furlongs)))
(loop for x in (list everest sahara chocorua)
thereis (and (mountain-p x) (mountain-height x))
) )
(2.86e-13 parsecs)
(with-output-to-string (*standard-output*)
(loop for (month date-list) in '((january (24 28)) (february (17 29 12)))
do (loop for date in date-list
do (case date
(29 (when (eq month 'february) (loop-finish)))
)
do (format t "~:(~A~) ~A~%" month date)
) ) )
"January 24
January 28
February 17
"
(loop for i in '(1 2 3 stop-here 4 5 6)
when (symbolp i) do (loop-finish)
count i
)
3
(loop for i in '(1 2 3 stop-here 4 5 6)
until (symbolp i)
count i
)
3
(loop for name in '(fred sue alice joe june)
for kids in '((bob ken) () () (kris sunshine) ())
collect name
append kids
)
(FRED BOB KEN SUE ALICE JOE KRIS SUNSHINE JUNE)
(multiple-value-list
(loop for name in '(fred sue alice joe june)
as age in '(22 26 19 20 10)
append (list name age) into name-and-age-list
count name into name-count
sum age into total-age
finally
(return (values (round total-age name-count) name-and-age-list))
) )
(19 (FRED 22 SUE 26 ALICE 19 JOE 20 JUNE 10))
(loop for i in '(bird 3 4 turtle (1 . 4) horse cat)
when (symbolp i) collect i
)
(BIRD TURTLE HORSE CAT)
(loop for i from 1 to 10
if (oddp i) collect i
)
(1 3 5 7 9)
(with-output-to-string (*standard-output*)
(loop for i in '(a b c d) by #'cddr
collect i into my-list
finally (print my-list)
) )
"
(A C) "
(loop for x in '((a) (b) ((c)))
append x
)
(A B (C))
(loop for i upfrom 0
as x in '(a b (c))
nconc (if (evenp i) (list x) '())
)
(A (C))
(loop for i in '(a b nil c nil d e)
count i
)
5
(loop for i fixnum in '(1 2 3 4 5)
sum i
)
15
(let ((series '(1.2 4.3 5.7)))
(loop for v in series
sum (* 2.0 v)
) )
22.4
(loop for i in '(2 1 5 3 4)
maximize i
)
5
(loop for i in '(2 1 5 3 4)
minimize i
)
1
(let ((series '(1.2 4.3 5.7)))
(loop for v in series
maximize (round v) fixnum
) )
6
(let ((series '(1.2 4.3 5.7)))
(loop for v in series
minimize (round v) into result fixnum
finally (return result)
) )
1
(loop with a = 1
with b = (+ a 2)
with c = (+ b 3)
with d = (+ c 4)
return (list a b c d)
)
(1 3 6 10)
(loop with a = 1
and b = 2
and c = 3
and d = 4
return (list a b c d)
)
(1 2 3 4)
(let ((a 5) (b 10) (c 1729))
(loop with a = 1
and b = (+ a 2)
and c = (+ b 3)
and d = (+ c 4)
return (list a b c d)
) )
(1 7 13 1733)
(loop with (a b c) (float integer float)
return (format nil "~A ~A ~A" a b c)
)
"0.0 0 0.0"
(loop with (a b c) float
return (format nil "~A ~A ~A" a b c)
)
"0.0 0.0 0.0"
(let ((numbers-list '(3 2 4 6 1 7 8)) (results nil))
(cons
(with-output-to-string (*standard-output*)
(loop for i in numbers-list
when (oddp i)
do (print i)
and collect i into odd-numbers
and do (terpri)
else
collect i into even-numbers
finally (setq results (list odd-numbers even-numbers))
) )
results
) )
("
3
1
7
"
(3 1 7) (2 4 6 8))
(loop for i in '(1 2 3 4 5 6)
when (and (> i 3) i)
collect it
)
(4 5 6)
(loop for i in '(1 2 3 4 5 6)
when (and (> i 3) i)
return it
)
4
(loop for i in '(1 2 3 4 5 6)
thereis (and (> i 3) i)
)
4
(with-output-to-string (*standard-output*)
(loop for x from 0 to 3
do (print x)
if (zerop (mod x 2))
do (write-string " a")
and
if (zerop (floor x 2))
do (write-string " b")
and
do (write-string " c")
) )
"
0 a b c
1
2 a
3 "
(with-output-to-string (*standard-output*)
(loop for x from 0 to 3
do (print x)
if (zerop (mod x 2))
do (write-string " a")
and
if (zerop (floor x 2))
do (write-string " b")
end
and
do (write-string " c")
) )
"
0 a b c
1
2 a c
3 "
(with-output-to-string (*standard-output*)
(loop for i from 1 to 5
do (print i)
) )
"
1
2
3
4
5 "
(with-output-to-string (*standard-output*)
(loop for i from 1 to 4
do (print i)
(print (* i i))
) )
"
1
1
2
4
3
9
4
16 "
(loop for item in '(1 2 3 a 4 5)
when (not (numberp item))
return (format nil "non-numeric value: ~S" item)
)
"non-numeric value: A"
(loop for item in '(1 2 3 a 4 5)
when (not (numberp item))
do (return (format nil "non-numeric value: ~S" item))
)
"non-numeric value: A"
(loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
for a integer = (first numlist)
for b integer = (second numlist)
for c float = (third numlist)
collect (list c b a)
)
((4.0 2 1) (8.3 6 5) (10.4 9 8))
;; According to the BNF syntax, "and" must not be followed by "for". But
;; ANSI CL section 6.1.1.5.1 contains ambiguous wording, and this example
;; appears in CLtL2 p. 743, we keep it.
(loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
for a integer = (first numlist)
and for b integer = (second numlist)
and for c float = (third numlist)
collect (list c b a)
)
#-CMU ((4.0 2 1) (8.3 6 5) (10.4 9 8))
#+CMU ERROR
(loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
for a integer = (first numlist)
and b integer = (second numlist)
and c float = (third numlist)
collect (list c b a)
)
((4.0 2 1) (8.3 6 5) (10.4 9 8))
(loop for (a b c) (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))
(loop for (a b c) 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))
(loop with (a b) float = '(1.0 2.0)
and (c d) integer = '(3 4)
and (e f)
return (list a b c d e f)
)
(1.0 2.0 3 4 NIL NIL)
(loop for (a nil b) = '(1 2 3)
do (return (list a b))
)
(1 3)
(loop for (x . y) = '(1 . 2)
do (return y)
)
2
(loop for ((a . b) (c . d)) of-type ((float . float) (integer . integer))
in '(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6)))
collect (list a b c d)
)
((1.2 2.4 3 4) (3.4 4.6 5 6))
(loop for buffer in '("\"Hello\"" "\"unterminated" "nothing")
collect
(loop initially (unless (char= (char buffer 0) #\") (loop-finish))
for i fixnum from 1 below (length buffer)
when (char= (char buffer i) #\")
return i
) )
(6 NIL NIL)
(let (result)
(list
(with-output-to-string (*standard-output*)
(setq result
(loop for i from 1 to 10
when (> i 5)
collect i
finally (print i)
) ) )
result
) )
("
11 " (6 7 8 9 10))
(multiple-value-list
(loop for i from 1 to 10
when (> i 5)
collect i into number-list
and count i into number-count
finally (return (values number-count number-list))
) )
(5 (6 7 8 9 10))
(let (result)
(list
(with-output-to-string (*standard-output*)
(setq result
(loop named max
for i from 1 to 10
do (print i)
do (return-from max 'done)
) ) )
result
) )
("
1 " DONE)
;;; The following tests are not mandatory according to dpANS or ANSI CL,
;;; but that's how users expect the LOOP macro to work, so we check them.
(loop for i = 0
for j to 2
collect j
)
(0 1 2)
(loop for i in '(1 2)
for j = i
for k = j
collect (list i j k)
)
((1 1 1) (2 2 2))
(loop for idx upfrom 0 below 5
for char = (aref "Error" idx)
collect char
)
(#\E #\r #\r #\o #\r)
(let ((hash-table (make-hash-table)))
(setf (gethash 1 hash-table) 100)
(setf (gethash 2 hash-table) 200)
(sort
(loop for key being each hash-key in hash-table using (hash-value val)
for key+1 = (1+ key)
collect (list key key+1 val))
#'<
:key #'car
) )
((1 2 100) (2 3 200))
(loop for i across '#(1 2 3 4)
for j = (1+ i)
collect (list i j)
)
((1 2) (2 3) (3 4) (4 5))
(loop for i in '()
for j = (1+ i)
collect j
)
nil
(loop for i across '#()
for j = (1+ i)
collect j
)
nil
(loop for x = t
for y in '(A B C)
for z = t
collect y
)
(A B C)
(loop for x = t
for y across '#(A B C)
for z = t
collect y
)
(A B C)
(loop for x = t
for y in ()
for z = t
collect y
)
nil
(loop for x = t
for y across '#()
for z = t
collect y
)
nil
(let ((hash-table (make-hash-table)))
(setf (gethash 1 hash-table) 100)
(setf (gethash 2 hash-table) 200)
(sort
(loop for x = t
for key being each hash-key in hash-table using (hash-value val)
for key+1 = (1+ key)
for z = t
collect (list key key+1 val))
#'<
:key #'car
) )
((1 2 100) (2 3 200))
(loop for i from 1 to 0
collect i
)
nil
(let ((hash-table (make-hash-table)))
(setf (gethash 1 hash-table) 100)
(setf (gethash 2 hash-table) 200)
(sort
(loop for val being each hash-value in hash-table
collect val)
#'<
) )
(100 200)
(let ((hash-table (make-hash-table)))
(setf (gethash 1 hash-table) 100)
(setf (gethash 2 hash-table) 200)
(sort
(loop for val being each hash-value in hash-table
for deriv-val = (/ 1 val)
collect deriv-val)
#'<
) )
(1/200 1/100)
(let ((hash-table (make-hash-table)))
(setq i 123456789)
(setf (gethash 1 hash-table) 100)
(setf (gethash 2 hash-table) 200)
(loop for i across '#(1 2 3 4 5 6)
collect i)
(loop for i in '(1 2 3 4 5 6)
collect i)
(loop for i being each hash-key of hash-table
collect i)
(loop for i being each present-symbol of *package*
collect i)
i
)
123456789
(loop for x on '(3 4 5)
for y = (car x)
for z in '(a b c)
collect z
)
(a b c)
(loop for x across '#(3 4 5)
for y = (1+ x)
for z across '#(a b c)
collect (list x y z)
)
((3 4 a) (4 5 b) (5 6 c))
(loop for x across '#()
for y = x
for z across '#(a b c)
collect (list x y z)
)
nil
(loop for x across '#(1 2 3)
for y = x
for z across '#()
collect (list x y z)
)
nil
(loop for x across '#(1 2 3)
for y = (1+ x)
for z across '#(a b)
collect (list x y z)
)
((1 2 a) (2 3 b))
(loop for x across '#(1 2)
for y = (1+ x)
for z across '#(a b c)
collect (list x y z)
)
((1 2 a) (2 3 b))
(let ((package (make-package "LOOP-TEST")))
(intern "blah" package)
(let ((blah2 (intern "blah2" package)))
(export blah2 package)
)
(list
(sort
(loop for sym being each present-symbol of package
for sym-name = (symbol-name sym)
collect sym-name
)
#'string<
)
(sort
(loop for sym being each external-symbol of package
for sym-name = (symbol-name sym)
collect sym-name
)
#'string<
) ) )
(("blah" "blah2") ("blah2"))
(let ((ht (make-hash-table)))
(loop for key being each hash-key of ht
for value = (gethash key ht)
collect (list key value)
) )
nil
(let ((ht (make-hash-table)))
(loop for dummy = (+ 1 2)
for key being each hash-key of ht
collect (list key)
) )
nil
;;; Three more tests, found by Russell Senior.
;;; They are justified by ANSI CL 6.1.1.4 and 6.1.2.1.5.
(let ((list '(1 2 3)))
(loop for x in list
and y = nil then x
collect (list x y)))
((1 NIL) (2 1) (3 2))
(let ((list '(1 2 3)))
(loop for x in list
for y = nil then x
collect (list x y)))
((1 NIL) (2 2) (3 3))
(let ((list '(1 2 3)))
(loop for x in list
for y = nil then x
and z = nil then y
collect (list x y z)))
((1 NIL NIL) (2 2 NIL) (3 3 2))
;;; One more test, found by Lennart Staflin.
(loop repeat 4 for x = (+ 1 1) collect x)
(2 2 2 2)
;;; Tests from ANSI CL section 6.1.2.1.1.
(let ((x 1)) (loop for i from x by (incf x) to 10 collect i))
(1 3 5 7 9)
(let ((x 1)) (loop for i by (incf x) from x to 10 collect i))
(2 4 6 8 10)
(loop for i from 1 to 5 collect i into c collect (copy-list c))
((1) (1 2) (1 2 3) (1 2 3 4) (1 2 3 4 5))
(let ((rem 55)) (loop for i below 3 with num = (* 10 rem) and rem collect rem))
(nil nil nil)
;; Clean up.
(progn (delete-package "LOOP-TEST") t)
T