@@ -673,6 +673,9 @@ data EventEnv x
673673runEventM :: EventM x a -> EventEnv x -> IO a
674674runEventM = runReaderT . unEventM
675675
676+asksEventEnv :: (EventEnv x -> a) -> EventM x a
677+asksEventEnv = EventM . asks
678+
676679class MonadIO m => Defer a m where
677680 getDeferralQueue :: m (IORef [a])
678681
@@ -684,11 +687,11 @@ defer a = do
684687
685688instance Defer (SomeAssignment x) (EventM x) where
686689 {-# INLINE getDeferralQueue #-}
687− getDeferralQueue = EventM $ asks eventEnvAssignments
690+ getDeferralQueue = asksEventEnv eventEnvAssignments
688691
689692instance Defer (SomeHoldInit x) (EventM x) where
690693 {-# INLINE getDeferralQueue #-}
691− getDeferralQueue = EventM $ asks eventEnvHoldInits
694+ getDeferralQueue = asksEventEnv eventEnvHoldInits
692695
693696instance Defer (SomeHoldInit x) (BehaviorM x) where
694697 {-# INLINE getDeferralQueue #-}
@@ -696,11 +699,11 @@ instance Defer (SomeHoldInit x) (BehaviorM x) where
696699
697700instance Defer (SomeMergeUpdate x) (EventM x) where
698701 {-# INLINE getDeferralQueue #-}
699− getDeferralQueue = EventM $ asks eventEnvMergeUpdates
702+ getDeferralQueue = asksEventEnv eventEnvMergeUpdates
700703
701704instance Defer (SomeMergeInit x) (EventM x) where
702705 {-# INLINE getDeferralQueue #-}
703− getDeferralQueue = EventM $ asks eventEnvMergeInits
706+ getDeferralQueue = asksEventEnv eventEnvMergeInits
704707
705708class HasCurrentHeight x m | m -> x where
706709 getCurrentHeight :: m Height
@@ -722,7 +725,7 @@ class HasSpiderTimeline x m | m -> x where
722725
723726instance HasSpiderTimeline x (EventM x) where
724727 {-# INLINE askSpiderTimeline #-}
725− askSpiderTimeline = EventM $ asks eventEnvSpiderTimeline
728+ askSpiderTimeline = asksEventEnv eventEnvSpiderTimeline
726729
727730instance HasSpiderTimeline x (SpiderHost x) where
728731 {-# INLINE askSpiderTimeline #-}
@@ -735,7 +738,7 @@ putCurrentHeight h = EventM $ do
735738
736739instance Defer SomeClear (EventM x) where
737740 {-# INLINE getDeferralQueue #-}
738− getDeferralQueue = EventM $ asks eventEnvClears
741+ getDeferralQueue = asksEventEnv eventEnvClears
739742
740743{-# INLINE scheduleClear #-}
741744scheduleClear :: Defer SomeClear m => IORef (Maybe a) -> m ()
@@ -743,7 +746,7 @@ scheduleClear r = defer $ SomeClear r
743746
744747instance Defer SomeRootClear (EventM x) where
745748 {-# INLINE getDeferralQueue #-}
746− getDeferralQueue = EventM $ asks eventEnvRootClears
749+ getDeferralQueue = asksEventEnv eventEnvRootClears
747750
748751{-# INLINE scheduleRootClear #-}
749752scheduleRootClear :: Defer SomeRootClear m => IORef (DMap k Identity) -> m ()
@@ -751,7 +754,7 @@ scheduleRootClear r = defer $ SomeRootClear r
751754
752755instance Defer (SomeResetCoincidence x) (EventM x) where
753756 {-# INLINE getDeferralQueue #-}
754− getDeferralQueue = EventM $ asks eventEnvResetCoincidences
757+ getDeferralQueue = asksEventEnv eventEnvResetCoincidences
755758
756759-- Note: hold cannot examine its event until after the phase is over
757760{-# SPECIALIZE hold :: R.Patch p => R.PatchTarget p -> Event x p -> EventM x (Hold x p) #-}
@@ -873,7 +876,7 @@ data SomeMergeUpdate x = SomeMergeUpdate
873876newtype SomeMergeInit x = SomeMergeInit { unSomeMergeInit :: EventM x () }
874877
875878-- EventM can do everything BehaviorM can, plus create holds
876−newtype EventM x (a :: *) = EventM { unEventM :: ReaderT (EventEnv x) IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException) -- The environment should be Nothing if we are not in a frame, and Just if we are - in which case it is a list of assignments to be done after the frame is over
879+newtype EventM x a = EventM { unEventM :: ReaderT (EventEnv x) IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException) -- The environment should be Nothing if we are not in a frame, and Just if we are - in which case it is a list of assignments to be done after the frame is over
877880
878881newtype ComputeM x a = ComputeM (ReaderT (IORef [SomeHoldInit x]) IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
879882
@@ -1104,7 +1107,7 @@ run roots after = do
11041107 else return Nothing
11051108 forM_ (catMaybes rootsToPropagate) $ \(RootTrigger (subscribersRef, _, _) :=> Identity a) -> do
11061109 propagate a subscribersRef
1107− delayedRef <- EventM $ asks eventEnvDelayedMerges
1110+ delayedRef <- asksEventEnv eventEnvDelayedMerges
11081111 let go = do
11091112 delayed <- liftIO $ readIORef delayedRef
11101113 case IntMap.minViewWithKey delayed of