Amiga ISO Collection/AmigaUtilCD2.iso/Programming/Misc/CLISP-1.LHA/CLISP960530-sr.lha/tests/loop.tst

Text File | 1996-04-17 | 13.8 KB | 709 lines

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

(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)
)
((4.0 2 1) (8.3 6 5) (10.4 9 8))

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

(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