/
reduceable-base.lisp
67 lines (51 loc) · 1.65 KB
/
reduceable-base.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
58
59
60
61
62
63
64
65
66
(in-package #:com.clearly-useful.generic-collection-interface)
(defun monoid (fn epsilon)
(lambda (&optional (result nil result-given) value)
(if result-given
(funcall fn result value)
epsilon)))
(defun reduce-indexable (r fn seed)
(let ((result seed))
(doindexable (v r result)
(setf result (funcall fn result v)))))
(defun reduce-seq (r fn seed)
(let ((result seed))
(doseq (v r result)
(setf result (funcall fn result v)))))
(defun reduced (v)
(throw 'coll-reduce v))
(defun reduceable-reduce (fn collection &key (initial-value (funcall fn)))
(catch 'coll-reduce
(coll-reduce collection fn initial-value)))
(defun %reduce (fn collection &key (initial-value (funcall fn)))
(reduceable-reduce fn collection :initial-value initial-value))
(defun fold-left (fn collection &key (initial-value (funcall fn)))
(reduceable-reduce fn collection :initial-value initial-value))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defstruct %reducer
coll transformer))
(extend-type %reducer
reduceable
(coll-reduce (self fn seed)
(coll-reduce (%reducer-coll self)
(funcall (%reducer-transformer self) fn)
seed)))
(defun reducer (collection transformer)
(make-%reducer :coll collection
:transformer transformer))
;;transformers
(defun mapping (fn)
(lambda (f1)
(lambda (result value)
(funcall f1 result (funcall fn value)))))
(defun filtering (pred)
(lambda (f1)
(lambda (result value)
(if (funcall pred value)
(funcall f1 result value)
result))))
(defun mapcatting (f)
(lambda (f1)
(lambda (result value)
(fold-left f1 result
:initial-value (funcall f value)))))