/
control.clj
125 lines (114 loc) · 3.62 KB
/
control.clj
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
(ns contextual.impl.control
(:require
[contextual.impl.protocols :as p]))
(defrecord If [p t e]
p/IContext
(-invoke [this ctx]
(if (p/-invoke p ctx)
(p/-invoke t ctx)
(p/-invoke e ctx)))
p/IStringBuild
(-invoke-with-builder [this ctx sb]
(if (p/-invoke p ctx)
(p/-invoke-with-builder t ctx sb)
(p/-invoke-with-builder e ctx sb))))
(defn ->if
([p t]
(->If p t nil))
([p t e]
(->If p t e)))
(defmacro ^:private def-ors []
(let [invoke '-invoke
ctx 'ctx
name "Or"
defs
(for [n (range 21)
:let [args (map (comp symbol #(str "k" %)) (range n))
rec (symbol (str name n))
ors (map (fn [arg] `(p/-invoke ~arg ~ctx)) args)
constructor (symbol (str "->" rec))
body `(or ~@ors)]]
{:rec
`(defrecord ~rec [~@args]
p/IContext
(~invoke [~'this ~ctx]
~body))
:call `([~@args] (~constructor ~@args))})
constructor `(defn ~'->or ~@(map :call defs))]
`(do
~@(map :rec defs)
~constructor)))
(def-ors)
(defmacro ^:private def-ands []
(let [invoke '-invoke
ctx 'ctx
name "And"
defs
(for [n (range 21)
:let [args (map (comp symbol #(str "k" %)) (range n))
rec (symbol (str name n))
constructand (symbol (str "->" rec))
ands (map (fn [arg] `(p/-invoke ~arg ~ctx)) args)
body `(and ~@ands)]]
{:rec
`(defrecord ~rec [~@args]
p/IContext
(~invoke [~'this ~ctx]
~body))
:call `([~@args] (~constructand ~@args))})
constructor `(defn ~'->and ~@(map :call defs))]
`(do
~@(map :rec defs)
~constructor)))
(def-ands)
(defmacro ^:private def-conds []
(let [invoke '-invoke
ctx 'ctx
name "Cond"
defs
(for [n (range 1 11)
:let [ks (map (comp symbol #(str "k" %)) (range n))
vs (map (comp symbol #(str "v" %)) (range n))
rec (symbol (str name n))
constructor (symbol (str "->" rec))
args (interleave ks vs)
body `(cond ~@(mapv
(fn [v]
`(p/-invoke ~v ~ctx))
args))]]
{:rec
`(defrecord ~rec [~@(interleave ks vs)]
p/IContext
(~invoke [~'this ~ctx]
~body))
:call `([~@args] (~constructor ~@args))})]
`(do
~@(map :rec defs)
(defn ~'->cond ~@(map :call defs)))))
(def-conds)
(defmacro ^:private def-condps []
(let [invoke '-invoke
ctx 'ctx
name "Condp"
pred 'pred
expr 'expr
defs
(for [n (range 1 19)
:let [args (map (comp symbol #(str "x" %)) (range n))
rec (symbol (str name n))
constructor (symbol (str "->" rec))
body `(condp ~pred (p/-invoke ~expr ~ctx)
~@(mapv
(fn [v]
`(p/-invoke ~v ~ctx))
args))]]
{:rec
`(defrecord ~rec [~pred ~expr ~@args]
p/IContext
(~invoke [~'this ~ctx]
~body))
:call `([~pred ~expr ~@args] (~constructor ~pred ~expr ~@args))})]
`(do
~@(map :rec defs)
(defn ~'->condp ~@(map :call defs)))))
(def-condps)