git.iko.soy/reflex
on develop help sign in
Merge pull request #41 from ryantrinkle/cale-develop-new-dmap

new DMap

commitd5acd55246097af18a361cb9124dc64e3c6b9607 authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 18 Jan 2016, 00:32 (11 years ago) parentd269720e6142cd
9 files changed+127−113
compare with develop
unifiedsplit
default.nix+1−1 reflex.cabal+3−3 src/Data/Functor/Misc.hs+26−25 src/Reflex/Class.hs+20−16 src/Reflex/Dynamic.hs+22−17 src/Reflex/Host/Class.hs+5−4 src/Reflex/Spider/Internal.hs+44−41 test/Reflex/Pure.hs+4−4 test/Reflex/Test/CrossImpl.hs+2−2
default.nix+1−1
@@ -4,7 +4,7 @@
44}:
55mkDerivation {
66 pname = "reflex";
7− version = "0.3.2";
7+ version = "0.4.0";
88 src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;
99 buildDepends = [
1010 dependent-map dependent-sum mtl ref-tf semigroups these exception-transformers
reflex.cabal+3−3
@@ -1,5 +1,5 @@
11Name: reflex
2−Version: 0.3.2
2+Version: 0.4.0
33Synopsis: Higher-order Functional Reactive Programming
44Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system
55License: BSD3
@@ -17,8 +17,8 @@ library
1717 hs-source-dirs: src
1818 build-depends:
1919 base >= 4.7 && < 4.9,
20− dependent-sum == 0.2.*,
21− dependent-map == 0.1.*,
20+ dependent-sum == 0.3.*,
21+ dependent-map == 0.2.*,
2222 semigroups >= 0.16 && < 0.18,
2323 mtl >= 2.1 && < 2.3,
2424 containers == 0.5.*,
src/Data/Functor/Misc.hs+26−25
@@ -8,7 +8,7 @@ import Data.Dependent.Map (DMap, DSum (..))
88import qualified Data.Dependent.Map as DMap
99import Data.Typeable hiding (Refl)
1010import Data.These
11−import Data.Maybe
11+import Control.Monad.Identity
1212
1313data WrapArg :: (k -> *) -> (k -> *) -> * -> * where
1414 WrapArg :: f a -> WrapArg g f (g a)
@@ -39,37 +39,38 @@ instance Ord k => GCompare (Const2 k v) where
3939 GT -> GGT
4040
4141{-# INLINE sequenceDmap #-}
42−sequenceDmap :: (Monad m, GCompare f) => DMap (WrapArg m f) -> m (DMap f)
43−sequenceDmap = DMap.foldrWithKey (\(WrapArg k) mv mx -> mx >>= \x -> mv >>= \v -> return $ DMap.insert k v x) (return DMap.empty)
42+sequenceDmap :: (Monad m, GCompare f) => DMap f m -> m (DMap f Identity)
43+sequenceDmap = DMap.foldrWithKey (\k mv mx -> mx >>= \x -> mv >>= \v -> return $ DMap.insert k (Identity v) x)
44+ (return DMap.empty)
4445
4546{-# INLINE combineDMapsWithKey #-}
46−combineDMapsWithKey :: forall f g h i. GCompare f => (forall a. f a -> These (g a) (h a) -> i a) -> DMap (WrapArg g f) -> DMap (WrapArg h f) -> DMap (WrapArg i f)
47+combineDMapsWithKey :: forall f g h i. GCompare f => (forall (a :: *). f a -> These (g a) (h a) -> i a) -> DMap f g -> DMap f h -> DMap f i
4748combineDMapsWithKey f mg mh = DMap.fromList $ go (DMap.toList mg) (DMap.toList mh)
48− where go :: [DSum (WrapArg g f)] -> [DSum (WrapArg h f)] -> [DSum (WrapArg i f)]
49− go [] hs = map (\(WrapArg hk :=> hv) -> WrapArg hk :=> f hk (That hv)) hs
50− go gs [] = map (\(WrapArg gk :=> gv) -> WrapArg gk :=> f gk (This gv)) gs
51− go gs@((WrapArg gk :=> gv) : gs') hs@((WrapArg hk :=> hv) : hs') = case gk `gcompare` hk of
52− GLT -> (WrapArg gk :=> f gk (This gv)) : go gs' hs
53− GEQ -> (WrapArg gk :=> f gk (These gv hv)) : go gs' hs'
54− GGT -> (WrapArg hk :=> f hk (That hv)) : go gs hs'
49+ where go :: [DSum f g] -> [DSum f h] -> [DSum f i]
50+ go [] hs = map (\(hk :=> hv) -> hk :=> f hk (That hv)) hs
51+ go gs [] = map (\(gk :=> gv) -> gk :=> f gk (This gv)) gs
52+ go gs@((gk :=> gv) : gs') hs@((hk :=> hv) : hs') = case gk `gcompare` hk of
53+ GLT -> (gk :=> f gk (This gv)) : go gs' hs
54+ GEQ -> (gk :=> f gk (These gv hv)) : go gs' hs'
55+ GGT -> (hk :=> f hk (That hv)) : go gs hs'
5556
56−wrapDMap :: (forall a. a -> f a) -> DMap k -> DMap (WrapArg f k)
57−wrapDMap f = DMap.fromDistinctAscList . map (\(k :=> v) -> WrapArg k :=> f v) . DMap.toAscList
57+wrapDMap :: (forall a. a -> f a) -> DMap k Identity -> DMap k f
58+wrapDMap f = DMap.fromDistinctAscList . map (\(k :=> Identity v) -> k :=> f v) . DMap.toAscList
5859
59−rewrapDMap :: (forall a. f a -> g a) -> DMap (WrapArg f k) -> DMap (WrapArg g k)
60−rewrapDMap f = DMap.fromDistinctAscList . map (\(WrapArg k :=> v) -> WrapArg k :=> f v) . DMap.toAscList
60+rewrapDMap :: (forall (a :: *). f a -> g a) -> DMap k f -> DMap k g
61+rewrapDMap f = DMap.fromDistinctAscList . map (\(k :=> v) -> k :=> f v) . DMap.toAscList
6162
62−unwrapDMap :: (forall a. f a -> a) -> DMap (WrapArg f k) -> DMap k
63−unwrapDMap f = DMap.fromDistinctAscList . map (\(WrapArg k :=> v) -> k :=> f v) . DMap.toAscList
63+unwrapDMap :: (forall a. f a -> a) -> DMap k f -> DMap k Identity
64+unwrapDMap f = DMap.fromDistinctAscList . map (\(k :=> v) -> k :=> Identity (f v)) . DMap.toAscList
6465
65−unwrapDMapMaybe :: (forall a. f a -> Maybe a) -> DMap (WrapArg f k) -> DMap k
66−unwrapDMapMaybe f = DMap.fromDistinctAscList . catMaybes . map (\(WrapArg k :=> v) -> fmap (k :=>) $ f v) . DMap.toAscList
66+unwrapDMapMaybe :: (forall a. f a -> Maybe a) -> DMap k f -> DMap k Identity
67+unwrapDMapMaybe f m = DMap.fromDistinctAscList [k :=> Identity w | (k :=> v) <- DMap.toAscList m, Just w <- [f v]]
6768
68−mapToDMap :: Map k v -> DMap (Const2 k v)
69−mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . Map.toAscList
69+mapToDMap :: Map k v -> DMap (Const2 k v) Identity
70+mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> Identity v) . Map.toAscList
7071
71−mapWithFunctorToDMap :: Map k (f v) -> DMap (WrapArg f (Const2 k v))
72−mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> WrapArg (Const2 k) :=> v) . Map.toAscList
72+mapWithFunctorToDMap :: Map k (f v) -> DMap (Const2 k v) f
73+mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> (Const2 k) :=> v) . Map.toAscList
7374
74−dmapToMap :: DMap (Const2 k v) -> Map k v
75−dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> v) -> (k, v)) . DMap.toAscList
75+dmapToMap :: DMap (Const2 k v) Identity -> Map k v
76+dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList
src/Reflex/Class.hs+20−16
@@ -45,9 +45,9 @@ class (MonadHold t (PushM t), MonadSample t (PullM t), MonadFix (PushM t), Funct
4545 -- | A monad for doing complex pull-based calculations efficiently
4646 type PullM t :: * -> *
4747 -- | Merge a collection of events; the resulting Event will only occur if at least one input event is occuring, and will contain all of the input keys that are occurring simultaneously
48− merge :: GCompare k => DMap (WrapArg (Event t) k) -> Event t (DMap k) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
48+ merge :: GCompare k => DMap k (Event t) -> Event t (DMap k Identity) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
4949 -- | Efficiently fan-out an event to many destinations. This function should be partially applied, and then the result applied repeatedly to create child events
50− fan :: GCompare k => Event t (DMap k) -> EventSelector t k --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
50+ fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
5151 -- | Create an Event that will occur whenever the currently-selected input Event occurs
5252 switch :: Behavior t (Event t a) -> Event t a
5353 -- | Create an Event that will occur whenever the input event is occurring and its occurrence value, another Event, is also occurring
@@ -273,30 +273,30 @@ instance GShow (EitherTag l r) where
273273 LeftTag -> showString "LeftTag"
274274 RightTag -> showString "RightTag"
275275
276−instance (Show l, Show r) => ShowTag (EitherTag l r) where
277− showTaggedPrec t n a = case t of
276+instance (Show l, Show r) => ShowTag (EitherTag l r) Identity where
277+ showTaggedPrec t n (Identity a) = case t of
278278 LeftTag -> showsPrec n a
279279 RightTag -> showsPrec n a
280280
281281-- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.
282−eitherToDSum :: Either a b -> DSum (EitherTag a b)
282+eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity
283283eitherToDSum = \case
284− Left a -> LeftTag :=> a
285− Right b -> RightTag :=> b
284+ Left a -> (LeftTag :=> Identity a)
285+ Right b -> (RightTag :=> Identity b)
286286
287287-- | Convert 'DSum' to 'Either'. Inverse of 'eitherToDSum'.
288−dsumToEither :: DSum (EitherTag a b) -> Either a b
288+dsumToEither :: DSum (EitherTag a b) Identity -> Either a b
289289dsumToEither = \case
290− LeftTag :=> a -> Left a
291− RightTag :=> b -> Right b
290+ (LeftTag :=> Identity a) -> Left a
291+ (RightTag :=> Identity b) -> Right b
292292
293293-- | Extract the values of a 'DMap' of 'EitherTag's.
294−dmapToThese :: DMap (EitherTag a b) -> Maybe (These a b)
294+dmapToThese :: DMap (EitherTag a b) Identity -> Maybe (These a b)
295295dmapToThese m = case (DMap.lookup LeftTag m, DMap.lookup RightTag m) of
296296 (Nothing, Nothing) -> Nothing
297− (Just a, Nothing) -> Just $ This a
298− (Nothing, Just b) -> Just $ That b
299− (Just a, Just b) -> Just $ These a b
297+ (Just (Identity a), Nothing) -> Just $ This a
298+ (Nothing, Just (Identity b)) -> Just $ That b
299+ (Just (Identity a), Just (Identity b)) -> Just $ These a b
300300
301301-- | Create a new 'Event' that occurs if at least one of the supplied
302302-- 'Event's occurs. If both occur at the same time they are combined
@@ -320,7 +320,11 @@ instance (Semigroup a, Reflex t) => Monoid (Event t a) where
320320-- in the list occurs. If multiple occur at the same time they are
321321-- folded from the left with the given function.
322322mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
323−mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> v) -> v) . DMap.toList) $ merge $ DMap.fromList $ map (\(k, v) -> WrapArg (Const2 k) :=> v) $ zip [0 :: Int ..] es
323+mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
324+ . merge
325+ . DMap.fromDistinctAscList
326+ . map (\(k, v) -> (Const2 k) :=> v)
327+ $ zip [0 :: Int ..] es
324328
325329-- | Create a new 'Event' that occurs if at least one of the 'Event's
326330-- in the list occurs. If multiple occur at the same time the value is
@@ -356,7 +360,7 @@ switchPromptly ea0 eea = do
356360
357361instance Reflex t => Align (Event t) where
358362 nil = never
359− align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [WrapArg LeftTag :=> ea, WrapArg RightTag :=> eb]
363+ align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
360364
361365-- | Create a new 'Event' that only occurs if the supplied 'Event'
362366-- occurs and the 'Behavior' is true at the time of occurence.
src/Reflex/Dynamic.hs+22−17
@@ -227,26 +227,26 @@ splitDyn d = liftM2 (,) (mapDyn fst d) (mapDyn snd d)
227227-- | Merge the 'Dynamic' values using their 'Monoid' instance.
228228mconcatDyn :: forall t m a. (Reflex t, MonadHold t m, Monoid a) => [Dynamic t a] -> m (Dynamic t a)
229229mconcatDyn es = do
230− ddm :: Dynamic t (DMap (Const2 Int a)) <- distributeDMapOverDyn $ DMap.fromList $ map (\(k, v) -> WrapArg (Const2 k) :=> v) $ zip [0 :: Int ..] es
231− mapDyn (mconcat . map (\(Const2 _ :=> v) -> v) . DMap.toList) ddm
230+ ddm :: Dynamic t (DMap (Const2 Int a) Identity) <- distributeDMapOverDyn . DMap.fromList . map (\(k, v) -> Const2 k :=> v) $ zip [0 :: Int ..] es
231+ mapDyn (mconcat . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) ddm
232232
233233-- | Create a 'Dynamic' with a 'DMap' of values out of a 'DMap' of
234234-- Dynamic values.
235−distributeDMapOverDyn :: forall t m k. (Reflex t, MonadHold t m, GCompare k) => DMap (WrapArg (Dynamic t) k) -> m (Dynamic t (DMap k))
235+distributeDMapOverDyn :: forall t m k. (Reflex t, MonadHold t m, GCompare k) => DMap k (Dynamic t) -> m (Dynamic t (DMap k Identity))
236236distributeDMapOverDyn dm = case DMap.toList dm of
237237 [] -> return $ constDyn DMap.empty
238− [WrapArg k :=> v] -> mapDyn (DMap.singleton k) v
238+ [k :=> v] -> mapDyn (DMap.singleton k . Identity) v
239239 _ -> do
240240 let edmPre = merge $ rewrapDMap updated dm
241− edm :: Event t (DMap k) = flip push edmPre $ \o -> return . Just =<< do
241+ edm :: Event t (DMap k Identity) = flip push edmPre $ \o -> return . Just =<< do
242242 let f _ = \case
243243 This origDyn -> sample $ current origDyn
244244 That _ -> error "distributeDMapOverDyn: should be impossible to have an event occurring that is not present in the original DMap"
245245 These _ (Identity newVal) -> return newVal
246246 sequenceDmap $ combineDMapsWithKey f dm (wrapDMap Identity o)
247− dm0 :: Behavior t (DMap k) = pull $ do
248− liftM DMap.fromList $ forM (DMap.toList dm) $ \(WrapArg k :=> dv) -> liftM (k :=>) $ sample $ current dv
249− bbdm :: Behavior t (Behavior t (DMap k)) <- hold dm0 $ fmap constant edm
247+ dm0 :: Behavior t (DMap k Identity) = pull $ do
248+ liftM DMap.fromList . forM (DMap.toList dm) $ \(k :=> dv) -> liftM ((k :=>) . Identity) . sample $ current dv
249+ bbdm :: Behavior t (Behavior t (DMap k Identity)) <- hold dm0 $ fmap constant edm
250250 let bdm = pull $ sample =<< sample bbdm
251251 return $ Dynamic bdm edm
252252
@@ -384,7 +384,12 @@ data Demux t k = Demux { demuxValue :: Behavior t k
384384
385385-- | Demultiplex an input value to a 'Demux' with many outputs. At any given time, whichever output is indicated by the given 'Dynamic' will be 'True'.
386386demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
387−demux k = Demux (current k) (fan $ attachWith (\k0 k1 -> if k0 == k1 then DMap.empty else DMap.fromList [Const2 k0 :=> False, Const2 k1 :=> True]) (current k) (updated k))
387+demux k = Demux (current k)
388+ (fan $ attachWith (\k0 k1 -> if k0 == k1
389+ then DMap.empty
390+ else DMap.fromList [Const2 k0 :=> Identity False,
391+ Const2 k1 :=> Identity True])
392+ (current k) (updated k))
388393
389394--TODO: The pattern of using hold (sample b0) can be reused in various places as a safe way of building certain kinds of Dynamics; see if we can factor this out
390395-- | Select a particular output of the 'Demux'; this is equivalent to (but much faster than)
@@ -422,16 +427,16 @@ data HListPtr l a where
422427 HHeadPtr :: HListPtr (h ': t) h
423428 HTailPtr :: HListPtr t a -> HListPtr (h ': t) a
424429
425−fhlistToDMap :: forall f l. FHList f l -> DMap (WrapArg f (HListPtr l))
430+fhlistToDMap :: forall (f :: * -> *) l. FHList f l -> DMap (HListPtr l) f
426431fhlistToDMap = DMap.fromList . go
427− where go :: forall l'. FHList f l' -> [DSum (WrapArg f (HListPtr l'))]
432+ where go :: forall l'. FHList f l' -> [DSum (HListPtr l') f]
428433 go = \case
429434 FHNil -> []
430− FHCons h t -> (WrapArg HHeadPtr :=> h) : map (\(WrapArg p :=> v) -> WrapArg (HTailPtr p) :=> v) (go t)
435+ FHCons h t -> (HHeadPtr :=> h) : map (\(p :=> v) -> (HTailPtr p) :=> v) (go t)
431436
432437class RebuildSortedHList l where
433− rebuildSortedFHList :: [DSum (WrapArg f (HListPtr l))] -> FHList f l
434− rebuildSortedHList :: [DSum (HListPtr l)] -> HList l
438+ rebuildSortedFHList :: [DSum (HListPtr l) f] -> FHList f l
439+ rebuildSortedHList :: [DSum (HListPtr l) Identity] -> HList l
435440
436441instance RebuildSortedHList '[] where
437442 rebuildSortedFHList l = case l of
@@ -443,13 +448,13 @@ instance RebuildSortedHList '[] where
443448
444449instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
445450 rebuildSortedFHList l = case l of
446− ((WrapArg HHeadPtr :=> h) : t) -> FHCons h $ rebuildSortedFHList $ map (\(WrapArg (HTailPtr p) :=> v) -> WrapArg p :=> v) t
451+ ((HHeadPtr :=> h) : t) -> FHCons h . rebuildSortedFHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
447452 _ -> error "rebuildSortedFHList{h':t}: non-empty list with HHeadPtr expected"
448453 rebuildSortedHList l = case l of
449− ((HHeadPtr :=> h) : t) -> HCons h $ rebuildSortedHList $ map (\(HTailPtr p :=> v) -> p :=> v) t
454+ ((HHeadPtr :=> Identity h) : t) -> HCons h . rebuildSortedHList . map (\(HTailPtr p :=> v) -> p :=> v) $ t
450455 _ -> error "rebuildSortedHList{h':t}: non-empty list with HHeadPtr expected"
451456
452−dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) -> HList l
457+dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
453458dmapToHList = rebuildSortedHList . DMap.toList
454459
455460distributeFHListOverDyn :: forall t m l. (Reflex t, MonadHold t m, RebuildSortedHList l) => FHList (Dynamic t) l -> m (Dynamic t (HList l))
src/Reflex/Host/Class.hs+5−4
@@ -6,6 +6,7 @@ import Reflex.Class
66import Control.Applicative
77import Control.Monad
88import Control.Monad.Fix
9+import Control.Monad.Identity
910import Control.Monad.Trans
1011import Control.Monad.Trans.Reader (ReaderT())
1112import Control.Monad.Trans.Writer (WriterT())
@@ -84,7 +85,7 @@ class (ReflexHost t, MonadReflexCreateTrigger t m, MonadSubscribeEvent t m, Mona
8485 -- The main loop waits for external events to happen (such as keyboard input or a mouse click)
8586 -- and then fires the corresponding events using this function. The read callback can be used
8687 -- to read output events and perform a corresponding response action to the external event.
87− fireEventsAndRead :: [DSum (EventTrigger t)] -> (ReadPhase m a) -> m a
88+ fireEventsAndRead :: [DSum (EventTrigger t) Identity] -> (ReadPhase m a) -> m a
8889
8990 -- | Run a frame without any events firing.
9091 --
@@ -96,7 +97,7 @@ class (ReflexHost t, MonadReflexCreateTrigger t m, MonadSubscribeEvent t m, Mona
9697 runHostFrame :: HostFrame t a -> m a
9798
9899-- | Like 'fireEventsAndRead', but without reading any events.
99−fireEvents :: MonadReflexHost t m => [DSum (EventTrigger t)] -> m ()
100+fireEvents :: MonadReflexHost t m => [DSum (EventTrigger t) Identity] -> m ()
100101fireEvents dm = fireEventsAndRead dm $ return ()
101102{-# INLINE fireEvents #-}
102103
@@ -120,14 +121,14 @@ fireEventRef mtRef input = do
120121 mt <- readRef mtRef
121122 case mt of
122123 Nothing -> return ()
123− Just trigger -> fireEvents [trigger :=> input]
124+ Just trigger -> fireEvents [trigger :=> Identity input]
124125
125126fireEventRefAndRead :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> EventHandle t b -> m (Maybe b)
126127fireEventRefAndRead mtRef input e = do
127128 mt <- readRef mtRef
128129 case mt of
129130 Nothing -> return Nothing -- Since we aren't firing the input, the output can't fire
130− Just trigger -> fireEventsAndRead [trigger :=> input] $ do
131+ Just trigger -> fireEventsAndRead [trigger :=> Identity input] $ do
131132 mGetValue <- readEvent e
132133 case mGetValue of
133134 Nothing -> return Nothing
src/Reflex/Spider/Internal.hs+44−41
@@ -9,19 +9,20 @@ import System.Mem.Weak
99import Data.Foldable
1010import Data.Traversable
1111import Control.Monad hiding (mapM, mapM_, forM_, forM, sequence)
12+import Control.Monad.Identity hiding (mapM, mapM_, forM_, forM, sequence)
1213import Control.Monad.Reader hiding (mapM, mapM_, forM_, forM, sequence)
1314import GHC.Exts
1415import Control.Applicative -- Unconditionally import, because otherwise it breaks on GHC 7.10.1RC2
1516import Data.Dependent.Map (DMap, DSum (..))
1617import qualified Data.Dependent.Map as DMap
1718import Data.GADT.Compare
18−import Data.Functor.Misc
1919import Data.Maybe
2020import Data.IntMap (IntMap)
2121import qualified Data.IntMap as IntMap
2222import Control.Monad.Ref
2323import Control.Monad.Exception
2424import Data.Monoid ((<>))
25+import Data.Coerce
2526
2627import System.IO.Unsafe
2728import Unsafe.Coerce
@@ -139,7 +140,7 @@ scheduleClear r = EventM $ do
139140 clears <- asks eventEnvClears
140141 liftIO $ modifyIORef' clears (SomeMaybeIORef r :)
141142
142−scheduleRootClear :: IORef (DMap k) -> EventM ()
143+scheduleRootClear :: IORef (DMap k Identity) -> EventM ()
143144scheduleRootClear r = EventM $ do
144145 clears <- asks eventEnvRootClears
145146 liftIO $ modifyIORef' clears (SomeDMapIORef r :)
@@ -223,8 +224,8 @@ data RootSubscribed a
223224 }
224225
225226data Root (k :: * -> *)
226− = Root { rootOccurrence :: !(IORef (DMap k)) -- The currently-firing occurrence of this event
227− , rootSubscribed :: !(IORef (DMap (WrapArg RootSubscribed k)))
227+ = Root { rootOccurrence :: !(IORef (DMap k Identity)) -- The currently-firing occurrence of this event
228+ , rootSubscribed :: !(IORef (DMap k RootSubscribed))
228229 , rootInit :: !(forall a. k a -> RootTrigger a -> IO (IO ()))
229230 }
230231
@@ -251,12 +252,12 @@ data Push a b
251252 }
252253
253254data MergeSubscribed k
254− = MergeSubscribed { mergeSubscribedOccurrence :: !(IORef (Maybe (DMap k)))
255− , mergeSubscribedAccum :: !(IORef (DMap k)) -- This will accumulate occurrences until our height is reached, at which point it will be transferred to mergeSubscribedOccurrence
255+ = MergeSubscribed { mergeSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))
256+ , mergeSubscribedAccum :: !(IORef (DMap k Identity)) -- This will accumulate occurrences until our height is reached, at which point it will be transferred to mergeSubscribedOccurrence
256257 , mergeSubscribedHeight :: !(IORef Int)
257− , mergeSubscribedSubscribers :: !(IORef [WeakSubscriber (DMap k)])
258+ , mergeSubscribedSubscribers :: !(IORef [WeakSubscriber (DMap k Identity)])
258259 , mergeSubscribedSelf :: !Any -- Hold all our Subscribers in memory
259− , mergeSubscribedParents :: !(DMap (WrapArg EventSubscribed k))
260+ , mergeSubscribedParents :: !(DMap k EventSubscribed)
260261#ifdef DEBUG_NODEIDS
261262 , mergeSubscribedNodeId :: Int
262263#endif
@@ -264,7 +265,7 @@ data MergeSubscribed k
264265
265266--TODO: DMap sucks; we should really write something better (with a functor for the value as well as the key)
266267data Merge k
267− = Merge { mergeParents :: !(DMap (WrapArg Event k))
268+ = Merge { mergeParents :: !(DMap k Event)
268269 , mergeSubscribed :: !(IORef (Maybe (MergeSubscribed k))) --TODO: Can we replace this with an unsafePerformIO thunk?
269270 }
270271
@@ -283,16 +284,16 @@ instance GCompare k => GCompare (FanSubscriberKey k) where
283284 GGT -> GGT
284285
285286data FanSubscribed k
286− = FanSubscribed { fanSubscribedSubscribers :: !(IORef (DMap (FanSubscriberKey k)))
287− , fanSubscribedParent :: !(EventSubscribed (DMap k))
288− , fanSubscribedSelf :: {-# NOUNPACK #-} (Subscriber (DMap k))
287+ = FanSubscribed { fanSubscribedSubscribers :: !(IORef (DMap (FanSubscriberKey k) Identity))
288+ , fanSubscribedParent :: !(EventSubscribed (DMap k Identity))
289+ , fanSubscribedSelf :: {-# NOUNPACK #-} (Subscriber (DMap k Identity))
289290#ifdef DEBUG_NODEIDS
290291 , fanSubscribedNodeId :: Int
291292#endif
292293 }
293294
294295data Fan k
295− = Fan { fanParent :: !(Event (DMap k))
296+ = Fan { fanParent :: !(Event (DMap k Identity))
296297 , fanSubscribed :: !(IORef (Maybe (FanSubscribed k)))
297298 }
298299
@@ -354,7 +355,7 @@ deRefWeakSubscriber ws = case ws of
354355data Subscriber a
355356 = forall b. SubscriberPush !(a -> EventM (Maybe b)) (PushSubscribed a b)
356357 | forall k. GCompare k => SubscriberMerge !(k a) (MergeSubscribed k) --TODO: Can we inline the GCompare?
357− | forall k. (GCompare k, a ~ DMap k) => SubscriberFan (FanSubscribed k)
358+ | forall k. (GCompare k, a ~ DMap k Identity) => SubscriberFan (FanSubscribed k)
358359 | SubscriberHold !(Hold a)
359360 | SubscriberSwitch (SwitchSubscribed a)
360361 | forall b. a ~ Event b => SubscriberCoincidenceOuter (CoincidenceSubscribed b)
@@ -374,7 +375,7 @@ data Event a
374375 = forall k. GCompare k => EventRoot !(k a) !(Root k)
375376 | EventNever
376377 | forall b. EventPush !(Push b a)
377− | forall k. (GCompare k, a ~ DMap k) => EventMerge !(Merge k)
378+ | forall k. (GCompare k, a ~ DMap k Identity) => EventMerge !(Merge k)
378379 | forall k. GCompare k => EventFan !(k a) !(Fan k)
379380 | EventSwitch !(Switch a)
380381 | EventCoincidence !(Coincidence a)
@@ -393,7 +394,7 @@ data EventSubscribed a
393394 = EventSubscribedRoot {-# NOUNPACK #-} (RootSubscribed a)
394395 | EventSubscribedNever
395396 | forall b. EventSubscribedPush !(PushSubscribed b a)
396− | forall k. (GCompare k, a ~ DMap k) => EventSubscribedMerge !(MergeSubscribed k)
397+ | forall k. (GCompare k, a ~ DMap k Identity) => EventSubscribedMerge !(MergeSubscribed k)
397398 | forall k. GCompare k => EventSubscribedFan !(k a) !(FanSubscribed k)
398399 | EventSubscribedSwitch !(SwitchSubscribed a)
399400 | EventSubscribedCoincidence !(CoincidenceSubscribed a)
@@ -424,7 +425,7 @@ newSubscriberHold :: Hold a -> IO (Subscriber a)
424425newSubscriberHold h = return $! SubscriberHold h
425426
426427{-# NOINLINE newSubscriberFan #-}
427−newSubscriberFan :: GCompare k => FanSubscribed k -> IO (Subscriber (DMap k))
428+newSubscriberFan :: GCompare k => FanSubscribed k -> IO (Subscriber (DMap k Identity))
428429newSubscriberFan subd = return $! SubscriberFan subd
429430
430431{-# NOINLINE newSubscriberSwitch #-}
@@ -519,7 +520,7 @@ propagateAndUpdateSubscribersRef subscribersRef a = do
519520 liftIO $ modifyIORef' subscribersRef (++stillAlive)
520521
521522-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors
522−run :: [DSum RootTrigger] -> ResultM b -> IO b
523+run :: [DSum RootTrigger Identity] -> ResultM b -> IO b
523524run roots after = do
524525 when debugPropagate $ putStrLn "Running an event frame"
525526 result <- runFrame $ do
@@ -532,7 +533,7 @@ run roots after = do
532533 then do scheduleRootClear occRef
533534 return $ Just r
534535 else return Nothing
535− forM_ (catMaybes rootsToPropagate) $ \(RootTrigger (subscribersRef, _, _) :=> a) -> do
536+ forM_ (catMaybes rootsToPropagate) $ \(RootTrigger (subscribersRef, _, _) :=> Identity a) -> do
536537 propagateAndUpdateSubscribersRef subscribersRef a
537538 delayedRef <- EventM $ asks eventEnvDelayedMerges
538539 let go = do
@@ -565,7 +566,7 @@ run roots after = do
565566
566567data SomeMaybeIORef = forall a. SomeMaybeIORef (IORef (Maybe a))
567568
568−data SomeDMapIORef = forall k. SomeDMapIORef (IORef (DMap k))
569+data SomeDMapIORef = forall k. SomeDMapIORef (IORef (DMap k Identity))
569570
570571data SomeAssignment = forall a. SomeAssignment (Hold a) a
571572
@@ -611,7 +612,7 @@ propagate a subscribers = do
611612 SubscriberMerge k subscribed -> do
612613 when debugPropagate $ liftIO $ putStrLn $ "SubscriberMerge" <> showNodeId subscribed
613614 oldM <- liftIO $ readIORef $ mergeSubscribedAccum subscribed
614− liftIO $ writeIORef (mergeSubscribedAccum subscribed) $ DMap.insertWith (error "Same key fired multiple times for") k a oldM
615+ liftIO $ writeIORef (mergeSubscribedAccum subscribed) $ DMap.insertWith (error "Same key fired multiple times for") k (Identity a) oldM
615616 when (DMap.null oldM) $ do -- Only schedule the firing once
616617 height <- liftIO $ readIORef $ mergeSubscribedHeight subscribed
617618 --TODO: assertions about height
@@ -622,17 +623,19 @@ propagate a subscribers = do
622623 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed
623624 when debugPropagate $ liftIO $ putStrLn $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"
624625 --TODO: We need a better DMap intersection; here, we are assuming that the number of firing keys is small and the number of subscribers is large
625− forM_ (DMap.toList a) $ \(k :=> v) -> case DMap.lookup (FanSubscriberKey k) subs of
626+ forM_ (DMap.toList a) $ \(k :=> Identity v) -> case DMap.lookup (FanSubscriberKey k) subs of
626627 Nothing -> do
627628 when debugPropagate $ liftIO $ putStrLn "No subscriber for key"
628629 return ()
629− Just subsubs -> do
630+ Just (Identity subsubs) -> do
630631 _ <- propagate v subsubs --TODO: use the value of this
631632 return ()
632633 --TODO: The following is way too slow to do all the time
633− subs' <- liftIO $ forM (DMap.toList subs) $ ((\(FanSubscriberKey k :=> subsubs) -> do
634+ subs' <- liftIO $ forM (DMap.toList subs) $ ((\(FanSubscriberKey k :=> Identity subsubs) -> do
634635 subsubs' <- traverseAndCleanWeakList_ (liftIO . deRefWeakSubscriber) subsubs (const $ return ())
635− return $ if null subsubs' then Nothing else Just $ FanSubscriberKey k :=> subsubs') :: DSum (FanSubscriberKey k) -> IO (Maybe (DSum (FanSubscriberKey k))))
636+ return $ if null subsubs'
637+ then Nothing
638+ else Just $ FanSubscriberKey k :=> Identity subsubs') :: DSum (FanSubscriberKey k) Identity -> IO (Maybe (DSum (FanSubscriberKey k) Identity)))
636639 liftIO $ writeIORef (fanSubscribedSubscribers subscribed) $ DMap.fromDistinctAscList $ catMaybes subs'
637640 SubscriberHold h -> do
638641 invalidators <- liftIO $ readIORef $ holdInvalidators h
@@ -731,7 +734,7 @@ readBehaviorTracked b = case b of
731734
732735readEvent :: Event a -> ResultM (Maybe a)
733736readEvent e = case e of
734− EventRoot k r -> liftIO $ liftM (DMap.lookup k) $ readIORef $ rootOccurrence r
737+ EventRoot k r -> liftIO . liftM (coerce . DMap.lookup k) . readIORef $ rootOccurrence r
735738 EventNever -> return Nothing
736739 EventPush p -> do
737740 subscribed <- getPushSubscribed p
@@ -747,7 +750,7 @@ readEvent e = case e of
747750 return result
748751 EventFan k f -> do
749752 parentOcc <- readEvent $ fanParent f
750− return $ DMap.lookup k =<< parentOcc
753+ return . coerce $ DMap.lookup k =<< parentOcc
751754 EventSwitch s -> do
752755 subscribed <- getSwitchSubscribed s
753756 liftIO $ do
@@ -794,7 +797,7 @@ subscribeEventSubscribed es ws = case es of
794797 modifyIORef' (pushSubscribedSubscribers subscribed) (ws:)
795798 EventSubscribedFan k subscribed -> do
796799 when debugSubscribe $ liftIO $ putStrLn $ "subscribeEventSubscribed Fan"
797− modifyIORef' (fanSubscribedSubscribers subscribed) $ DMap.insertWith (++) (FanSubscriberKey k) [ws]
800+ modifyIORef' (fanSubscribedSubscribers subscribed) $ DMap.insertWith (liftA2 (++)) (FanSubscriberKey k) (Identity [ws])
798801 EventSubscribedMerge subscribed -> do
799802 when debugSubscribe $ liftIO $ putStrLn $ "subscribeEventSubscribed Merge"
800803 modifyIORef' (mergeSubscribedSubscribers subscribed) (ws:)
@@ -812,7 +815,7 @@ getEventSubscribedOcc es = case es of
812815 EventSubscribedPush subscribed -> readIORef $ pushSubscribedOccurrence subscribed
813816 EventSubscribedFan k subscribed -> do
814817 parentOcc <- getEventSubscribedOcc $ fanSubscribedParent subscribed
815− let occ = DMap.lookup k =<< parentOcc
818+ let occ = coerce $ DMap.lookup k =<< parentOcc
816819 return occ
817820 EventSubscribedMerge subscribed -> readIORef $ mergeSubscribedOccurrence subscribed
818821 EventSubscribedSwitch subscribed -> readIORef $ switchSubscribedOccurrence subscribed
@@ -841,18 +844,18 @@ noinlineFalse = False
841844getRootSubscribed :: GCompare k => k a -> Root k -> EventM (RootSubscribed a)
842845getRootSubscribed k r = do
843846 mSubscribed <- liftIO $ readIORef $ rootSubscribed r
844− case DMap.lookup (WrapArg k) mSubscribed of
847+ case DMap.lookup k mSubscribed of
845848 Just subscribed -> return subscribed
846849 Nothing -> liftIO $ do
847850 subscribersRef <- newIORef []
848− subscribed <- newRootSubscribed (liftM (DMap.lookup k) $ readIORef $ rootOccurrence r) subscribersRef
851+ subscribed <- newRootSubscribed (liftM (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r) subscribersRef
849852 -- Strangely, init needs the same stuff as a RootSubscribed has, but it must not be the same as the one that everyone's subscribing to, or it'll leak memory
850853 uninit <- rootInit r k $ RootTrigger (subscribersRef, rootOccurrence r, k)
851854 addFinalizer subscribed $ do
852855 when noinlineFalse $ putStr "" -- For some reason, without this line, the finalizer will run earlier than it should
853856-- putStrLn "Uninit root"
854857 uninit
855− liftIO $ modifyIORef' (rootSubscribed r) $ DMap.insert (WrapArg k) subscribed
858+ liftIO $ modifyIORef' (rootSubscribed r) $ DMap.insert k subscribed
856859 return subscribed
857860
858861-- When getPushSubscribed returns, the PushSubscribed returned will have a fully filled-in
@@ -894,11 +897,11 @@ getMergeSubscribed m = {-# SCC "getMergeSubscribed.entire" #-} do
894897 subscribedUnsafe <- liftIO $ unsafeInterleaveIO $ readIORef subscribedRef
895898 s <- liftIO $ newBox subscribedUnsafe
896899 ws <- liftIO $ mkWeakPtrWithDebug s "SubscriberMerge"
897− subscribers :: [(Any, Maybe (DSum k), Int, DSum (WrapArg EventSubscribed k))] <- forM (DMap.toList $ mergeParents m) $ {-# SCC "getMergeSubscribed.a" #-} \(WrapArg k :=> e) -> {-# SCC "getMergeSubscribed.a1" #-} do
900+ subscribers :: [(Any, Maybe (DSum k Identity), Int, DSum k EventSubscribed)] <- forM (DMap.toList $ mergeParents m) $ {-# SCC "getMergeSubscribed.a" #-} \(k :=> e) -> {-# SCC "getMergeSubscribed.a1" #-} do
898901 parentSubd <- {-# SCC "getMergeSubscribed.a.parentSubd" #-} subscribe e $ WeakSubscriberMerge k ws
899902 parentOcc <- {-# SCC "getMergeSubscribed.a.parentOcc" #-} liftIO $ getEventSubscribedOcc parentSubd
900903 height <- {-# SCC "getMergeSubscribed.a.height" #-} liftIO $ readIORef $ eventSubscribedHeightRef parentSubd
901− return $ {-# SCC "getMergeSubscribed.a.returnVal" #-} (unsafeCoerce s :: Any, fmap (k :=>) parentOcc, height, WrapArg k :=> parentSubd)
904+ return $ {-# SCC "getMergeSubscribed.a.returnVal" #-} (unsafeCoerce s :: Any, fmap (\x -> k :=> Identity x) parentOcc, height, k :=> parentSubd)
902905 let dm = DMap.fromDistinctAscList $ catMaybes $ map (\(_, x, _, _) -> x) subscribers
903906 subscriberHeights = map (\(_, _, x, _) -> x) subscribers
904907 myHeight =
@@ -1048,7 +1051,7 @@ getCoincidenceSubscribed c = do
10481051 liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed
10491052 return subscribed
10501053
1051−merge :: GCompare k => DMap (WrapArg Event k) -> Event (DMap k)
1054+merge :: GCompare k => DMap k Event -> Event (DMap k Identity)
10521055merge m = EventMerge $ Merge
10531056 { mergeParents = m
10541057 , mergeSubscribed = unsafeNewIORef m Nothing
@@ -1056,7 +1059,7 @@ merge m = EventMerge $ Merge
10561059
10571060newtype EventSelector k = EventSelector { select :: forall a. k a -> Event a }
10581061
1059−fan :: GCompare k => Event (DMap k) -> EventSelector k
1062+fan :: GCompare k => Event (DMap k Identity) -> EventSelector k
10601063fan e =
10611064 let f = Fan
10621065 { fanParent = e
@@ -1154,7 +1157,7 @@ invalidateSubscriberHeight ws = do
11541157 SubscriberFan subscribed -> do
11551158 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
11561159 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
1157− forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> v) -> mapM_ invalidateSubscriberHeight v) :: DSum (FanSubscriberKey k) -> IO ())
1160+ forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> Identity v) -> mapM_ invalidateSubscriberHeight v) :: DSum (FanSubscriberKey k) Identity -> IO ())
11581161 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
11591162 SubscriberHold _ -> return ()
11601163 SubscriberSwitch subscribed -> do
@@ -1205,7 +1208,7 @@ recalculateSubscriberHeight ws = do
12051208 SubscriberFan subscribed -> do
12061209 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
12071210 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
1208− forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> v) -> mapM_ recalculateSubscriberHeight v) :: DSum (FanSubscriberKey k) -> IO ())
1211+ forM_ (DMap.toList subscribers) $ ((\(FanSubscriberKey _ :=> Identity v) -> mapM_ recalculateSubscriberHeight v) :: DSum (FanSubscriberKey k) Identity -> IO ())
12091212 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
12101213 SubscriberHold _ -> return ()
12111214 SubscriberSwitch subscribed -> do
@@ -1237,7 +1240,7 @@ recalculateCoincidenceHeight subscribed = do
12371240
12381241calculateMergeHeight :: MergeSubscribed k -> IO Int
12391242calculateMergeHeight subscribed = if DMap.null (mergeSubscribedParents subscribed) then return 0 else do
1240− heights <- forM (DMap.toList $ mergeSubscribedParents subscribed) $ \(WrapArg _ :=> es) -> do
1243+ heights <- forM (DMap.toList $ mergeSubscribedParents subscribed) $ \(_ :=> es) -> do
12411244 readIORef $ eventSubscribedHeightRef es
12421245 return $ if any (== invalidHeight) heights then invalidHeight else succ $ Prelude.maximum heights --TODO: Replace 'any' with invalidHeight-preserving 'maximum'
12431246
@@ -1316,7 +1319,7 @@ instance R.Reflex Spider where
13161319 constant = SpiderBehavior . BehaviorConst
13171320 push f = SpiderEvent. push f . unSpiderEvent
13181321 pull = SpiderBehavior . pull
1319− merge = SpiderEvent . merge . (unsafeCoerce :: DMap (WrapArg (R.Event Spider) k) -> DMap (WrapArg Event k))
1322+ merge = SpiderEvent . merge . (unsafeCoerce :: DMap k (R.Event Spider) -> DMap k Event)
13201323 fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))
13211324 switch = SpiderEvent . switch . (unsafeCoerce :: Behavior (R.Event Spider a) -> Behavior (Event a)) . unSpiderBehavior
13221325 coincidence = SpiderEvent . coincidence . (unsafeCoerce :: Event (R.Event Spider a) -> Event (Event a)) . unSpiderEvent
@@ -1340,7 +1343,7 @@ instance R.MonadHold Spider EventM where
13401343 {-# INLINE hold #-}
13411344 hold v0 e = SpiderBehavior <$> hold v0 (unSpiderEvent e)
13421345
1343−data RootTrigger a = forall k. GCompare k => RootTrigger (IORef [WeakSubscriber a], IORef (DMap k), k a)
1346+data RootTrigger a = forall k. GCompare k => RootTrigger (IORef [WeakSubscriber a], IORef (DMap k Identity), k a)
13441347newtype SpiderEventHandle a = SpiderEventHandle { unEventHandle :: Event a }
13451348
13461349instance R.MonadSubscribeEvent Spider SpiderHostFrame where
test/Reflex/Pure.hs+4−4
@@ -9,7 +9,7 @@ module Reflex.Pure where
99
1010import Reflex.Class
1111import Data.Functor.Misc
12−
12+import Control.Monad.Identity
1313import Control.Monad
1414import Data.MemoTrie
1515import Data.Dependent.Map (DMap, GCompare)
@@ -40,15 +40,15 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
4040 pull :: PullM (Pure t) a -> Behavior (Pure t) a
4141 pull = Behavior . memo
4242
43− merge :: GCompare k => DMap (WrapArg (Event (Pure t)) k) -> Event (Pure t) (DMap k)
43+ merge :: GCompare k => DMap k (Event (Pure t)) -> Event (Pure t) (DMap k Identity)
4444 merge events = Event $ memo $ \t ->
4545 let currentOccurrences = unwrapDMapMaybe (($ t) . unEvent) events
4646 in if DMap.null currentOccurrences
4747 then Nothing
4848 else Just currentOccurrences
4949
50− fan :: GCompare k => Event (Pure t) (DMap k) -> EventSelector (Pure t) k
51− fan e = EventSelector $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k
50+ fan :: GCompare k => Event (Pure t) (DMap k Identity) -> EventSelector (Pure t) k
51+ fan e = EventSelector $ \k -> Event $ \t -> unEvent e t >>= fmap runIdentity . DMap.lookup k
5252
5353 switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a
5454 switch b = Event $ memo $ \t -> unEvent (unBehavior b t) t
test/Reflex/Test/CrossImpl.hs+2−2
@@ -71,12 +71,12 @@ testSpider builder (bMap, eMap) = unsafePerformIO $ S.runSpiderHost $ do
7171 let times = relevantTestingTimes (bMap, eMap)
7272 liftIO performGC
7373 outputs <- forM times $ \t -> do
74− forM_ (Map.lookup t bMap) $ \val -> mapM_ (\ rbt -> fireEvents [rbt :=> val]) =<< readRef rbTrigger
74+ forM_ (Map.lookup t bMap) $ \val -> mapM_ (\ rbt -> fireEvents [rbt :=> Identity val]) =<< readRef rbTrigger
7575 bOutput <- sample b'
7676 eOutput <- liftM join $ forM (Map.lookup t eMap) $ \val -> do
7777 mret <- readRef reTrigger
7878 let firing = case mret of
79− Just ret -> [ret :=> val]
79+ Just ret -> [ret :=> Identity val]
8080 Nothing -> []
8181 fireEventsAndRead firing $ sequence =<< readEvent e'Handle
8282 liftIO performGC