-
Notifications
You must be signed in to change notification settings - Fork 0
/
map.lisp
57 lines (52 loc) · 2.13 KB
/
map.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
(in-package #:iterator)
(defun map-into (result function &rest iterables)
(do ()
((or (endp result) (cl:some #'endp iterables)) result)
(setf (elt result) (apply function (mapcar #'elt iterables)))
(step result)
(mapc #'step iterables)))
(defun map-for-effect (function &rest iterables)
(do ()
((cl:some #'endp iterables) nil)
(apply function (mapcar #'elt iterables))
(mapc #'step iterables)))
(defun map (accumulator function &rest iterables)
(do ()
((cl:some #'endp iterables)
(finalize accumulator))
(accumulate (apply function (mapcar #'elt iterables)) accumulator)
(mapc #'step iterables)))
(defun concatenate (accumulator &rest iterators)
(dolist (iterator iterators (finalize accumulator))
(do ()
((endp iterator))
(accumulate (elt iterator) accumulator)
(step iterator))))
(defun merge (accumulator iterator1 iterator2 predicate &key (key #'identity))
(if (or (endp iterator1) (endp iterator2))
(finalize accumulator)
(flet ((copy (iterator)
(do ()
((endp iterator) (finalize accumulator))
(accumulate (elt iterator) accumulator)
(step iterator))))
(loop with e1 = (elt iterator1)
with ek1 = (funcall key e1)
with e2 = (elt iterator2)
with ek2 = (funcall key e2)
do (cond ((funcall predicate ek1 ek2)
(accumulate e1 accumulator)
(step iterator1)
(cond ((endp iterator1)
(return (copy iterator2)))
(t
(setf e1 (elt iterator1)
ek1 (funcall key e1)))))
(t
(accumulate e2 accumulator)
(step iterator2)
(cond ((endp iterator2)
(return (copy iterator1)))
(t
(setf e2 (elt iterator2)
ek2 (funcall key e2))))))))))