git.iko.soy/elk
on master help sign in
Rewrote Automaton library with normal functions instead of CPS (resulting in more complex, but hopefully better performing code). Added some common AFRP functions (including loop\!). Requires some testing...
ae65d1eJeff Smits
libraries/Automaton.elm+106−42
compare with master
unifiedsplit
@@ -9,40 +9,59 @@ import Signal (lift,foldp,Signal)
9import open List
9import open List
10import Maybe (Just, Nothing)
10import Maybe (Just, Nothing)
11
11
12−data Automaton a b = Step (a -> (Automaton a b, b))
12+data Automaton input output =
13−
13+ Pure (input -> output)
14+ | Stateful state (input -> state -> (output,state))
15+
16+
17+-- The basics
18+
19+-- AFRP name: arr
20+pure: (i -> o) -> Automaton i o
21+pure = Pure
22+
23+-- AFRP name: >>>
24+before: Automaton i inter -> Automaton inter o -> Automaton i o
25+before first second =
26+ case first of
27+ Pure f -> case second of -- f is the function from first
28+ Pure s -> Pure (s . f) -- s is the function from second
29+ Stateful b s -> Stateful b (\i -> s (f i)) -- b is the base state from second
30+ Stateful fb f -> case second of -- fb is the base state from first
31+ Pure s -> Stateful fb (\i st -> -- sb is the base state from second
32+ let (inter, st') = f i st -- i is the input
33+ in (s inter, st')) -- st is the input state
34+ Stateful sb s -> Stateful (fb, sb) (\i (fst, sst) -> -- inter is the intermediate value
35+ let (inter, fst') = f i fst -- st' is the new state
36+ (o, sst') = s inter sst -- fst and sst are the state of first and second
37+ in (o, (fst', sst'))) -- ect...
38+
39+-- AFRP name: first
40+extendDown: Automaton i o -> Automaton (i,extra) (o,extra)
41+extendDown auto = case auto of
42+ Pure fun -> Pure (\(i,extra) -> (fun i, extra))
43+ Stateful base fun -> Stateful base (\(i,extra) s -> (fun i s, extra))
44+
45+-- AFRP name: loop
46+loop: s -> Automaton (i,s) (o,s) -> Automaton i o
47+loop base auto = case auto of
48+ Pure fun -> Stateful base (curry fun)
49+ Stateful base2 fun -> -- fun: (i, s) -> s2 -> ((o, s), s2)
50+ let newFun = (\i (s,s2) ->
51+ let ((o, s'), s2') = fun (i, s) s2
52+ in (o, (s', s2'))) -- newFun: i -> (s, s2) -> (o, (s, s2))
53+ in Stateful (base, base2) newFun
54+
14−-- Run an automaton on a given signal. The automaton steps forward
55+-- Run an automaton on a given signal
15−-- whenever the input signal updates.
16−run : Automaton a b -> b -> Signal a -> Signal b
56+run: Automaton i o -> o -> Signal i -> Signal o
17−run auto base inputs =
57+run auto baseOut input = case auto of
18− let step a (Step f, _) = f a
58+ Pure fun -> lift fun input
19− in lift (\(x,y) -> y) (foldp step (auto,base) inputs)
59+ Stateful base fun -> lift fst
20−
60+ (foldp (\i (o, s) -> fun i s)
21−-- Step an automaton forward once with a given input.
61+ (baseOut, base) input)
22−step : a -> Automaton a b -> (Automaton a b, b)
62+
23−step a (Step f) = f a
63+
24−
64+-- Other frequently used functions/operators
25−-- Compose two automatons, chaining them together.
26−(>>>) : Automaton a b -> Automaton b c -> Automaton a c
27−f >>> g =
28− Step (\a -> let (f', b) = step a f
29− (g', c) = step b g
30− in (f' >>> g', c))
31−
32−-- Compose two automatons, chaining them together.
33−(<<<) : Automaton b c -> Automaton a b -> Automaton a c
34−g <<< f = f >>> g
35−
36−-- Combine a list of automatons into a single automaton that produces a list.
37−combine : [Automaton a b] -> Automaton a [b]
38−combine autos =
39− Step (\a -> let (autos', bs) = unzip (map (step a) autos)
40− in (combine autos', bs))
41−
42−-- Create an automaton with no memory. It just applies the given function to
43−-- every input.
44−pure : (a -> b) -> Automaton a b
45−pure f = Step (\x -> (pure f, f x))
46
65
47-- Create an automaton with state. Requires an initial state and a step
66-- Create an automaton with state. Requires an initial state and a step
48-- function to step the state forward. For example, an automaton that counted
67-- function to step the state forward. For example, an automaton that counted
@@ -53,15 +72,61 @@ pure f = Step (\x -> (pure f, f x))
53--
72--
54-- It is a stateful automaton. The initial state is zero, and the step function
73-- It is a stateful automaton. The initial state is zero, and the step function
55-- increments the state on every step.
74-- increments the state on every step.
56−state : b -> (a -> b -> b) -> Automaton a b
75+state : s -> (i -> s -> s) -> Automaton i s
57−state s f = Step (\x -> let s' = f x s
76+state base fun = loop base (pure (\(i,s) ->
77+ let s' = fun i s
58− in (state s' f, s'))
78+ in (s',s')))
59
79
60-- Create an automaton with hidden state. Requires an initial state and a
80-- Create an automaton with hidden state. Requires an initial state and a
61-- step function to step the state forward and produce an output.
81-- step function to step the state forward and produce an output.
62−hiddenState : s -> (a -> s -> (s,b)) -> Automaton a b
82+hiddenState : s -> (i -> s -> (s,o)) -> Automaton i o
63−hiddenState s f = Step (\x -> let (s',out) = f x s
83+hiddenState base fun = loop base (pure (\(i,s) ->
64− in (hiddenState s' f, out))
84+ let (o,s') = fun i s
85+ in (s',o)))
86+
87+(>>>) : Automaton i inter -> Automaton inter o -> Automaton i o
88+(>>>) = before
89+
90+after : Automaton inter o -> Automaton i inter -> Automaton i o
91+after g f = f `before` g
92+
93+(<<<) : Automaton inter o -> Automaton i inter -> Automaton i o
94+(<<<) = after
95+
96+-- AFRP name: second
97+extendUp: Automaton i o -> Automaton (extra,i) (extra,o)
98+extendUp auto =
99+ let swap (a, b) = (b, a)
100+ in pure swap >>> extendDown auto >>> pure swap
101+
102+-- (parallel composition)
103+stack: Automaton i1 o1 -> Automaton i2 o2 -> Automaton (i1,i2) (o1,o2)
104+stack f g = extendDown f >>> extendUp g
105+
106+(***): Automaton i1 o1 -> Automaton i2 o2 -> Automaton (i1,i2) (o1,o2)
107+(***) = stack
108+
109+and : Automaton i o1 -> Automaton i o2 -> Automaton i (o1,o2)
110+and f g =
111+ let double = pure (\i -> (i,i))
112+ in double >>> stack f g
113+
114+(&&&) : Automaton i o1 -> Automaton i o2 -> Automaton i (o1,o2)
115+(&&&) = and
116+
117+combi: Automaton i o -> Automaton i [o] -> Automaton i [o]
118+combi a1 a2 = (a1 &&& a2) >>> pure (uncurry (::))
119+
120+-- Combine a list of automatons into a single automaton that produces a list.
121+combine : [Automaton i o] -> Automaton i [o]
122+combine autos =
123+ let l = length autos
124+ in if l == 0
125+ then pure (\_ -> [])
126+ else foldr combi (last autos >>> pure (\a -> [a])) (take (l-1) autos)
127+
128+
129+-- Examples of automata
65
130
66-- Count the number of steps taken.
131-- Count the number of steps taken.
67count : Automaton a Int
132count : Automaton a Int
@@ -92,10 +157,9 @@ average k =
92{-- TODO(evancz): See the following papers for ideas on how to make this
157{-- TODO(evancz): See the following papers for ideas on how to make this
93library faster and better:
158library faster and better:
94
159
95−- Functional Reactive Programming, Continued
160+- Functional Reactive Programming, Continued -- took some inspirations from this paper (Apanatshka)
96- Causal commutative arrows and their optimization
161- Causal commutative arrows and their optimization
97
162
98Speeding things up is a really low priority. Language features and
163Speeding things up is a really low priority. Language features and
99libraries with nice APIs and are way more important!
164libraries with nice APIs and are way more important!
100--}
165--}
101−