@@ -9,40 +9,59 @@ import Signal (lift,foldp,Signal)
99import open List
1010import Maybe (Just, Nothing)
1111
12−data Automaton a b = Step (a -> (Automaton a b, b))
13−
14−-- Run an automaton on a given signal. The automaton steps forward
15−-- whenever the input signal updates.
16−run : Automaton a b -> b -> Signal a -> Signal b
17−run auto base inputs =
18− let step a (Step f, _) = f a
19− in lift (\(x,y) -> y) (foldp step (auto,base) inputs)
20−
21−-- Step an automaton forward once with a given input.
22−step : a -> Automaton a b -> (Automaton a b, b)
23−step a (Step f) = f a
24−
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))
12+data Automaton input output =
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+
55+-- Run an automaton on a given signal
56+run: Automaton i o -> o -> Signal i -> Signal o
57+run auto baseOut input = case auto of
58+ Pure fun -> lift fun input
59+ Stateful base fun -> lift fst
60+ (foldp (\i (o, s) -> fun i s)
61+ (baseOut, base) input)
62+
63+
64+-- Other frequently used functions/operators
4665
4766-- Create an automaton with state. Requires an initial state and a step
4867-- function to step the state forward. For example, an automaton that counted
@@ -53,15 +72,61 @@ pure f = Step (\x -> (pure f, f x))
5372--
5473-- It is a stateful automaton. The initial state is zero, and the step function
5574-- increments the state on every step.
56−state : b -> (a -> b -> b) -> Automaton a b
57−state s f = Step (\x -> let s' = f x s
58− in (state s' f, s'))
75+state : s -> (i -> s -> s) -> Automaton i s
76+state base fun = loop base (pure (\(i,s) ->
77+ let s' = fun i s
78+ in (s',s')))
5979
6080-- Create an automaton with hidden state. Requires an initial state and a
6181-- step function to step the state forward and produce an output.
62−hiddenState : s -> (a -> s -> (s,b)) -> Automaton a b
63−hiddenState s f = Step (\x -> let (s',out) = f x s
64− in (hiddenState s' f, out))
82+hiddenState : s -> (i -> s -> (s,o)) -> Automaton i o
83+hiddenState base fun = loop base (pure (\(i,s) ->
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
65130
66131-- Count the number of steps taken.
67132count : Automaton a Int
@@ -92,10 +157,9 @@ average k =
92157{-- TODO(evancz): See the following papers for ideas on how to make this
93158library faster and better:
94159
95−- Functional Reactive Programming, Continued
160+- Functional Reactive Programming, Continued -- took some inspirations from this paper (Apanatshka)
96161- Causal commutative arrows and their optimization
97162
98163Speeding things up is a really low priority. Language features and
99164libraries with nice APIs and are way more important!
100165--}
101−