37dc4de · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

Improve specialization of Accumulator functions

37dc4deRyan Trinkle9 years ago

src/Reflex/Class.hs+90−21

compare with develop

unifiedsplit

@@ -78,6 +78,22 @@ module Reflex.Class

78 , zipDynWith

79 -- ** Accumulating state

80 , Accumulator (..)

81+ , accumDyn

82+ , accumMDyn

83+ , accumMaybeDyn

84+ , accumMaybeMDyn

85+ , mapAccumDyn

86+ , mapAccumMDyn

87+ , mapAccumMaybeDyn

88+ , mapAccumMaybeMDyn

89+ , accumB

90+ , accumMB

91+ , accumMaybeB

92+ , accumMaybeMB

93+ , mapAccumB

94+ , mapAccumMB

95+ , mapAccumMaybeB

96+ , mapAccumMaybeMB

81 , mapAccum_

97 , mapAccum_

82 , mapAccumM_

98 , mapAccumM_

83 , mapAccumMaybe_

99 , mapAccumMaybe_

@@ -880,6 +896,12 @@ alignEventWithMaybe f ea eb =

880

896

881-- | An 'Accumulator' type can be built by accumulating occurrences of an

897-- | An 'Accumulator' type can be built by accumulating occurrences of an

882-- 'Event'.

898-- 'Event'.

899+#if __GLASGOW_HASKELL__ < 802

900+{-# WARNING accum "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}

901+{-# WARNING accumM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}

902+{-# WARNING accumMaybe "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}

903+{-# WARNING accumMaybeM "ghc < 8.2.1 doesn't seem to be able to specialize functions in this class, which can lead to poor performance" #-}

904+#endif

883class Reflex t => Accumulator t f | f -> t where

905class Reflex t => Accumulator t f | f -> t where

884 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)

906 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)

885 accum f = accumMaybe $ \v o -> Just $ f v o

907 accum f = accumMaybe $ \v o -> Just $ f v o

@@ -896,25 +918,85 @@ class Reflex t => Accumulator t f | f -> t where

896 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o

918 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o

897 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)

919 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)

898

920

921+accumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Dynamic t a)

922+accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o

923+accumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)

924+accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o

925+accumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)

926+accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o

927+accumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)

928+accumMaybeMDyn f z e = do

929+ rec let e' = flip push e $ \o -> do

930+ v <- sample $ current d'

931+ f v o

932+ d' <- holdDyn z e'

933+ return d'

934+mapAccumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)

935+mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o

936+mapAccumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)

937+mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o

938+mapAccumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)

939+mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o

940+mapAccumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)

941+mapAccumMaybeMDyn f z e = do

942+ rec let e' = flip push e $ \o -> do

943+ v <- sample $ current d'

944+ result <- f v o

945+ return $ case result of

946+ (Nothing, Nothing) -> Nothing

947+ _ -> Just result

948+ d' <- holdDyn z $ fmapMaybe fst e'

949+ return (d', fmapMaybe snd e')

950+

951+accumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Behavior t a)

952+accumB f = accumMaybeB $ \v o -> Just $ f v o

953+accumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Behavior t a)

954+accumMB f = accumMaybeMB $ \v o -> Just <$> f v o

955+accumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Behavior t a)

956+accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o

957+accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)

958+accumMaybeMB f z e = do

959+ rec let e' = flip push e $ \o -> do

960+ v <- sample d'

961+ f v o

962+ d' <- hold z e'

963+ return d'

964+mapAccumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)

965+mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o

966+mapAccumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)

967+mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o

968+mapAccumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)

969+mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o

970+mapAccumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)

971+mapAccumMaybeMB f z e = do

972+ rec let e' = flip push e $ \o -> do

973+ v <- sample d'

974+ result <- f v o

975+ return $ case result of

976+ (Nothing, Nothing) -> Nothing

977+ _ -> Just result

978+ d' <- hold z $ fmapMaybe fst e'

979+ return (d', fmapMaybe snd e')

980+

899-- | Accumulate occurrences of an 'Event', producing an output occurrence each

981-- | Accumulate occurrences of an 'Event', producing an output occurrence each

900-- time. Discard the underlying 'Accumulator'.

982-- time. Discard the underlying 'Accumulator'.

901mapAccum_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)

983mapAccum_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)

902mapAccum_ f z e = do

984mapAccum_ f z e = do

903− (_ :: Behavior t a, result) <- mapAccum f z e

985+ (_, result) <- mapAccumB f z e

904 return result

986 return result

905

987

906-- | Accumulate occurrences of an 'Event', possibly producing an output

988-- | Accumulate occurrences of an 'Event', possibly producing an output

907-- occurrence each time. Discard the underlying 'Accumulator'.

989-- occurrence each time. Discard the underlying 'Accumulator'.

908mapAccumMaybe_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)

990mapAccumMaybe_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)

909mapAccumMaybe_ f z e = do

991mapAccumMaybe_ f z e = do

910− (_ :: Behavior t a, result) <- mapAccumMaybe f z e

992+ (_, result) <- mapAccumMaybeB f z e

911 return result

993 return result

912

994

913-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing

995-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing

914-- an output occurrence each time. Discard the underlying 'Accumulator'.

996-- an output occurrence each time. Discard the underlying 'Accumulator'.

915mapAccumM_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)

997mapAccumM_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)

916mapAccumM_ f z e = do

998mapAccumM_ f z e = do

917− (_ :: Behavior t a, result) <- mapAccumM f z e

999+ (_, result) <- mapAccumMB f z e

918 return result

1000 return result

919

1001

920-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly

1002-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly

@@ -922,29 +1004,16 @@ mapAccumM_ f z e = do

922-- 'Accumulator'.

1004-- 'Accumulator'.

923mapAccumMaybeM_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)

1005mapAccumMaybeM_ :: forall t m a b c. (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)

924mapAccumMaybeM_ f z e = do

1006mapAccumMaybeM_ f z e = do

925− (_ :: Behavior t a, result) <- mapAccumMaybeM f z e

1007+ (_, result) <- mapAccumMaybeMB f z e

926 return result

1008 return result

927

1009

928instance Reflex t => Accumulator t (Dynamic t) where

1010instance Reflex t => Accumulator t (Dynamic t) where

929− accumMaybeM f z e = do

1011+ accumMaybeM = accumMaybeMDyn

930− rec let e' = flip push e $ \o -> do

931− v <- sample $ current d'

932− f v o

933− d' <- holdDyn z e'

934− return d'

935− mapAccumMaybeM f z e = do

1012+ mapAccumMaybeM = mapAccumMaybeMDyn

936− rec let e' = flip push e $ \o -> do

937− v <- sample $ current d'

938− result <- f v o

939− return $ case result of

940− (Nothing, Nothing) -> Nothing

941− _ -> Just result

942− d' <- holdDyn z $ fmapMaybe fst e'

943− return (d', fmapMaybe snd e')

944

1013

945instance Reflex t => Accumulator t (Behavior t) where

1014instance Reflex t => Accumulator t (Behavior t) where

946− accumMaybeM f z e = current <$> accumMaybeM f z e

1015+ accumMaybeM = accumMaybeMB

947− mapAccumMaybeM f z e = first current <$> mapAccumMaybeM f z e

1016+ mapAccumMaybeM = mapAccumMaybeMB

948

1017

949instance Reflex t => Accumulator t (Event t) where

1018instance Reflex t => Accumulator t (Event t) where

950 accumMaybeM f z e = updated <$> accumMaybeM f z e

1019 accumMaybeM f z e = updated <$> accumMaybeM f z e

src/Reflex/Dynamic.hs+4−4

@@ -140,12 +140,12 @@ scanDynMaybe z f d = do

140-- 'Event' occurs using a folding function on the previous value and the value

141-- of the 'Event'.

142foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)

143−foldDyn = accum . flip

143+foldDyn = accumDyn . flip

144

145-- | Like 'foldDyn', but the combining function is a 'PushM' action, so it

146-- can 'sample' existing 'Behaviors' and 'hold' new ones.

147foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)

148−foldDynM = accumM . flip

148+foldDynM = accumMDyn . flip

149

150-- | Create a 'Dynamic' using the provided initial value and change it each time

151-- the provided 'Event' occurs, using a function to combine the old value with

@@ -154,12 +154,12 @@ foldDynM = accumM . flip

154-- 'Dynamic''s 'updated' 'Event' will fire in the 'Just' case, and will not fire

155-- in the 'Nothing' case.

156foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)

157−foldDynMaybe = accumMaybe . flip

157+foldDynMaybe = accumMaybeDyn . flip

158

159-- | Like 'foldDynMaybe', but the combining function is a 'PushM' action, so it

160-- can 'sample' existing 'Behaviors' and 'hold' new ones.

161foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)

162−foldDynMaybeM = accumMaybeM . flip

162+foldDynMaybeM = accumMaybeMDyn . flip

163

164-- | Create a new 'Dynamic' that counts the occurences of the 'Event'.

165count :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Dynamic t b)

src/Reflex/Dynamic/Uniq.hs+2−2

@@ -81,13 +81,13 @@ instance Reflex t => Accumulator t (UniqDynamic t) where

81 let f' old change = do

82 mNew <- f old change

83 return $ unsafeJustChanged old =<< mNew

84− d <- accumMaybeM f' z e

84+ d <- accumMaybeMDyn f' z e

85 return $ UniqDynamic d

86 mapAccumMaybeM f z e = do

87 let f' old change = do

88 (mNew, output) <- f old change

89 return (unsafeJustChanged old =<< mNew, output)

90− (d, out) <- mapAccumMaybeM f' z e

90+ (d, out) <- mapAccumMaybeMDyn f' z e

91 return (UniqDynamic d, out)

93instance Reflex t => Functor (UniqDynamic t) where