blob: 296147e6b7c8aff521d49f626a35ea12740fb15d (
plain)
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
(.module:
lux
(lux (control ["F" functor]
["A" apply]
[monad #+ do Monad])))
## [Types]
(type: #export (State s a)
{#.doc "Stateful computations."}
(-> s [s a]))
## [Structures]
(struct: #export Functor<State>
(All [s] (F.Functor (State s)))
(def: (map f ma)
(function (_ state)
(let [[state' a] (ma state)]
[state' (f a)]))))
(struct: #export Apply<State>
(All [s] (A.Apply (State s)))
(def: functor Functor<State>)
(def: (apply ff fa)
(function (_ state)
(let [[state' f] (ff state)
[state'' a] (fa state')]
[state'' (f a)]))))
(struct: #export Monad<State>
(All [s] (Monad (State s)))
(def: functor Functor<State>)
(def: (wrap a)
(function (_ state)
[state a]))
(def: (join mma)
(function (_ state)
(let [[state' ma] (mma state)]
(ma state')))))
## [Values]
(def: #export get
{#.doc "Read the current state."}
(All [s] (State s s))
(function (_ state)
[state state]))
(def: #export (put new-state)
{#.doc "Set the new state."}
(All [s] (-> s (State s Any)))
(function (_ state)
[new-state []]))
(def: #export (update change)
{#.doc "Compute the new state."}
(All [s] (-> (-> s s) (State s Any)))
(function (_ state)
[(change state) []]))
(def: #export (use user)
{#.doc "Run function on current state."}
(All [s a] (-> (-> s a) (State s a)))
(function (_ state)
[state (user state)]))
(def: #export (local change action)
{#.doc "Run computation with a locally-modified state."}
(All [s a] (-> (-> s s) (State s a) (State s a)))
(function (_ state)
(let [[state' output] (action (change state))]
[state output])))
(def: #export (run state action)
{#.doc "Run a stateful computation."}
(All [s a] (-> s (State s a) [s a]))
(action state))
(struct: (Functor<StateT> Functor<M>)
(All [M s] (-> (F.Functor M) (F.Functor (All [a] (-> s (M [s a]))))))
(def: (map f sfa)
(function (_ state)
(:: Functor<M> map (function (_ [s a]) [s (f a)])
(sfa state)))))
(struct: (Apply<StateT> Monad<M>)
(All [M s] (-> (Monad M) (A.Apply (All [a] (-> s (M [s a]))))))
(def: functor (Functor<StateT> (:: Monad<M> functor)))
(def: (apply sFf sFa)
(function (_ state)
(do Monad<M>
[[state f] (sFf state)
[state a] (sFa state)]
(wrap [state (f a)])))))
(type: #export (State' M s a)
{#.doc "Stateful computations decorated by a monad."}
(-> s (M [s a])))
(def: #export (run' state action)
{#.doc "Run a stateful computation decorated by a monad."}
(All [M s a] (-> s (State' M s a) (M [s a])))
(action state))
(struct: #export (StateT Monad<M>)
{#.doc "A monad transformer to create composite stateful computations."}
(All [M s] (-> (Monad M) (Monad (State' M s))))
(def: functor (Functor<StateT> (:: Monad<M> functor)))
(def: (wrap a)
(function (_ state)
(:: Monad<M> wrap [state a])))
(def: (join sMsMa)
(function (_ state)
(do Monad<M>
[[state' sMa] (sMsMa state)]
(sMa state')))))
(def: #export (lift Monad<M> ma)
{#.doc "Lift monadic values to the State' wrapper."}
(All [M s a] (-> (Monad M) (M a) (State' M s a)))
(function (_ state)
(do Monad<M>
[a ma]
(wrap [state a]))))
(def: #export (while condition body)
(All [s] (-> (State s Bool) (State s Any) (State s Any)))
(do Monad<State>
[execute? condition]
(if execute?
(do @
[_ body]
(while condition body))
(wrap []))))
(def: #export (do-while condition body)
(All [s] (-> (State s Bool) (State s Any) (State s Any)))
(do Monad<State>
[_ body]
(while condition body)))
|
