@@ -4,54 +4,60 @@
44-- it can be used.
55module Automaton where
66
7−data Automaton a b = Automaton (a -> (b, Automaton a b))
7+data Automaton a b = Step (a -> (Automaton a b, b))
88
9−-- Run an automaton on a given signal. The automaton takes in ‘a’ values and returns ‘b’ values. The automaton steps forward whenever the input signal updates.
10−run : Automaton a b -> Signal a -> Signal b
11−run (Automaton m0) input =
12− lift fst $ foldp' (\a (b, Automaton m) -> m a) m0 input
9+-- Run an automaton on a given signal. The automaton steps forward
10+-- whenever the input signal updates.
11+run : Automaton a b -> b -> Signal a -> Signal b
12+run (Step f) base inputs =
13+ let step a (Step f, _) = f a
14+ in lift snd $ foldp step base inputs
1315
1416-- Step an automaton forward once with a given input.
15−step : Automaton a b -> a -> (b, Automaton a b)
16−step (Automaton m) a = m a
17−
17+step : a -> Automaton a b -> (Automaton a b, b)
18+step a (Step f) = f a
1819
1920-- Compose two automatons, chaining them together.
2021(>>>) : Automaton a b -> Automaton b c -> Automaton a c
21−a1 >>> a2 =
22− let Automaton m1 = a1
23− Automaton m2 = a2
24− in Automaton (\a -> let (b,m1') = m1 a
25− (c,m2') = m2 b
26− in (c, m1' >>> m2'))
22+f >>> g =
23+ Step (\a -> let (f', b) = step a f
24+ (g', c) = step b g
25+ in (f' >>> g', c))
2726
2827-- Compose two automatons, chaining them together.
2928(<<<) : Automaton b c -> Automaton a b -> Automaton a c
30−a2 <<< a1 = a1 >>> a2
29+g <<< f = f >>> g
3130
3231-- Combine a list of automatons into a single automaton that produces a list.
3332combine : [Automaton a b] -> Automaton a [b]
3433combine autos =
35− Automaton (\a -> let (bs,autos') = unzip $ map (\(Automaton m) -> m a) autos in
36− (bs, combine autos'))
37−
38−-- Create an automaton with no memory. It just applies the given function to every input.
39−pure : (a -> b) -> Automaton a b
40−pure f = Automaton (\x -> (f x, pure f))
41−
42−-- Create an automaton with no memory. It just applies the given function to every input.
43−init : b -> (a -> b -> b) -> Automaton a b
44−init s step = Automaton (\a -> let s' = step a s in (s', init s' step))
45−
46−-- Create an automaton with hidden state. Requires an initial state and a step function to step the state forward and produce an output.
47−init' : s -> (a -> s -> (b,s)) -> Automaton a b
48−init' s step = Automaton (\a -> let (b,s') = step a s in (b , init' s' step))
34+ Step (\a -> let (autos', bs) = unzip $ map (step a) autos
35+ in (combine autos', bs))
36+
37+-- Create an automaton with no memory. It just applies the given function to
38+-- every input.
39+pure : (a -> b) -> Automaton a b
40+pure f = Step (\x -> (pure f, f x))
41+
42+-- Create an automaton with state. Requires an initial state and a step
43+-- function to step the state forward.
44+init : b -> (a -> b -> b) -> Automaton a b
45+init s f = Step (\x -> let s' = f x s
46+ in (init s' f, s'))
47+
48+-- Create an automaton with hidden state. Requires an initial state and a
49+-- step function to step the state forward and produce an output.
50+init' : s -> (a -> s -> (s,b)) -> Automaton a b
51+init' s f = Step (\x -> let (s',out) = f x s
52+ in (init' s' f, out))
4953
5054-- Count the number of steps taken.
5155count : Automaton a Int
5256count = init 0 (\_ c -> c + 1)
5357
5458
59+{-- TODO(evancz): move this code to the Form library so people can find it.
60+
5561data DragState = Listen | Ignore | DragFrom (Int,Int)
5662
5763vecSub (x1,y1) (x2,y2) = (x1-x2,y1-y2)
@@ -71,15 +77,15 @@ stepDrag (press,pos) (ds,form) =
7177-- Create a draggable form that can be dynamically created and added to a scene.
7278draggable : Form -> Automaton (Bool,(Int,Int)) Form
7379draggable form = init' (Listen,form) stepDrag
80+--}
7481
75−
76−{--- See the following papers for ideas on how to make this faster:
82+{-- TODO(evancz): See the following papers for ideas on how to make this
83+library faster and better:
7784
7885- Functional Reactive Programming, Continued
7986- Causal commutative arrows and their optimization
8087
8188Speeding things up is a really low priority. Language features and
8289libraries with nice APIs and are way more important!
83−
8490--}
8591