diff options
-rw-r--r-- | Spear/Step.hs | 110 |
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 | ) |
24 | where | 24 | where |
25 | 25 | ||
@@ -35,6 +35,19 @@ type Dt = Float | |||
35 | data Step s e a b = | 35 | data 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 | ||
38 | instance 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 | |||
43 | instance 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. |
39 | step :: (Elapsed -> Dt -> s -> e -> a -> (b, Step s e a b)) -> Step s e a b | 52 | step :: (Elapsed -> Dt -> s -> e -> a -> (b, Step s e a b)) -> Step s e a b |
40 | step = Step | 53 | step = Step |
@@ -55,6 +68,45 @@ sfst = spure $ \(a,_) -> a | |||
55 | ssnd :: Step s e (a,b) b | 68 | ssnd :: Step s e (a,b) b |
56 | ssnd = spure $ \(_,b) -> b | 69 | ssnd = 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. | ||
74 | sfold :: Step s (Maybe e) a a -> Step s [e] a a | ||
75 | sfold 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 | |||
84 | sfold' :: Elapsed -> Dt -> s -> Step s (Maybe e) a a -> a -> [e] | ||
85 | -> (a, Step s (Maybe e) a a) | ||
86 | sfold' 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. | ||
104 | szip :: (a -> b -> c) -> Step s e d a -> Step s e d b -> Step s e d c | ||
105 | szip 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. | ||
108 | sfold :: Step s (Maybe e) a a -> Step s [e] a a | ||
109 | sfold 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 | |||
118 | sfold' :: Elapsed -> Dt -> s -> Step s (Maybe e) a a -> a -> [e] | ||
119 | -> (a, Step s (Maybe e) a a) | ||
120 | sfold' 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 | |||
124 | instance 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 | |||
129 | instance 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. | ||
151 | szip :: (a -> b -> c) -> Step s e d a -> Step s e d b -> Step s e d c | ||
152 | szip 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 | ||