832c414260
* goof-impl.scm (loop/first loop/last): add ability to specify a :default value. Added auxiliary syntax :default. * goof/iterators.scm (accumulating hash(q|v)ing): changed auxiliary keyword from initial -> :initial. * goof.scm: export extra keywords * doc.html * doc.xml : document changes. fix bugs.
156 lines
3.1 KiB
Scheme
156 lines
3.1 KiB
Scheme
(use-modules (srfi srfi-64)
|
|
(goof))
|
|
|
|
(test-begin "basic workings")
|
|
(test-equal
|
|
"basic syntax 1"
|
|
(loop ((:for a (up-from 0 3)) (:acc acc (listing a)))
|
|
=> acc)
|
|
'(0 1 2))
|
|
|
|
(test-equal ":when clause"
|
|
(loop ((:for a (up-from 0 3))
|
|
(:when (odd? a))
|
|
(:acc lst (listing a)))
|
|
=> lst)
|
|
'(1))
|
|
|
|
(test-equal ":unless clause"
|
|
(loop ((:for a (up-from 0 3))
|
|
(:unless (even? a))
|
|
(:acc lst (listing a)))
|
|
=> lst)
|
|
'(1))
|
|
|
|
(test-equal ":when subloop"
|
|
(loop/list ((a (up-from 0 4)) (:when (odd? a)) (b (up-from 0 2)))
|
|
(cons a b))
|
|
'((1 . 0) (1 . 1) (3 . 0) (3 . 1)))
|
|
|
|
(test-equal ":break"
|
|
(loop/list ((a (up-from 0)) (:break (= a 3)))
|
|
a)
|
|
'(0 1 2))
|
|
|
|
(test-equal ":final"
|
|
(loop/list ((a (up-from 0)) (:final (= a 3)))
|
|
a)
|
|
'(0 1 2 3))
|
|
|
|
(test-equal ":bind"
|
|
(loop/list ((a (up-from 0 5)) (:bind (b (+ a 1))) (:bind (c (+ b 1))))
|
|
c)
|
|
'(2 3 4 5 6))
|
|
|
|
(test-equal "putting things together"
|
|
(loop ((:for a (in-list '(((1) (2)) ((3) (4)) ((5) (6 7)))))
|
|
(:when #t)
|
|
(:for b (in-list a))
|
|
:subloop
|
|
(:for c (in-list b))
|
|
(:acc acc (listing c)))
|
|
=> acc)
|
|
'(1 2 3 4 5 6 7))
|
|
|
|
(test-equal "putting things together 2"
|
|
(loop ((:for a (in-list '(1 2 3)))
|
|
(:acc oa (summing a))
|
|
:subloop
|
|
(:for b (up-from a (:to (+ a 2))))
|
|
(:acc ob (listing b)))
|
|
=> (cons oa ob))
|
|
'(6 1 2 2 3 3 4))
|
|
(test-end "basic workings")
|
|
|
|
|
|
|
|
(test-begin "simple forms")
|
|
(test-equal "loop/first"
|
|
(loop/first ((a (in-list '(-1 1 2 3 4 5)))
|
|
(:when (even? a)))
|
|
a)
|
|
2)
|
|
|
|
(test-equal "loop/last"
|
|
(loop/last ((a (up-from 0 10)) (:when (even? a)))
|
|
a)
|
|
8)
|
|
|
|
(test-equal "loop/list"
|
|
(loop/list ((a (up-from 0 10))
|
|
(:break (> a 4)))
|
|
a)
|
|
'(0 1 2 3 4))
|
|
|
|
(test-equal "loop/product"
|
|
(loop/product ((a (up-from 1 5)))
|
|
a)
|
|
24)
|
|
|
|
(test-equal "loop/sum"
|
|
(loop/sum ((a (up-from 1 5)))
|
|
a)
|
|
10)
|
|
|
|
(test-equal "loop/and true"
|
|
(loop/and ((a (in-list '(1 1 1 1 1))))
|
|
(= a 1))
|
|
#t)
|
|
|
|
(test-equal "loop/and false"
|
|
(loop/and ((a (in-list '(1 2 3 4 banana))))
|
|
(< a 4))
|
|
#f)
|
|
|
|
(test-equal "loop/or true"
|
|
(loop/or ((a (in-list '(1 2 3 4 #f))))
|
|
(and (= 4 a) a))
|
|
4)
|
|
|
|
(test-equal "loop/or false"
|
|
(loop/or ((a (in-list '(1 3 5 banana))))
|
|
(> a 3))
|
|
#t)
|
|
|
|
(test-equal "loop/list/parallel"
|
|
(loop/list/parallel ((a (in-list '(1 2 3 4))))
|
|
(+ a 1))
|
|
'(2 3 4 5))
|
|
|
|
(test-end "simple forms")
|
|
|
|
|
|
(test-begin ":for-clauses")
|
|
(test-equal "in-list"
|
|
(loop name ((:for elt pair (in-list '(1 2 3))))
|
|
(if (null? (cdr pair))
|
|
(list elt)
|
|
(cons* elt ': (name))))
|
|
'(1 : 2 : 3))
|
|
|
|
;; suming 1 3 5 7 9 => 25
|
|
(test-equal "up-from-1"
|
|
(loop/sum ((a (up-from 1 (:to 10) (:by 2))))
|
|
a)
|
|
25)
|
|
|
|
(test-equal "up-from-2"
|
|
(loop/sum ((a (up-from 1 10 2)))
|
|
a)
|
|
25)
|
|
|
|
(test-equal "up-from unbounded"
|
|
(loop/list ((a (up-from 1)) (b (in-list '(1 2 3))))
|
|
(+ a b))
|
|
'(2 4 6))
|
|
|
|
(test-equal "up-from unbounded 2"
|
|
(loop/list ((a (up-from 1 (:by 2))) (b (in-list '(1 3 5))))
|
|
(+ a b))
|
|
'(2 6 10))
|
|
|
|
(test-equal "down-from-10"
|
|
(loop/sum ((a (down-from 11 (:to 1) (:by 2))))
|
|
a)
|
|
25)
|
|
(test-end ":for-clauses")
|