@@ -0,0 +1,148 @@
1+-- This library is a way to package up dynamic behavior. It makes it easier to
2+-- dynamically create dynamic components. See the [original release
3+-- notes](/blog/announce/version-0.5.0.elm) on this library to get a feel for how
4+-- it can be used.
5+module AutomatonV2 where
6+
7+import open Basics
8+import Signal (lift,foldp,Signal)
9+import open List
10+import Maybe (Just, Nothing)
11+
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
63+
64+-- Create an automaton with state. Requires an initial state and a step
65+-- function to step the state forward. For example, an automaton that counted
66+-- how many steps it has taken would look like this:
67+--
68+-- count = Automaton a Int
69+-- count = state 0 (\\_ c -> c+1)
70+--
71+-- It is a stateful automaton. The initial state is zero, and the step function
72+-- 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')))
77+
78+-- Create an automaton with hidden state. Requires an initial state and a
79+-- 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
113+
114+-- Count the number of steps taken.
115+count : Automaton a Int
116+count = state 0 (\_ c -> c + 1)
117+
118+type Queue t = ([t],[t])
119+empty = ([],[])
120+enqueue x (en,de) = (x::en, de)
121+dequeue q = case q of
122+ ([],[]) -> Nothing
123+ (en,[]) -> dequeue ([], reverse en)
124+ (en,hd::tl) -> Just (hd, (en,tl))
125+
126+-- Computes the running average of the last `n` inputs.
127+average : Int -> Automaton Float Float
128+average k =
129+ let step n (ns,len,sum) =
130+ if len == k then stepFull n (ns,len,sum)
131+ else ((enqueue n ns, len+1, sum+n), (sum+n) / (toFloat len+1))
132+ stepFull n (ns,len,sum) =
133+ case dequeue ns of
134+ Nothing -> ((ns,len,sum), 0)
135+ Just (m,ns') -> let sum' = sum + n - m
136+ in ((enqueue n ns', len, sum'), sum' / toFloat len)
137+ in hiddenState (empty,0,0) step
138+
139+
140+{-- TODO(evancz): See the following papers for ideas on how to make this
141+library faster and better:
142+
143+- Functional Reactive Programming, Continued -- took some inspirations from this paper (Apanatshka)
144+- Causal commutative arrows and their optimization
145+
146+Speeding things up is a really low priority. Language features and
147+libraries with nice APIs and are way more important!
148+--}