aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear/Step.hs110
1 files changed, 55 insertions, 55 deletions
diff --git a/Spear/Step.hs b/Spear/Step.hs
index f1aef59..26dfdc0 100644
--- a/Spear/Step.hs
+++ b/Spear/Step.hs
@@ -13,13 +13,13 @@ module Spear.Step
13, spure 13, spure
14, sfst 14, sfst
15, ssnd 15, ssnd
16, switch
17, multiSwitch
18, sfold 16, sfold
19 -- * Combinators 17 -- * Combinators
20, (.>) 18, (.>)
21, (<.) 19, (<.)
22, szip 20, szip
21, switch
22, multiSwitch
23) 23)
24where 24where
25 25
@@ -35,6 +35,19 @@ type Dt = Float
35data Step s e a b = 35data Step s e a b =
36 Step { runStep :: Elapsed -> Dt -> s -> e -> a -> (b, Step s e a b) } 36 Step { runStep :: Elapsed -> Dt -> s -> e -> a -> (b, Step s e a b) }
37 37
38instance Functor (Step s e a) where
39 fmap f (Step s1) = Step $ \elapsed dt g e x ->
40 let (a, s') = s1 elapsed dt g e x
41 in (f a, fmap f s')
42
43instance Monoid (Step s e a a) where
44 mempty = sid
45
46 mappend (Step s1) (Step s2) = Step $ \elapsed dt g e a ->
47 let (b, s1') = s1 elapsed dt g e a
48 (c, s2') = s2 elapsed dt g e b
49 in (c, mappend s1' s2')
50
38-- | Construct a step from a function. 51-- | Construct a step from a function.
39step :: (Elapsed -> Dt -> s -> e -> a -> (b, Step s e a b)) -> Step s e a b 52step :: (Elapsed -> Dt -> s -> e -> a -> (b, Step s e a b)) -> Step s e a b
40step = Step 53step = Step
@@ -55,6 +68,45 @@ sfst = spure $ \(a,_) -> a
55ssnd :: Step s e (a,b) b 68ssnd :: Step s e (a,b) b
56ssnd = spure $ \(_,b) -> b 69ssnd = spure $ \(_,b) -> b
57 70
71-- | Construct a step that folds a given list of inputs.
72--
73-- The step is run N+1 times, where N is the size of the input list.
74sfold :: Step s (Maybe e) a a -> Step s [e] a a
75sfold s = Step $ \elapsed dt g es a ->
76 case es of
77 [] ->
78 let (b',s') = runStep s elapsed dt g Nothing a
79 in (b', sfold s')
80 es ->
81 let (b',s') = sfold' elapsed dt g s a es
82 in (b', sfold s')
83
84sfold' :: Elapsed -> Dt -> s -> Step s (Maybe e) a a -> a -> [e]
85 -> (a, Step s (Maybe e) a a)
86sfold' elapsed dt g s a es = foldl' f (a',s') es
87 where f (a,s) e = runStep s elapsed dt g (Just e) a
88 (a',s') = runStep s elapsed dt g Nothing a
89
90-- Combinators
91
92-- | Compose two steps.
93(.>) :: Step s e a b -> Step s e b c -> Step s e a c
94(Step s1) .> (Step s2) = Step $ \elapsed dt g e a ->
95 let (b, s1') = s1 elapsed dt g e a
96 (c, s2') = s2 elapsed dt g e b
97 in (c, s1' .> s2')
98
99-- | Compose two steps.
100(<.) :: Step s e a b -> Step s e c a -> Step s e c b
101(<.) = flip (.>)
102
103-- | Evaluate two steps and zip their results.
104szip :: (a -> b -> c) -> Step s e d a -> Step s e d b -> Step s e d c
105szip f (Step s1) (Step s2) = Step $ \elapsed dt g e d ->
106 let (a, s1') = s1 elapsed dt g e d
107 (b, s2') = s2 elapsed dt g e d
108 in (f a b, szip f s1' s2')
109
58-- | Construct a step that switches between two steps based on input. 110-- | Construct a step that switches between two steps based on input.
59-- 111--
60-- The initial step is the first one. 112-- The initial step is the first one.
@@ -100,56 +152,4 @@ multiSwitch' curKey cur m = Step $ \elapsed dt g e a ->
100 m' = case curKey of 152 m' = case curKey of
101 Nothing -> m 153 Nothing -> m
102 Just key -> Map.insert key cur m 154 Just key -> Map.insert key cur m
103 in (a', multiSwitch' e s' m') 155 in (a', multiSwitch' e s' m') \ No newline at end of file
104
105-- | Construct a step that folds a given list of inputs.
106--
107-- The step is run N+1 times, where N is the size of the input list.
108sfold :: Step s (Maybe e) a a -> Step s [e] a a
109sfold s = Step $ \elapsed dt g es a ->
110 case es of
111 [] ->
112 let (b',s') = runStep s elapsed dt g Nothing a
113 in (b', sfold s')
114 es ->
115 let (b',s') = sfold' elapsed dt g s a es
116 in (b', sfold s')
117
118sfold' :: Elapsed -> Dt -> s -> Step s (Maybe e) a a -> a -> [e]
119 -> (a, Step s (Maybe e) a a)
120sfold' elapsed dt g s a es = foldl' f (a',s') es
121 where f (a,s) e = runStep s elapsed dt g (Just e) a
122 (a',s') = runStep s elapsed dt g Nothing a
123
124instance Functor (Step s e a) where
125 fmap f (Step s1) = Step $ \elapsed dt g e x ->
126 let (a, s') = s1 elapsed dt g e x
127 in (f a, fmap f s')
128
129instance Monoid (Step s e a a) where
130 mempty = sid
131
132 mappend (Step s1) (Step s2) = Step $ \elapsed dt g e a ->
133 let (b, s1') = s1 elapsed dt g e a
134 (c, s2') = s2 elapsed dt g e b
135 in (c, mappend s1' s2')
136
137-- Combinators
138
139-- | Compose two steps.
140(.>) :: Step s e a b -> Step s e b c -> Step s e a c
141(Step s1) .> (Step s2) = Step $ \elapsed dt g e a ->
142 let (b, s1') = s1 elapsed dt g e a
143 (c, s2') = s2 elapsed dt g e b
144 in (c, s1' .> s2')
145
146-- | Compose two steps.
147(<.) :: Step s e a b -> Step s e c a -> Step s e c b
148(<.) = flip (.>)
149
150-- | Evaluate two steps and zip their results.
151szip :: (a -> b -> c) -> Step s e d a -> Step s e d b -> Step s e d c
152szip f (Step s1) (Step s2) = Step $ \elapsed dt g e d ->
153 let (a, s1') = s1 elapsed dt g e d
154 (b, s2') = s2 elapsed dt g e d
155 in (f a b, szip f s1' s2') \ No newline at end of file