git.iko.soy/reflex
on b3ad64a help sign in
90891e1
swap
8 ahead, 338 behind
12 files changed+301−302
since splitsnapshots
unifiedsplit
ChangeLog.md+1−12 default.nix−1 reflex.cabal+2−1 src/Control/Monad/ReaderIO.hs−60 src/Reflex/Class.hs+7−56 src/Reflex/Patch/DMapWithReset.hs+120 src/Reflex/Patch/Patchable.hs+44 src/Reflex/Profiled.hs+8−12 src/Reflex/Pure.hs+3−5 src/Reflex/Spider/Internal.hs+114−141 test/GC.hs+2−2 test/Reflex/Bench/Focused.hs−12
ChangeLog.md+1−12
@@ -16,23 +16,12 @@
1616
1717## 0.6.2.1
1818
19−* Generalize `fan` to `fanG` to take a `DMap` with non-`Identity`
20− functor:
21− * `fan` to `fanG`
22− * `EventSelectorG` for `fanG` result selector.
23−
24−* Reduce the amount of unsafeCoerce in coercing newtypes under Event/Dynamic/Behavior.
25− * Add fused ReaderIO for the purpose of coercion (ReaderT's third argument has nominal role preventing automated coerce)
26− * Add incrementalCoercion/coerceIncremental to go with dynamicCoercion/coerceDynamic
27−
2819* Generalize merging functions:
2920 `merge` to `mergeG`,
3021 `mergeIncremental` to `mergeIncrementalG`,
22+ `distributeDMapOverDynPure` to `distributeDMapOverDynPureG`,
3123 `mergeIncrementalWithMove` to `mergeIncrementalWithMoveG`.
3224
33−* Generalize distribute function:
34− `distributeDMapOverDynPure` to `distributeDMapOverDynPureG`,
35−
3625## 0.6.2.0
3726
3827* Fix `holdDyn` so that it is lazy in its event argument
default.nix−1
@@ -23,7 +23,6 @@ mkDerivation {
2323 base bifunctors containers deepseq dependent-map dependent-sum
2424 mtl ref-tf split transformers data-default
2525 random time unbounded-delays monoidal-containers witherable
26− profunctors
2726 ] ++ (if ghc.isGhcjs or false then [
2827 ghcjs-base
2928 ] else []) ++ (if !useTemplateHaskell then [] else [
reflex.cabal+2−1
@@ -85,7 +85,6 @@ library
8585 monoidal-containers == 0.4.0.0
8686
8787 exposed-modules:
88− Control.Monad.ReaderIO
8988 Data.AppendMap,
9089 Data.FastMutableIntMap,
9190 Data.FastWeakBag,
@@ -115,9 +114,11 @@ library
115114 Reflex.Patch.Class,
116115 Reflex.Patch.DMap,
117116 Reflex.Patch.DMapWithMove,
117+ Reflex.Patch.DMapWithReset,
118118 Reflex.Patch.IntMap,
119119 Reflex.Patch.Map,
120120 Reflex.Patch.MapWithMove,
121+ Reflex.Patch.Patchable,
121122 Reflex.PerformEvent.Base,
122123 Reflex.PerformEvent.Class,
123124 Reflex.PostBuild.Base,
src/Control/Monad/ReaderIO.hsdeleted−60
@@ -1,60 +0,0 @@
1−{-# language RoleAnnotations #-}
2−{-# language MultiParamTypeClasses #-}
3−{-# language FlexibleInstances #-}
4−{-# language CPP #-}
5−module Control.Monad.ReaderIO
6− (
7− ReaderIO (..)
8− )
9− where
10−
11−import Control.Monad.Fix
12−#if MIN_VERSION_base(4,10,0)
13−import Control.Applicative
14−#endif
15−import Control.Monad
16−import Control.Monad.Reader.Class
17−import Control.Monad.IO.Class
18−
19−-- | An approximate clone of @RIO@ from the @rio@ package, but not based on
20−-- @ReaderT@. The trouble with @ReaderT@ is that its third type argument has a
21−-- @nominal@ role, so we can't coerce through it when it's wrapped in some
22−-- other @data@ type. Ugh.
23−newtype ReaderIO e a = ReaderIO { runReaderIO :: e -> IO a }
24−type role ReaderIO representational representational
25−
26−instance Functor (ReaderIO e) where
27− fmap = liftM
28− {-# INLINE fmap #-}
29− a <$ m = m >> pure a
30− {-# INLINE (<$) #-}
31−
32−instance Applicative (ReaderIO e) where
33− pure a = ReaderIO $ \_ -> pure a
34− {-# INLINE pure #-}
35− (<*>) = ap
36− {-# INLINE (<*>) #-}
37−#if MIN_VERSION_base(4,10,0)
38− liftA2 = liftM2
39− {-# INLINE liftA2 #-}
40−#endif
41− (*>) = (>>)
42− {-# INLINE (*>) #-}
43−
44−instance Monad (ReaderIO e) where
45− ReaderIO q >>= f = ReaderIO $ \e -> q e >>= \a -> runReaderIO (f a) e
46− {-# INLINE (>>=) #-}
47−
48−instance MonadFix (ReaderIO e) where
49− mfix f = ReaderIO $ \e -> mfix $ \r -> runReaderIO (f r) e
50− {-# INLINE mfix #-}
51−
52−instance MonadIO (ReaderIO e) where
53− liftIO m = ReaderIO $ \_ -> m
54− {-# INLINE liftIO #-}
55−
56−instance MonadReader e (ReaderIO e) where
57− ask = ReaderIO pure
58− {-# INLINE ask #-}
59− local f (ReaderIO m) = ReaderIO (m . f)
60− {-# INLINE local #-}
src/Reflex/Class.hs+7−56
@@ -36,12 +36,10 @@ module Reflex.Class
3636 , coerceBehavior
3737 , coerceEvent
3838 , coerceDynamic
39− , coerceIncremental
4039 , MonadSample (..)
4140 , MonadHold (..)
4241 -- ** 'fan' related types
4342 , EventSelector (..)
44− , EventSelectorG (..)
4543 , EventSelectorInt (..)
4644 -- * Convenience functions
4745 , constDyn
@@ -65,7 +63,6 @@ module Reflex.Class
6563 , alignEventWithMaybe
6664 -- ** Breaking up 'Event's
6765 , splitE
68− , fan
6966 , fanEither
7067 , fanThese
7168 , fanMap
@@ -90,7 +87,6 @@ module Reflex.Class
9087 , gate
9188 -- ** Combining 'Dynamic's
9289 , distributeDMapOverDynPure
93− , distributeDMapOverDynPureG
9490 , distributeListOverDyn
9591 , distributeListOverDynWith
9692 , zipDyn
@@ -273,16 +269,13 @@ class ( MonadHold t (PushM t)
273269 -- | Merge a collection of events; the resulting 'Event' will only occur if at
274270 -- least one input event is occurring, and will contain all of the input keys
275271 -- that are occurring simultaneously
276−
277− --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
278272 mergeG :: GCompare k => (forall a. q a -> Event t (v a))
279273 -> DMap k q -> Event t (DMap k v)
280−
274+ --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
281275 -- | Efficiently fan-out an event to many destinations. You should save the
282− -- result in a @let@-binding, and then repeatedly 'selectG' on the result to
276+ -- result in a @let@-binding, and then repeatedly 'select' on the result to
283277 -- create child events
284− fanG :: GCompare k => Event t (DMap k v) -> EventSelectorG t k v
285−
278+ fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k
286279 -- | Create an 'Event' that will occur whenever the currently-selected input
287280 -- 'Event' occurs
288281 switch :: Behavior t (Event t a) -> Event t a
@@ -323,25 +316,9 @@ class ( MonadHold t (PushM t)
323316 -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
324317 -- occurrence type
325318 dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
326− -- | Construct a 'Coercion' for an 'Incremental' given 'Coercion's for its
327− -- patch target and patch types.
328− incrementalCoercion
329− :: Coercion (PatchTarget a) (PatchTarget b) -> Coercion a b -> Coercion (Incremental t a) (Incremental t b)
330319 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
331320 fanInt :: Event t (IntMap a) -> EventSelectorInt t a
332321
333−-- | Efficiently fan-out an event to many destinations. You should save the
334−-- result in a @let@-binding, and then repeatedly 'select' on the result to
335−-- create child events
336−fan :: forall t k. (Reflex t, GCompare k)
337− => Event t (DMap k Identity) -> EventSelector t k
338− --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
339−fan e = EventSelector (fixup (selectG (fanG e) :: k a -> Event t (Identity a)) :: forall a. k a -> Event t a)
340− where
341− fixup :: forall a. (k a -> Event t (Identity a)) -> k a -> Event t a
342− fixup = case eventCoercion Coercion :: Coercion (Event t (Identity a)) (Event t a) of
343− Coercion -> coerce
344−
345322--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
346323-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple
347324-- keys simultaneously.
@@ -360,12 +337,6 @@ coerceEvent = coerceWith $ eventCoercion Coercion
360337coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
361338coerceDynamic = coerceWith $ dynamicCoercion Coercion
362339
363−-- | Coerce an 'Incremental' between representationally-equivalent value types
364−coerceIncremental
365− :: (Reflex t, Coercible a b, Coercible (PatchTarget a) (PatchTarget b))
366− => Incremental t a -> Incremental t b
367−coerceIncremental = coerceWith $ incrementalCoercion Coercion Coercion
368−
369340-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
370341-- __must__ change when and only when the 'Event' fires, such that the
371342-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
@@ -535,17 +506,6 @@ newtype EventSelector t k = EventSelector
535506 select :: forall a. k a -> Event t a
536507 }
537508
538−newtype EventSelectorG t k v = EventSelectorG
539− { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
540− -- determined by the type of the key, so this can be used to fan-out
541− -- 'Event's whose sub-'Event's have different types.
542− --
543− -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
544− -- (but equivalent to) using 'mapMaybe' to select only the relevant
545− -- occurrences of an 'Event'.
546− selectG :: forall a. k a -> Event t (v a)
547− }
548−
549509-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
550510-- filtering by key.
551511newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
@@ -1138,21 +1098,12 @@ instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
11381098-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
11391099-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
11401100distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
1141−distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
1142−
1143−-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
1144−-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
1145−-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
1146−distributeDMapOverDynPureG
1147− :: forall t k q v. (Reflex t, GCompare k)
1148− => (forall a. q a -> Dynamic t (v a))
1149− -> DMap k q -> Dynamic t (DMap k v)
1150−distributeDMapOverDynPureG nt dm = case DMap.toList dm of
1101+distributeDMapOverDynPure dm = case DMap.toList dm of
11511102 [] -> constDyn DMap.empty
1152− [k :=> v] -> DMap.singleton k <$> nt v
1103+ [k :=> v] -> fmap (DMap.singleton k . Identity) v
11531104 _ ->
1154− let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
1155− edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
1105+ let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
1106+ edmPre = merge $ DMap.map updated dm
11561107 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
11571108 olds <- sample $ current result
11581109 return $ DMap.unionWithKey (\_ _ new -> new) olds news
src/Reflex/Patch/DMapWithReset.hsnew file+120
@@ -0,0 +1,120 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE LambdaCase #-}
4+{-# LANGUAGE MultiParamTypeClasses #-}
5+{-# LANGUAGE PolyKinds #-}
6+{-# LANGUAGE Rank2Types #-}
7+{-# LANGUAGE ScopedTypeVariables #-}
8+{-# LANGUAGE StandaloneDeriving #-}
9+{-# LANGUAGE TypeApplications #-}
10+{-# LANGUAGE TypeFamilies #-}
11+{-# LANGUAGE UndecidableInstances #-}
12+
13+{-# OPTIONS_GHC -Wall #-}
14+
15+-- | 'Patch'es on 'DMap' that consist only of insertions (or overwrites) and deletions.
16+module Reflex.Patch.DMapWithReset where
17+
18+import Reflex.Patch.Class
19+
20+import Data.Dependent.Map (DMap, GCompare (..))
21+import qualified Data.Dependent.Map as DMap
22+import Data.Semigroup (Semigroup (..))
23+import Data.Constraint.Extras
24+
25+-- | A set of changes to a 'DMap'. Any element may be inserted/updated or deleted.
26+-- Insertions are represented as @'ComposeMaybe' (Just value)@,
27+-- while deletions are represented as @'ComposeMaybe' Nothing@.
28+newtype PatchDMapWithReset k p = PatchDMapWithReset { unPatchDMapWithReset :: DMap k (By p) }
29+
30+-- | Holds the information about each key: where its new value should come from,
31+-- and where its old value should go to
32+data By p a
33+ = By_Insert (PatchTarget (p a)) -- ^ Insert the given value here
34+ | By_Delete -- ^ Delete the existing value, if any, from here
35+ | By_Patch (p a) -- ^ Patch the value here with the given patch
36+
37+instance (Semigroup (p a), Patch (p a)) => Semigroup (By p a) where
38+ x@(By_Insert _) <> _ = x
39+ By_Delete <> _ = By_Delete
40+ By_Patch x <> By_Insert y = By_Insert (applyAlways x y)
41+ By_Patch x <> By_Patch y = By_Patch (x <> y)
42+ By_Patch _ <> By_Delete = By_Delete
43+
44+instance (Monoid (p a), Patch (p a)) => Monoid (By p a) where
45+ mappend = (<>)
46+ mempty = By_Patch mempty
47+
48+instance
49+ ( GCompare k
50+ , Has' Semigroup k p
51+ , Has' Patch k p
52+ )
53+ => Semigroup (PatchDMapWithReset k p) where
54+ PatchDMapWithReset xs <> PatchDMapWithReset ys = PatchDMapWithReset $ DMap.unionWithKey
55+ (\k -> has' @Patch @p k
56+ $ has' @Semigroup @p k
57+ $ (<>)) xs ys
58+
59+instance
60+ ( GCompare k
61+ , Has' Semigroup k p
62+ , Has' Patch k p
63+ )
64+ => Monoid (PatchDMapWithReset k p) where
65+ mappend = (<>)
66+ mempty = PatchDMapWithReset DMap.empty
67+
68+class (Patch (p a), PatchTarget (p a) ~ Patches1LocallyTarget p a) => Patches1Locally p a where
69+ type Patches1LocallyTarget p :: k -> *
70+
71+data These1 f g x
72+ = This1 (f x)
73+ | That1 (g x)
74+ | These1 (f x) (g x)
75+
76+mergeWithKey
77+ :: forall k v1 v2 v.
78+ (GCompare k)
79+ => (forall x. k x -> v1 x -> Maybe (v x))
80+ -> (forall x. k x -> v2 x -> Maybe (v x))
81+ -> (forall x. k x -> v1 x -> v2 x -> Maybe (v x))
82+ -> DMap k v1 -> DMap k v2 -> DMap k v
83+mergeWithKey f g fg = \xs ys -> DMap.mapMaybeWithKey onlyThat $ DMap.unionWithKey doIt (DMap.map This1 xs) (DMap.map That1 ys)
84+ where
85+ doIt _ (This1 xs) (That1 ys) = These1 xs ys
86+ doIt _ _ _ = error "mergeWithKey misalligned keys"
87+
88+ onlyThat :: forall x. k x -> These1 v1 v2 x -> Maybe (v x)
89+ onlyThat k = \case
90+ This1 xs -> f k xs
91+ That1 ys -> g k ys
92+ These1 xs ys -> fg k xs ys
93+{-# INLINE mergeWithKey #-}
94+
95+-- | Apply the insertions or deletions to a given 'DMap'.
96+instance (GCompare k, Has (Patches1Locally p) k) => Patch (PatchDMapWithReset k p) where
97+
98+ type PatchTarget (PatchDMapWithReset k p) = DMap k (Patches1LocallyTarget p)
99+
100+ apply = go
101+ where
102+ go :: PatchDMapWithReset k p -> DMap k (Patches1LocallyTarget p) -> Maybe (DMap k (Patches1LocallyTarget p))
103+ go (PatchDMapWithReset diff) old = Just $! mergeWithKey (\_ -> Just) inserts updates old diff
104+ where
105+ updates :: forall x. k x -> Patches1LocallyTarget p x -> By p x -> Maybe (Patches1LocallyTarget p x)
106+ updates k ys = has @(Patches1Locally p) k $ \case
107+ By_Insert x -> Just x
108+ By_Delete -> Nothing
109+ By_Patch x -> Just $ applyAlways x ys
110+
111+ inserts :: forall x. k x -> By p x -> Maybe (Patches1LocallyTarget p x)
112+ inserts k = has @(Patches1Locally p) k $ \case
113+ By_Insert x -> Just x
114+ By_Delete -> Nothing
115+ By_Patch _ -> Nothing
116+
117+deriving instance (Patch (p a), Eq (p a), Eq (PatchTarget (p a))) => Eq (By p a)
118+deriving instance (Patch (p a), Show (p a), Show (PatchTarget (p a))) => Show (By p a)
119+deriving instance (Eq (DMap k (By p))) => Eq (PatchDMapWithReset k p)
120+deriving instance (Show (DMap k (By p))) => Show (PatchDMapWithReset k p)
src/Reflex/Patch/Patchable.hsnew file+44
@@ -0,0 +1,44 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# LANGUAGE LambdaCase #-}
4+{-# LANGUAGE StandaloneDeriving #-}
5+{-# LANGUAGE TypeFamilies #-}
6+
7+-- The derived instances are undecidable in the case of a pathological instance like
8+-- instance Patch x where
9+-- type PatchTarget x = Patchable x
10+{-# LANGUAGE UndecidableInstances #-}
11+
12+module Reflex.Patch.Patchable where
13+
14+-- import Data.Aeson
15+import GHC.Generics
16+import Reflex.Patch
17+
18+-- | Like SemiMap/PartialMap but for anything patchable
19+data Patchable p
20+ = Patchable_Patch p
21+ | Patchable_Complete (PatchTarget p)
22+ deriving (Generic)
23+
24+completePatchable :: Patchable p -> Maybe (PatchTarget p)
25+completePatchable = \case
26+ Patchable_Complete t -> Just t
27+ Patchable_Patch _ -> Nothing
28+
29+deriving instance (Eq p, Eq (PatchTarget p)) => Eq (Patchable p)
30+deriving instance (Ord p, Ord (PatchTarget p)) => Ord (Patchable p)
31+deriving instance (Show p, Show (PatchTarget p)) => Show (Patchable p)
32+deriving instance (Read p, Read (PatchTarget p)) => Read (Patchable p)
33+-- instance (ToJSON p, ToJSON (PatchTarget p)) => ToJSON (Patchable p)
34+-- instance (FromJSON p, FromJSON (PatchTarget p)) => FromJSON (Patchable p)
35+
36+instance (Monoid p, Patch p) => Monoid (Patchable p) where
37+ mempty = Patchable_Patch mempty
38+ mappend = (<>)
39+
40+instance (Semigroup p, Patch p) => Semigroup (Patchable p) where
41+ (<>) = curry $ \case
42+ (Patchable_Patch a, Patchable_Patch b) -> Patchable_Patch $ a <> b
43+ (Patchable_Patch a, Patchable_Complete b) -> Patchable_Complete $ applyAlways a b
44+ (Patchable_Complete a, _) -> Patchable_Complete a
src/Reflex/Profiled.hs+8−12
@@ -9,7 +9,6 @@
99{-# LANGUAGE TypeFamilies #-}
1010{-# LANGUAGE UndecidableInstances #-}
1111{-# LANGUAGE PolyKinds #-}
12−{-# LANGUAGE TypeApplications #-}
1312{-# LANGUAGE RankNTypes #-}
1413-- |
1514-- Module:
@@ -136,11 +135,11 @@ instance Reflex t => Reflex (ProfiledTimeline t) where
136135 push f (Event_Profiled e) = coerce $ push (coerce f) $ profileEvent e -- Profile before rather than after; this way fanout won't count against us
137136 pushCheap f (Event_Profiled e) = coerce $ pushCheap (coerce f) $ profileEvent e
138137 pull = Behavior_Profiled . pull . coerce
139− fanG (Event_Profiled e) = EventSelectorG $ coerce $ selectG (fanG $ profileEvent e)
140138 mergeG :: forall (k :: z -> *) q v. GCompare k
141139 => (forall a. q a -> Event (ProfiledTimeline t) (v a))
142140 -> DMap k q -> Event (ProfiledTimeline t) (DMap k v)
143141 mergeG nt = Event_Profiled #. mergeG (coerce nt)
142+ fan (Event_Profiled e) = EventSelector $ coerce $ select (fan $ profileEvent e)
144143 switch (Behavior_Profiled b) = coerce $ profileEvent $ switch (coerceBehavior b)
145144 coincidence (Event_Profiled e) = coerce $ profileEvent $ coincidence (coerceEvent e)
146145 current (Dynamic_Profiled d) = coerce $ current d
@@ -152,16 +151,13 @@ instance Reflex t => Reflex (ProfiledTimeline t) where
152151 currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i
153152 updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i
154153 incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i
155− behaviorCoercion c =
156− Coercion `trans` behaviorCoercion @t c `trans` Coercion
157− eventCoercion c =
158− Coercion `trans` eventCoercion @t c `trans` Coercion
159− dynamicCoercion c =
160− Coercion `trans` dynamicCoercion @t c `trans` Coercion
161− incrementalCoercion c d =
162− Coercion `trans` incrementalCoercion @t c d `trans` Coercion
163− mergeIntIncremental = Event_Profiled . mergeIntIncremental .
164− coerceWith (Coercion `trans` incrementalCoercion Coercion Coercion `trans` Coercion)
154+ behaviorCoercion (c :: Coercion a b) = case behaviorCoercion c :: Coercion (Behavior t a) (Behavior t b) of
155+ Coercion -> unsafeCoerce (Coercion :: Coercion (Behavior (ProfiledTimeline t) a) (Behavior (ProfiledTimeline t) a)) --TODO: Figure out how to make this typecheck without the unsafeCoerce
156+ eventCoercion (c :: Coercion a b) = case eventCoercion c :: Coercion (Event t a) (Event t b) of
157+ Coercion -> unsafeCoerce (Coercion :: Coercion (Event (ProfiledTimeline t) a) (Event (ProfiledTimeline t) a)) --TODO: Figure out how to make this typecheck without the unsafeCoerce
158+ dynamicCoercion (c :: Coercion a b) = case dynamicCoercion c :: Coercion (Dynamic t a) (Dynamic t b) of
159+ Coercion -> unsafeCoerce (Coercion :: Coercion (Dynamic (ProfiledTimeline t) a) (Dynamic (ProfiledTimeline t) a)) --TODO: Figure out how to make this typecheck without the unsafeCoerce
160+ mergeIntIncremental = Event_Profiled . mergeIntIncremental . (unsafeCoerce :: Incremental (ProfiledTimeline t) (PatchIntMap (Event (ProfiledTimeline t) a)) -> Incremental t (PatchIntMap (Event t a)))
165161 fanInt (Event_Profiled e) = coerce $ fanInt $ profileEvent e
166162
167163deriving instance Functor (Dynamic t) => Functor (Dynamic (ProfiledTimeline t))
src/Reflex/Pure.hs+3−5
@@ -7,7 +7,6 @@
77{-# LANGUAGE TypeFamilies #-}
88{-# LANGUAGE RankNTypes #-}
99{-# LANGUAGE PolyKinds #-}
10−
1110#ifdef USE_REFLEX_OPTIMIZER
1211{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
1312#endif
@@ -34,6 +33,7 @@ module Reflex.Pure
3433import Control.Monad
3534import Data.Dependent.Map (DMap, GCompare)
3635import qualified Data.Dependent.Map as DMap
36+import Data.Functor.Identity
3737import Data.IntMap (IntMap)
3838import qualified Data.IntMap as IntMap
3939import Data.Maybe
@@ -88,9 +88,8 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
8888 then Nothing
8989 else Just currentOccurrences
9090
91−-- The instance signature doeesn't compile, leave commented for documentation
92−-- fanG :: GCompare k => Event (Pure t) (DMap k v) -> EventSelectorG (Pure t) k v
93− fanG e = EventSelectorG $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k
91+ fan :: GCompare k => Event (Pure t) (DMap k Identity) -> EventSelector (Pure t) k
92+ fan e = EventSelector $ \k -> Event $ \t -> unEvent e t >>= fmap runIdentity . DMap.lookup k
9493
9594 switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a
9695 switch b = Event $ memo $ \t -> unEvent (unBehavior b t) t
@@ -129,7 +128,6 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
129128 behaviorCoercion Coercion = Coercion
130129 eventCoercion Coercion = Coercion
131130 dynamicCoercion Coercion = Coercion
132− incrementalCoercion Coercion Coercion = Coercion
133131
134132 fanInt e = EventSelectorInt $ \k -> Event $ \t -> unEvent e t >>= IntMap.lookup k
135133
src/Reflex/Spider/Internal.hs+114−141
@@ -17,10 +17,7 @@
1717{-# LANGUAGE TypeOperators #-}
1818{-# LANGUAGE UndecidableInstances #-}
1919{-# LANGUAGE PolyKinds #-}
20−{-# LANGUAGE DeriveFunctor #-}
21−{-# LANGUAGE StandaloneDeriving #-}
2220{-# LANGUAGE InstanceSigs #-}
23−
2421#ifdef USE_REFLEX_OPTIMIZER
2522{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
2623#endif
@@ -38,10 +35,7 @@ import Control.Monad hiding (forM, forM_, mapM, mapM_)
3835import Control.Monad.Exception
3936import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_)
4037import Control.Monad.Primitive
41−--import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_)
42−import Control.Monad.Reader.Class
43−import Control.Monad.IO.Class
44−import Control.Monad.ReaderIO
38+import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_)
4539import Control.Monad.Ref
4640import Data.Align
4741import Data.Coerce
@@ -211,6 +205,12 @@ nextNodeIdRef = unsafePerformIO $ newIORef 1
211205
212206newNodeId :: IO Int
213207newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)
208+
209+{-# NOINLINE unsafeNodeId #-}
210+unsafeNodeId :: a -> Int
211+unsafeNodeId a = unsafePerformIO $ do
212+ touch a
213+ newNodeId
214214#endif
215215
216216--------------------------------------------------------------------------------
@@ -314,10 +314,9 @@ cacheEvent e =
314314#else
315315 Event $
316316#endif
317− unsafePerformIO $ do
318− mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
319− <- newIORef emptyFastWeak
320− pure $ \sub -> {-# SCC "cacheEvent" #-} do
317+ let mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))
318+ !mSubscribedRef = unsafeNewIORef e emptyFastWeak
319+ in \sub -> {-# SCC "cacheEvent" #-} do
321320#ifdef DEBUG_TRACE_EVENTS
322321 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite
323322#endif
@@ -383,7 +382,7 @@ eventRoot !k !r = Event $ wrap eventSubscribedRoot $ liftIO . getRootSubscribed
383382eventNever :: Event x a
384383eventNever = Event $ \_ -> return (EventSubscription (return ()) eventSubscribedNever, Nothing)
385384
386−eventFan :: (GCompare k, HasSpiderTimeline x) => k a -> Fan x k v -> Event x (v a)
385+eventFan :: (GCompare k, HasSpiderTimeline x) => k a -> Fan x k -> Event x a
387386eventFan !k !f = Event $ wrap eventSubscribedFan $ getFanSubscribed k f
388387
389388eventSwitch :: HasSpiderTimeline x => Switch x a -> Event x a
@@ -435,14 +434,14 @@ newSubscriberHold h = return $ Subscriber
435434 , subscriberRecalculateHeight = \_ -> return ()
436435 }
437436
438−newSubscriberFan :: forall x k v. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k v -> IO (Subscriber x (DMap k v))
437+newSubscriberFan :: forall x k. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k -> IO (Subscriber x (DMap k Identity))
439438newSubscriberFan subscribed = return $ Subscriber
440439 { subscriberPropagate = \a -> {-# SCC "traverseFan" #-} do
441440 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
442441 tracePropagate (Proxy :: Proxy x) $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
443442 liftIO $ writeIORef (fanSubscribedOccurrence subscribed) $ Just a
444443 scheduleClear $ fanSubscribedOccurrence subscribed
445− let f _ (Pair v subsubs) = do
444+ let f _ (Pair (Identity v) subsubs) = do
446445 propagate v $ _fanSubscribedChildren_list subsubs
447446 return $ Constant ()
448447 _ <- DMap.traverseWithKey f $ DMap.intersectionWithKey (\_ -> Pair) a subs --TODO: Would be nice to have DMap.traverse_
@@ -558,11 +557,6 @@ propagateFast a subscribers = withIncreasedDepth $ do
558557toAny :: a -> Any
559558toAny = unsafeCoerce
560559
561−-- Why do we use Any here, instead of just giving eventSubscribedRetained an
562−-- existential type? Sadly, GHC does not currently know how to unbox types
563−-- with existentially quantified fields. So instead we just coerce values
564−-- to type Any on the way in. Since we never coerce them back, this is
565−-- perfectly safe.
566560data EventSubscribed x = EventSubscribed
567561 { eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)
568562 , eventSubscribedRetained :: {-# NOUNPACK #-} !Any
@@ -595,7 +589,7 @@ eventSubscribedNever = EventSubscribed
595589#endif
596590 }
597591
598−eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x
592+eventSubscribedFan :: FanSubscribed x k -> EventSubscribed x
599593eventSubscribedFan !subscribed = EventSubscribed
600594 { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed
601595 , eventSubscribedRetained = toAny subscribed
@@ -686,7 +680,7 @@ behaviorPull !p = Behavior $ do
686680 wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorPull"
687681 parentsRef <- liftIO $ newIORef []
688682 holdInits <- askBehaviorHoldInits
689− a <- liftIO $ runReaderIO (unBehaviorM $ pullCompute p) (Just (wi, parentsRef), holdInits)
683+ a <- liftIO $ runReaderT (unBehaviorM $ pullCompute p) (Just (wi, parentsRef), holdInits)
690684 invsRef <- liftIO . newIORef . maybeToList =<< askInvalidator
691685 parents <- liftIO $ readIORef parentsRef
692686 let subscribed = PullSubscribed
@@ -721,46 +715,42 @@ readBehaviorUntracked b = do
721715-- Dynamic
722716--------------------------------------------------------------------------------
723717
724−type DynamicS x p = Dynamic x (PatchTarget p) p
725−
726−data Dynamic x target p = Dynamic
727− { dynamicCurrent :: !(Behavior x target)
718+data Dynamic x p = Dynamic
719+ { dynamicCurrent :: !(Behavior x (PatchTarget p))
728720 , dynamicUpdated :: Event x p -- This must be lazy; see the comment on holdEvent --TODO: Would this let us eliminate `Dyn`?
729721 }
730722
731−deriving instance (HasSpiderTimeline x) => Functor (Dynamic x target)
732−
733−
734−
735−
736−dynamicHold :: Hold x p -> DynamicS x p
723+dynamicHold :: Hold x p -> Dynamic x p
737724dynamicHold !h = Dynamic
738725 { dynamicCurrent = behaviorHold h
739726 , dynamicUpdated = eventHold h
740727 }
741728
742−dynamicHoldIdentity :: Hold x (Identity a) -> DynamicS x (Identity a)
729+dynamicHoldIdentity :: Hold x (Identity a) -> Dynamic x (Identity a)
743730dynamicHoldIdentity = dynamicHold
744731
745−dynamicConst :: PatchTarget p -> DynamicS x p
732+dynamicConst :: PatchTarget p -> Dynamic x p
746733dynamicConst !a = Dynamic
747734 { dynamicCurrent = behaviorConst a
748735 , dynamicUpdated = eventNever
749736 }
750737
751−dynamicDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> DynamicS x p
738+dynamicDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> Dynamic x p
752739dynamicDyn !d = Dynamic
753740 { dynamicCurrent = behaviorDyn d
754741 , dynamicUpdated = eventDyn d
755742 }
756743
757−dynamicDynIdentity :: HasSpiderTimeline x => Dyn x (Identity a) -> DynamicS x (Identity a)
744+dynamicDynIdentity :: HasSpiderTimeline x => Dyn x (Identity a) -> Dynamic x (Identity a)
758745dynamicDynIdentity = dynamicDyn
759746
760747--------------------------------------------------------------------------------
761748-- Combinators
762749--------------------------------------------------------------------------------
763750
751+--TODO: Figure out why certain things are not 'representational', then make them
752+--representational so we can use coerce
753+
764754--type role Hold representational
765755data Hold x p
766756 = Hold { holdValue :: !(IORef (PatchTarget p))
@@ -781,25 +771,20 @@ globalSpiderTimelineEnv = unsafePerformIO unsafeNewSpiderTimelineEnv
781771
782772-- | Stores all global data relevant to a particular Spider timeline; only one
783773-- value should exist for each type @x@
784−newtype SpiderTimelineEnv x = STE {unSTE :: SpiderTimelineEnv' x}
785−-- We implement SpiderTimelineEnv with a newtype wrapper so
786−-- we can get the coercions we want safely.
787−type role SpiderTimelineEnv nominal
788−
789−data SpiderTimelineEnv' x = SpiderTimelineEnv
774+data SpiderTimelineEnv x = SpiderTimelineEnv
790775 { _spiderTimeline_lock :: {-# UNPACK #-} !(MVar ())
791776 , _spiderTimeline_eventEnv :: {-# UNPACK #-} !(EventEnv x)
792777#ifdef DEBUG
793778 , _spiderTimeline_depth :: {-# UNPACK #-} !(IORef Int)
794779#endif
795780 }
796−type role SpiderTimelineEnv' phantom
781+type role SpiderTimelineEnv nominal
797782
798783instance Eq (SpiderTimelineEnv x) where
799784 _ == _ = True -- Since only one exists of each type
800785
801786instance GEq SpiderTimelineEnv where
802− a `geq` b = if _spiderTimeline_lock (unSTE a) == _spiderTimeline_lock (unSTE b)
787+ a `geq` b = if _spiderTimeline_lock a == _spiderTimeline_lock b
803788 then Just $ unsafeCoerce Refl -- This unsafeCoerce is safe because the same SpiderTimelineEnv can't have two different 'x' arguments
804789 else Nothing
805790
@@ -822,7 +807,7 @@ runEventM :: EventM x a -> IO a
822807runEventM = unEventM
823808
824809asksEventEnv :: forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a
825−asksEventEnv f = return $ f $ _spiderTimeline_eventEnv (unSTE (spiderTimeline :: SpiderTimelineEnv x))
810+asksEventEnv f = return $ f $ _spiderTimeline_eventEnv (spiderTimeline :: SpiderTimelineEnv x)
826811
827812class MonadIO m => Defer a m where
828813 getDeferralQueue :: m (IORef [a])
@@ -960,9 +945,9 @@ getHoldEventSubscription h = do
960945
961946type BehaviorEnv x = (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]), IORef [SomeHoldInit x])
962947
948+--type role BehaviorM representational
963949-- BehaviorM can sample behaviors
964−newtype BehaviorM x a = BehaviorM { unBehaviorM :: ReaderIO (BehaviorEnv x) a }
965− deriving (Functor, Applicative, MonadIO, MonadFix, MonadReader (BehaviorEnv x))
950+newtype BehaviorM x a = BehaviorM { unBehaviorM :: ReaderT (BehaviorEnv x) IO a } deriving (Functor, Applicative, MonadIO, MonadFix)
966951
967952instance Monad (BehaviorM x) where
968953 {-# INLINE (>>=) #-}
@@ -1013,7 +998,7 @@ data RootSubscribed x a = forall k. GCompare k => RootSubscribed
1013998#endif
1014999 }
10151000
1016−data Root x k
1001+data Root x (k :: * -> *)
10171002 = Root { rootOccurrence :: !(IORef (DMap k Identity)) -- The currently-firing occurrence of this event
10181003 , rootSubscribed :: !(IORef (DMap k (RootSubscribed x)))
10191004 , rootInit :: !(forall a. k a -> RootTrigger x a -> IO (IO ()))
@@ -1083,25 +1068,25 @@ heightBagVerify b@(HeightBag s c) = if
10831068heightBagVerify = id
10841069#endif
10851070
1086−data FanSubscribedChildren x k v a = FanSubscribedChildren
1087− { _fanSubscribedChildren_list :: !(WeakBag (Subscriber x (v a)))
1088− , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k v)
1089− , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k v)))
1071+data FanSubscribedChildren (x :: *) k a = FanSubscribedChildren
1072+ { _fanSubscribedChildren_list :: !(WeakBag (Subscriber x a))
1073+ , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k)
1074+ , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k)))
10901075 }
10911076
1092−data FanSubscribed x k v
1093− = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))
1094− , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k v)))
1095− , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k v))) -- This DMap should never be empty
1077+data FanSubscribed (x :: *) k
1078+ = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k)))
1079+ , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))
1080+ , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k))) -- This DMap should never be empty
10961081 , fanSubscribedParent :: !(EventSubscription x)
10971082#ifdef DEBUG_NODEIDS
10981083 , fanSubscribedNodeId :: Int
10991084#endif
11001085 }
11011086
1102−data Fan x k v
1103− = Fan { fanParent :: !(Event x (DMap k v))
1104− , fanSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))
1087+data Fan x k
1088+ = Fan { fanParent :: !(Event x (DMap k Identity))
1089+ , fanSubscribed :: !(IORef (Maybe (FanSubscribed x k)))
11051090 }
11061091
11071092data SwitchSubscribed x a
@@ -1179,11 +1164,11 @@ data DynType x p = UnsafeDyn !(BehaviorM x (PatchTarget p), Event x p)
11791164
11801165newtype Dyn (x :: Type) p = Dyn { unDyn :: IORef (DynType x p) }
11811166
1182−newMapDyn :: HasSpiderTimeline x => (a -> b) -> DynamicS x (Identity a) -> DynamicS x (Identity b)
1167+newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)
11831168newMapDyn f d = dynamicDynIdentity $ unsafeBuildDynamic (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)
11841169
11851170--TODO: Avoid the duplication between this and R.zipDynWith
1186−zipDynWith :: HasSpiderTimeline x => (a -> b -> c) -> DynamicS x (Identity a) -> DynamicS x (Identity b) -> DynamicS x (Identity c)
1171+zipDynWith :: HasSpiderTimeline x => (a -> b -> c) -> Dynamic x (Identity a) -> Dynamic x (Identity b) -> Dynamic x (Identity c)
11871172zipDynWith f da db =
11881173 let eab = align (dynamicUpdated da) (dynamicUpdated db)
11891174 ec = flip push eab $ \o -> do
@@ -1206,12 +1191,18 @@ buildDynamic readV0 v' = do
12061191 return d
12071192
12081193unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p
1209−unsafeBuildDynamic readV0 v' =
1210− Dyn $ unsafePerformIO $ newIORef $ UnsafeDyn (readV0, v')
1194+unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ UnsafeDyn x
1195+ where x = (readV0, v')
12111196
12121197-- ResultM can read behaviors and events
12131198type ResultM = EventM
12141199
1200+{-# NOINLINE unsafeNewIORef #-}
1201+unsafeNewIORef :: a -> b -> IORef b
1202+unsafeNewIORef a b = unsafePerformIO $ do
1203+ touch a
1204+ newIORef b
1205+
12151206instance HasSpiderTimeline x => Functor (Event x) where
12161207 fmap f = push $ return . Just . f
12171208
@@ -1224,42 +1215,33 @@ push f e = cacheEvent (pushCheap f e)
12241215
12251216{-# INLINABLE pull #-}
12261217pull :: BehaviorM x a -> Behavior x a
1227−pull a = unsafePerformIO $ do
1228− ref <- newIORef Nothing
1218+pull a = behaviorPull $ Pull
1219+ { pullCompute = a
1220+ , pullValue = unsafeNewIORef a Nothing
12291221#ifdef DEBUG_NODEIDS
1230− nid <- newNodeId
1222+ , pullNodeId = unsafeNodeId a
12311223#endif
1232− pure $ behaviorPull $ Pull
1233− { pullCompute = a
1234− , pullValue = ref
1235−#ifdef DEBUG_NODEIDS
1236− , pullNodeId = nid
1237−#endif
1238− }
1224+ }
12391225
12401226{-# INLINABLE switch #-}
12411227switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a
1242−switch a = unsafePerformIO $ do
1243− ref <- newIORef Nothing
1244− pure $ eventSwitch $ Switch
1245− { switchParent = a
1246− , switchSubscribed = ref
1247− }
1228+switch a = eventSwitch $ Switch
1229+ { switchParent = a
1230+ , switchSubscribed = unsafeNewIORef a Nothing
1231+ }
12481232
12491233coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a
1250−coincidence a = unsafePerformIO $ do
1251− ref <- newIORef Nothing
1252− pure $ eventCoincidence $ Coincidence
1253− { coincidenceParent = a
1254− , coincidenceSubscribed = ref
1255− }
1234+coincidence a = eventCoincidence $ Coincidence
1235+ { coincidenceParent = a
1236+ , coincidenceSubscribed = unsafeNewIORef a Nothing
1237+ }
12561238
12571239-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
12581240run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b
12591241run roots after = do
12601242 tracePropagate (Proxy :: Proxy x) $ "Running an event frame with " <> show (length roots) <> " events"
12611243 let t = spiderTimeline :: SpiderTimelineEnv x
1262− result <- SpiderHost $ withMVar (_spiderTimeline_lock (unSTE t)) $ \_ -> unSpiderHost $ runFrame $ do
1244+ result <- SpiderHost $ withMVar (_spiderTimeline_lock t) $ \_ -> unSpiderHost $ runFrame $ do
12631245 rootsToPropagate <- forM roots $ \r@(RootTrigger (_, occRef, k) :=> a) -> do
12641246 occBefore <- liftIO $ do
12651247 occBefore <- readIORef occRef
@@ -1323,9 +1305,9 @@ type WeakList a = [Weak a]
13231305withIncreasedDepth :: CanTrace x m => m a -> m a
13241306withIncreasedDepth a = do
13251307 spiderTimeline <- askSpiderTimelineEnv
1326− liftIO $ modifyIORef' (_spiderTimeline_depth (unSTE spiderTimeline)) succ
1308+ liftIO $ modifyIORef' (_spiderTimeline_depth spiderTimeline) succ
13271309 result <- a
1328− liftIO $ modifyIORef' (_spiderTimeline_depth (unSTE spiderTimeline)) pred
1310+ liftIO $ modifyIORef' (_spiderTimeline_depth spiderTimeline) pred
13291311 return result
13301312#else
13311313withIncreasedDepth :: m a -> m a
@@ -1352,7 +1334,7 @@ traceMWhen _ b getMessage = when b $ do
13521334 message <- getMessage
13531335#ifdef DEBUG
13541336 spiderTimeline <- askSpiderTimelineEnv
1355− d <- liftIO $ readIORef $ _spiderTimeline_depth $ unSTE spiderTimeline
1337+ d <- liftIO $ readIORef $ _spiderTimeline_depth spiderTimeline
13561338#else
13571339 let d = 0
13581340#endif
@@ -1393,25 +1375,25 @@ propagateSubscriberHold h a = do
13931375data SomeResetCoincidence x = forall a. SomeResetCoincidence !(EventSubscription x) !(Maybe (CoincidenceSubscribed x a)) -- The CoincidenceSubscriber will be present only if heights need to be reset
13941376
13951377runBehaviorM :: BehaviorM x a -> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]) -> IORef [SomeHoldInit x] -> IO a
1396−runBehaviorM a mwi holdInits = runReaderIO (unBehaviorM a) (mwi, holdInits)
1378+runBehaviorM a mwi holdInits = runReaderT (unBehaviorM a) (mwi, holdInits)
13971379
13981380askInvalidator :: BehaviorM x (Maybe (Weak (Invalidator x)))
13991381askInvalidator = do
1400− (!m, _) <- ask
1382+ (!m, _) <- BehaviorM ask
14011383 case m of
14021384 Nothing -> return Nothing
14031385 Just (!wi, _) -> return $ Just wi
14041386
14051387askParentsRef :: BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x]))
14061388askParentsRef = do
1407− (!m, _) <- ask
1389+ (!m, _) <- BehaviorM ask
14081390 case m of
14091391 Nothing -> return Nothing
14101392 Just (_, !p) -> return $ Just p
14111393
14121394askBehaviorHoldInits :: BehaviorM x (IORef [SomeHoldInit x])
14131395askBehaviorHoldInits = do
1414− (_, !his) <- ask
1396+ (_, !his) <- BehaviorM ask
14151397 return his
14161398
14171399{-# INLINE getDynHold #-}
@@ -1456,9 +1438,6 @@ getRootSubscribed k r sub = do
14561438 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"
14571439 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)
14581440 writeIORef uninitRef $! uninit
1459−#ifdef DEBUG_NODEIDS
1460− nid <- newNodeId
1461−#endif
14621441 let !subscribed = RootSubscribed
14631442 { rootSubscribedKey = k
14641443 , rootSubscribedCachedSubscribed = cached
@@ -1467,7 +1446,7 @@ getRootSubscribed k r sub = do
14671446 , rootSubscribedUninit = uninit
14681447 , rootSubscribedWeakSelf = weakSelf
14691448#ifdef DEBUG_NODEIDS
1470− , rootSubscribedNodeId = nid
1449+ , rootSubscribedNodeId = unsafeNodeId (k, r, subs)
14711450#endif
14721451 }
14731452 -- If we die at the same moment that all our children die, they will
@@ -1516,10 +1495,16 @@ newFanInt = do
15161495 , _fanInt_occRef = occRef
15171496 }
15181497
1498+{-# NOINLINE unsafeNewFanInt #-}
1499+unsafeNewFanInt :: b -> FanInt x a
1500+unsafeNewFanInt b = unsafePerformIO $ do
1501+ touch b
1502+ newFanInt
1503+
15191504fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a
1520−fanInt p = unsafePerformIO $ do
1521− self <- newFanInt
1522− pure $ EventSelectorInt $ \k -> Event $ \sub -> do
1505+fanInt p =
1506+ let self = unsafeNewFanInt p
1507+ in EventSelectorInt $ \k -> Event $ \sub -> do
15231508 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)
15241509 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input
15251510 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber
@@ -1555,7 +1540,7 @@ fanInt p = unsafePerformIO $ do
15551540 return (EventSubscription (FastWeakBag.remove t) $! EventSubscribed heightRef $! toAny (_fanInt_subscriptionRef self, t), IntMap.lookup k currentOcc)
15561541
15571542{-# INLINABLE getFanSubscribed #-}
1558−getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k v -> Subscriber x (v a) -> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))
1543+getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket, FanSubscribed x k, Maybe a)
15591544getFanSubscribed k f sub = do
15601545 mSubscribed <- liftIO $ readIORef $ fanSubscribed f
15611546 case mSubscribed of
@@ -1573,16 +1558,13 @@ getFanSubscribed k f sub = do
15731558 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"
15741559 occRef <- liftIO $ newIORef parentOcc
15751560 when (isJust parentOcc) $ scheduleClear occRef
1576−#ifdef DEBUG_NODEIDS
1577− nid <- liftIO newNodeId
1578−#endif
15791561 let subscribed = FanSubscribed
15801562 { fanSubscribedCachedSubscribed = fanSubscribed f
15811563 , fanSubscribedOccurrence = occRef
15821564 , fanSubscribedParent = subscription
15831565 , fanSubscribedSubscribers = subscribersRef
15841566#ifdef DEBUG_NODEIDS
1585− , fanSubscribedNodeId = nid
1567+ , fanSubscribedNodeId = unsafeNodeId f
15861568#endif
15871569 }
15881570 let !self = (k, subscribed)
@@ -1592,7 +1574,7 @@ getFanSubscribed k f sub = do
15921574 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed
15931575 return (slnForSub, subscribed, coerce $ DMap.lookup k =<< parentOcc)
15941576
1595−cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k v) -> IO ()
1577+cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k) -> IO ()
15961578cleanupFanSubscribed (k, subscribed) = do
15971579 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
15981580 let reducedSubscribers = DMap.delete k subscribers
@@ -1604,7 +1586,7 @@ cleanupFanSubscribed (k, subscribed) = do
16041586 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers
16051587
16061588{-# INLINE subscribeFanSubscribed #-}
1607−subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k v -> Subscriber x (v a) -> IO WeakBagTicket
1589+subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> Subscriber x a -> IO WeakBagTicket
16081590subscribeFanSubscribed k subscribed sub = do
16091591 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
16101592 case DMap.lookup k subscribers of
@@ -1642,9 +1624,6 @@ getSwitchSubscribed s sub = do
16421624 when (isJust parentOcc) $ scheduleClear occRef
16431625 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"
16441626 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed
1645−#ifdef DEBUG_NODEIDS
1646− nid <- liftIO newNodeId
1647−#endif
16481627 let !subscribed = SwitchSubscribed
16491628 { switchSubscribedCachedSubscribed = switchSubscribed s
16501629 , switchSubscribedOccurrence = occRef
@@ -1657,7 +1636,7 @@ getSwitchSubscribed s sub = do
16571636 , switchSubscribedCurrentParent = subscriptionRef
16581637 , switchSubscribedWeakSelf = weakSelf
16591638#ifdef DEBUG_NODEIDS
1660− , switchSubscribedNodeId = nid
1639+ , switchSubscribedNodeId = unsafeNodeId s
16611640#endif
16621641 }
16631642 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"
@@ -1702,9 +1681,6 @@ getCoincidenceSubscribed c sub = do
17021681 scheduleClear innerSubdRef
17031682 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"
17041683 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed
1705−#ifdef DEBUG_NODEIDS
1706− nid <- liftIO newNodeId
1707−#endif
17081684 let subscribed = CoincidenceSubscribed
17091685 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c
17101686 , coincidenceSubscribedOccurrence = occRef
@@ -1715,7 +1691,7 @@ getCoincidenceSubscribed c sub = do
17151691 , coincidenceSubscribedInnerParent = innerSubdRef
17161692 , coincidenceSubscribedWeakSelf = weakSelf
17171693#ifdef DEBUG_NODEIDS
1718− , coincidenceSubscribedNodeId = nid
1694+ , coincidenceSubscribedNodeId = unsafeNodeId c
17191695#endif
17201696 }
17211697 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"
@@ -1735,20 +1711,20 @@ subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceS
17351711{-# INLINE mergeG #-}
17361712mergeG :: forall k q x v. (HasSpiderTimeline x, GCompare k)
17371713 => (forall a. q a -> Event x (v a))
1738− -> DynamicS x (PatchDMap k q) -> Event x (DMap k v)
1714+ -> Dynamic x (PatchDMap k q) -> Event x (DMap k v)
17391715mergeG nt d = cacheEvent (mergeCheap nt d)
17401716
17411717{-# INLINE mergeWithMove #-}
17421718mergeWithMove :: forall k v q x. (HasSpiderTimeline x, GCompare k)
17431719 => (forall a. q a -> Event x (v a))
1744− -> DynamicS x (PatchDMapWithMove k q) -> Event x (DMap k v)
1720+ -> Dynamic x (PatchDMapWithMove k q) -> Event x (DMap k v)
17451721mergeWithMove nt d = cacheEvent (mergeCheapWithMove nt d)
17461722
17471723{-# INLINE [1] mergeCheap #-}
17481724mergeCheap
17491725 :: forall k x q v. (HasSpiderTimeline x, GCompare k)
17501726 => (forall a. q a -> Event x (v a))
1751− -> DynamicS x (PatchDMap k q)
1727+ -> Dynamic x (PatchDMap k q)
17521728 -> Event x (DMap k v)
17531729mergeCheap nt = mergeGCheap' getInitialSubscribers updateMe destroy
17541730 where
@@ -1788,7 +1764,7 @@ mergeCheap nt = mergeGCheap' getInitialSubscribers updateMe destroy
17881764{-# INLINE [1] mergeCheapWithMove #-}
17891765mergeCheapWithMove :: forall k x v q. (HasSpiderTimeline x, GCompare k)
17901766 => (forall a. q a -> Event x (v a))
1791− -> DynamicS x (PatchDMapWithMove k q)
1767+ -> Dynamic x (PatchDMapWithMove k q)
17921768 -> Event x (DMap k v)
17931769mergeCheapWithMove nt = mergeGCheap' getInitialSubscribers updateMe destroy
17941770 where
@@ -1936,7 +1912,7 @@ updateMerge m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m)
19361912
19371913{-# INLINE mergeGCheap' #-}
19381914mergeGCheap' :: forall k v x p s q. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k q)
1939− => MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> DynamicS x p -> Event x (DMap k v)
1915+ => MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> Dynamic x p -> Event x (DMap k v)
19401916mergeGCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do
19411917 initialParents <- readBehaviorUntracked $ dynamicCurrent d
19421918 accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"
@@ -1985,11 +1961,11 @@ mergeGCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do
19851961 , occ
19861962 )
19871963
1988−mergeInt :: forall x a. (HasSpiderTimeline x) => DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
1964+mergeInt :: forall x a. (HasSpiderTimeline x) => Dynamic x (PatchIntMap (Event x a)) -> Event x (IntMap a)
19891965mergeInt = cacheEvent . mergeIntCheap
19901966
19911967{-# INLINABLE mergeIntCheap #-}
1992−mergeIntCheap :: forall x a. (HasSpiderTimeline x) => DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a)
1968+mergeIntCheap :: forall x a. (HasSpiderTimeline x) => Dynamic x (PatchIntMap (Event x a)) -> Event x (IntMap a)
19931969mergeIntCheap d = Event $ \sub -> do
19941970 initialParents <- readBehaviorUntracked $ dynamicCurrent d
19951971 accum <- liftIO $ FastMutableIntMap.newEmpty
@@ -2086,16 +2062,14 @@ mergeIntCheap d = Event $ \sub -> do
20862062 )
20872063
20882064newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a }
2089−newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }
20902065
2091−fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v
2092−fanG e = unsafePerformIO $ do
2093− ref <- newIORef Nothing
2066+fan :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k Identity) -> EventSelector x k
2067+fan e =
20942068 let f = Fan
20952069 { fanParent = e
2096− , fanSubscribed = ref
2070+ , fanSubscribed = unsafeNewIORef e Nothing
20972071 }
2098− pure $ EventSelectorG $ \k -> eventFan k f
2072+ in EventSelector $ \k -> eventFan k f
20992073
21002074runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()
21012075runHoldInits holdInitRef dynInitRef mergeInitRef = do
@@ -2149,7 +2123,7 @@ clearEventEnv (EventEnv toAssignRef holdInitRef dynInitRef mergeUpdateRef mergeI
21492123-- | Run an event action outside of a frame
21502124runFrame :: forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a --TODO: This function also needs to hold the mutex
21512125runFrame a = SpiderHost $ do
2152− let env = _spiderTimeline_eventEnv $ unSTE (spiderTimeline :: SpiderTimelineEnv x)
2126+ let env = _spiderTimeline_eventEnv (spiderTimeline :: SpiderTimelineEnv x)
21532127 let go = do
21542128 result <- a
21552129 runHoldInits (eventEnvHoldInits env) (eventEnvDynInits env) (eventEnvMergeInits env) -- This must happen before doing the assignments, in case subscribing a Hold causes existing Holds to be read by the newly-propagated events
@@ -2360,7 +2334,7 @@ instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x))
23602334 fail _ = error "Dynamic does not support 'fail'"
23612335
23622336{-# INLINABLE newJoinDyn #-}
2363−newJoinDyn :: HasSpiderTimeline x => DynamicS x (Identity (DynamicS x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)
2337+newJoinDyn :: HasSpiderTimeline x => Reflex.Spider.Internal.Dynamic x (Identity (Reflex.Spider.Internal.Dynamic x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)
23642338newJoinDyn d =
23652339 let readV0 = readBehaviorTracked . dynamicCurrent =<< readBehaviorTracked (dynamicCurrent d)
23662340 eOuter = Reflex.Spider.Internal.push (fmap (Just . Identity) . readBehaviorUntracked . dynamicCurrent . runIdentity) $ dynamicUpdated d
@@ -2510,7 +2484,7 @@ unsafeNewSpiderTimelineEnv = do
25102484#ifdef DEBUG
25112485 depthRef <- newIORef 0
25122486#endif
2513− return $ STE $ SpiderTimelineEnv
2487+ return $ SpiderTimelineEnv
25142488 { _spiderTimeline_lock = lock
25152489 , _spiderTimeline_eventEnv = env
25162490#ifdef DEBUG
@@ -2526,13 +2500,13 @@ data LocalSpiderTimeline (x :: Type) s
25262500
25272501instance Reifies s (SpiderTimelineEnv x) =>
25282502 HasSpiderTimeline (LocalSpiderTimeline x s) where
2529− spiderTimeline = localSpiderTimeline Proxy $ reflect (Proxy :: Proxy s)
2503+ spiderTimeline = localSpiderTimeline (Proxy :: Proxy s) $ reflect (Proxy :: Proxy s)
25302504
25312505localSpiderTimeline
2532− :: proxy s
2506+ :: Proxy s
25332507 -> SpiderTimelineEnv x
25342508 -> SpiderTimelineEnv (LocalSpiderTimeline x s)
2535−localSpiderTimeline _ = coerce
2509+localSpiderTimeline _ = unsafeCoerce
25362510
25372511-- | Pass a new timeline to the given function.
25382512withSpiderTimeline :: (forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r) -> IO r
@@ -2550,8 +2524,8 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
25502524 {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}
25512525 newtype Behavior (SpiderTimeline x) a = SpiderBehavior { unSpiderBehavior :: Behavior x a }
25522526 newtype Event (SpiderTimeline x) a = SpiderEvent { unSpiderEvent :: Event x a }
2553− newtype Dynamic (SpiderTimeline x) a = SpiderDynamic { unSpiderDynamic :: DynamicS x (Identity a) } -- deriving (Functor, Applicative, Monad)
2554− newtype Incremental (SpiderTimeline x) p = SpiderIncremental { unSpiderIncremental :: DynamicS x p }
2527+ newtype Dynamic (SpiderTimeline x) a = SpiderDynamic { unSpiderDynamic :: Dynamic x (Identity a) } -- deriving (Functor, Applicative, Monad)
2528+ newtype Incremental (SpiderTimeline x) p = SpiderIncremental { unSpiderIncremental :: Dynamic x p }
25552529 type PullM (SpiderTimeline x) = SpiderPullM x
25562530 type PushM (SpiderTimeline x) = SpiderPushM x
25572531 {-# INLINABLE never #-}
@@ -2564,8 +2538,6 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
25642538 pushCheap f = SpiderEvent . pushCheap (coerce f) . unSpiderEvent
25652539 {-# INLINABLE pull #-}
25662540 pull = SpiderBehavior . pull . coerce
2567− {-# INLINABLE fanG #-}
2568− fanG e = R.EventSelectorG $ SpiderEvent . selectG (fanG (unSpiderEvent e))
25692541 {-# INLINABLE mergeG #-}
25702542 mergeG
25712543 :: forall (k :: k2 -> *) q (v :: k2 -> *). GCompare k
@@ -2573,6 +2545,8 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
25732545 -> DMap k q
25742546 -> R.Event (SpiderTimeline x) (DMap k v)
25752547 mergeG nt = SpiderEvent . mergeG (unSpiderEvent #. nt) . dynamicConst
2548+ {-# INLINABLE fan #-}
2549+ fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))
25762550 {-# INLINABLE switch #-}
25772551 switch = SpiderEvent . switch . (coerce :: Behavior x (R.Event (SpiderTimeline x) a) -> Behavior x (Event x a)) . unSpiderBehavior
25782552 {-# INLINABLE coincidence #-}
@@ -2580,7 +2554,7 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
25802554 {-# INLINABLE current #-}
25812555 current = SpiderBehavior . dynamicCurrent . unSpiderDynamic
25822556 {-# INLINABLE updated #-}
2583− updated = SpiderEvent #. dynamicUpdated .# fmap coerce . unSpiderDynamic
2557+ updated = coerce $ SpiderEvent . dynamicUpdated . unSpiderDynamic
25842558 {-# INLINABLE unsafeBuildDynamic #-}
25852559 unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'
25862560 {-# INLINABLE unsafeBuildIncremental #-}
@@ -2599,10 +2573,9 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where
25992573 return $ Identity <$> apply p c --TODO: Avoid the redundant 'apply'
26002574 eventCoercion Coercion = Coercion
26012575 behaviorCoercion Coercion = Coercion
2602− dynamicCoercion Coercion = Coercion
2603− incrementalCoercion Coercion Coercion = Coercion
2576+ dynamicCoercion = unsafeCoerce --TODO: How can we avoid this unsafeCoerce? This is safe only because we know how Identity works as a Patch instance
26042577 {-# INLINABLE mergeIntIncremental #-}
2605− mergeIntIncremental = SpiderEvent . mergeInt . coerce
2578+ mergeIntIncremental = SpiderEvent . mergeInt . (unsafeCoerce :: Dynamic x (PatchIntMap (R.Event (SpiderTimeline x) a)) -> Dynamic x (PatchIntMap (Event x a))) . unSpiderIncremental
26062579 {-# INLINABLE fanInt #-}
26072580 fanInt e = R.EventSelectorInt $ SpiderEvent . selectInt (fanInt (unSpiderEvent e))
26082581
test/GC.hs+2−2
@@ -56,8 +56,8 @@ hostPerf ref = S.runSpiderHost $ do
5656 { S.subscriberPropagate = S.subscriberPropagate sub
5757 }
5858 return (s, o))
59− $ runIdentity . runIdentity <$> S.selectG
60− (S.fanG $ S.pushCheap (return . Just . mapKeyValuePairsMonotonic (\(t :=> e) -> WrapArg t :=> Identity e)) response)
59+ $ runIdentity <$> S.select
60+ (S.fan $ S.pushCheap (return . Just . mapKeyValuePairsMonotonic (\(t :=> e) -> WrapArg t :=> Identity e)) response)
6161 (WrapArg Request)
6262 return $ alignWith (mergeThese (<>))
6363 (flip S.pushCheap eadd $ \_ -> return $ Just $ DMap.singleton Request $ do
test/Reflex/Bench/Focused.hs−12
@@ -130,16 +130,6 @@ mapDynChain = iterM (return . fmap (+1))
130130joinDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
131131joinDynChain = iterM (\d -> return $ join $ fmap (const d) d)
132132
133−holdDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
134−holdDynChain = iterM (\d -> sample (current d) >>= flip holdDyn (updated d))
135−
136−buildDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
137−buildDynChain = iterM (\d -> do
138− let b = fmap (+1) (current d)
139− e = fmap (*2) (updated d)
140− buildDynamic (sample b) e)
141−
142−
143133combineDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
144134combineDynChain = iterM (\d -> return $ zipDynWith (+) d d)
145135
@@ -318,8 +308,6 @@ dynamics :: Word -> [(String, TestCase)]
318308dynamics n =
319309 [ testE "mapDynChain" $ fmap updated $ mapDynChain n =<< d
320310 , testE "joinDynChain" $ fmap updated $ joinDynChain n =<< d
321− , testE "holdDynChain" $ fmap updated $ holdDynChain n =<< d
322− , testE "buildDynChain" $ fmap updated $ buildDynChain n =<< d
323311 , testE "combineDynChain" $ fmap updated $ combineDynChain n =<< d
324312 , testE "dense mergeTree" $ fmap (updated . mergeTreeDyn 8) dense
325313 , testE "sparse mergeTree" $ fmap (updated . mergeTreeDyn 8) sparse