@@ -9,57 +9,40 @@ import Signal (lift,foldp,Signal)
99import open List
1010import Maybe (Just, Nothing)
1111
12−data Automaton input output = Pure (input -> output)
13− | Stateful state (input -> state -> (output,state))
14−
15−-- The basics
16−
17−-- AFRP name: arr
18−pure: (i -> o) -> Automaton i o
19−pure = Pure
20−
21−-- AFRP name: >>>
22−andThen: Automaton i inter -> Automaton inter o -> Automaton i o
23−andThen first second =
24− case first of
25− Pure f -> case second of -- f is the function from first
26− Pure s -> Pure (s . f) -- s is the function from second
27− Stateful b s -> Stateful b (\i -> s (f i)) -- b is the base state from second
28− Stateful fb f -> case second of -- fb is the base state from first
29− Pure s -> Stateful fb (\i st -> -- sb is the base state from second
30− let (inter, st') = f i st -- i is the input
31− in (s inter, st')) -- st is the input state
32− Stateful sb s -> Stateful (fb, sb) (\i (fst, sst) -> -- inter is the intermediate value
33− let (inter, fst') = f i fst -- st' is the new state
34− (o, sst') = s inter sst -- fst and sst are the state of first and second
35− in (o, (fst', sst'))) -- ect...
36−
37−-- AFRP name: first
38−extendDown: Automaton i o -> Automaton (i,extra) (o,extra)
39−extendDown auto = case auto of
40− Pure fun -> Pure (\(i,extra) -> (fun i, extra))
41− Stateful base fun -> Stateful base (\(i,extra) s -> (fun i s, extra))
42−
43−-- AFRP name: loop
44−loop: s -> Automaton (i,s) (o,s) -> Automaton i o
45−loop base auto = case auto of
46− Pure fun -> Stateful base (curry fun)
47− Stateful base2 fun -> -- fun: (i, s) -> s2 -> ((o, s), s2)
48− let newFun = (\i (s,s2) ->
49− let ((o, s'), s2') = fun (i, s) s2
50− in (o, (s', s2'))) -- newFun: i -> (s, s2) -> (o, (s, s2))
51− in Stateful (base, base2) newFun
52−
53−-- Run an automaton on a given signal
54−run: Automaton i o -> o -> Signal i -> Signal o
55−run auto baseOut input = case auto of
56− Pure fun -> lift fun input
57− Stateful base fun -> lift fst
58− (foldp (\i (o, s) -> fun i s)
59− (baseOut, base) input)
60−
61−
62−-- Other frequently used functions/operators
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))
6346
6447-- Create an automaton with state. Requires an initial state and a step
6548-- function to step the state forward. For example, an automaton that counted
@@ -70,46 +53,15 @@ run auto baseOut input = case auto of
7053--
7154-- It is a stateful automaton. The initial state is zero, and the step function
7255-- increments the state on every step.
73−state : s -> (i -> s -> s) -> Automaton i s
74−state base fun = loop base (pure (\(i,s) ->
75− let s' = fun i s
76− in (s',s')))
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'))
7759
7860-- Create an automaton with hidden state. Requires an initial state and a
7961-- step function to step the state forward and produce an output.
80−hiddenState : s -> (i -> s -> (s,o)) -> Automaton i o
81−hiddenState base fun = loop base (pure (\(i,s) ->
82− let (o,s') = fun i s
83− in (s',o)))
84−
85−-- AFRP name: second
86−extendUp: Automaton i o -> Automaton (extra,i) (extra,o)
87−extendUp auto =
88− let swap (a, b) = (b, a)
89− in pure swap `andThen` extendDown auto `andThen` pure swap
90−
91−-- (parallel composition)
92−pair: Automaton i1 o1 -> Automaton i2 o2 -> Automaton (i1,i2) (o1,o2)
93−pair f g = extendDown f `andThen` extendUp g
94−
95−branch : Automaton i o1 -> Automaton i o2 -> Automaton i (o1,o2)
96−branch f g =
97− let double = pure (\i -> (i,i))
98− in double `andThen` pair f g
99−
100−combi: Automaton i o -> Automaton i [o] -> Automaton i [o]
101−combi a1 a2 = (a1 `branch` a2) `andThen` pure (uncurry (::))
102−
103−-- Combine a list of automatons into a single automaton that produces a list.
104−combine : [Automaton i o] -> Automaton i [o]
105−combine autos =
106− let l = length autos
107− in if l == 0
108− then pure (\_ -> [])
109− else foldr combi (last autos `andThen` pure (\a -> [a])) (take (l-1) autos)
110−
111−
112−-- Examples of automata
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))
11365
11466-- Count the number of steps taken.
11567count : Automaton a Int
@@ -140,9 +92,10 @@ average k =
14092{-- TODO(evancz): See the following papers for ideas on how to make this
14193library faster and better:
14294
143−- Functional Reactive Programming, Continued -- took some inspirations from this paper (Apanatshka)
95+- Functional Reactive Programming, Continued
14496- Causal commutative arrows and their optimization
14597
14698Speeding things up is a really low priority. Language features and
14799libraries with nice APIs and are way more important!
148100--}
101+