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 | ||
