From 123b62e5380301da53121fefeb0c1e814251e125 Mon Sep 17 00:00:00 2001 From: Matthew Bauer Date: Fri, 31 Jan 2020 16:26:42 -0500 Subject: [PATCH] Revert "Use unsafePerformIO better (#325)" This reverts commit dc3ce150b6a88fc29f2ee0bb60a5bc686d2d0cc8. --- src/Reflex/Spider/Internal.hs | 97 +++++++++++++++++------------------ 1 file changed, 46 insertions(+), 51 deletions(-) diff --git a/src/Reflex/Spider/Internal.hs b/src/Reflex/Spider/Internal.hs index cf9570cf..db8f25f0 100644 --- a/src/Reflex/Spider/Internal.hs +++ b/src/Reflex/Spider/Internal.hs @@ -211,6 +211,12 @@ nextNodeIdRef = unsafePerformIO $ newIORef 1 newNodeId :: IO Int newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n) + +{-# NOINLINE unsafeNodeId #-} +unsafeNodeId :: a -> Int +unsafeNodeId a = unsafePerformIO $ do + touch a + newNodeId #endif -------------------------------------------------------------------------------- @@ -314,10 +320,9 @@ cacheEvent e = #else Event $ #endif - unsafePerformIO $ do - mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a)) - <- newIORef emptyFastWeak - pure $ \sub -> {-# SCC "cacheEvent" #-} do + let mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a)) + !mSubscribedRef = unsafeNewIORef e emptyFastWeak + in \sub -> {-# SCC "cacheEvent" #-} do #ifdef DEBUG_TRACE_EVENTS unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite #endif @@ -1206,12 +1211,18 @@ buildDynamic readV0 v' = do return d unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p -unsafeBuildDynamic readV0 v' = - Dyn $ unsafePerformIO $ newIORef $ UnsafeDyn (readV0, v') +unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ UnsafeDyn x + where x = (readV0, v') -- ResultM can read behaviors and events type ResultM = EventM +{-# NOINLINE unsafeNewIORef #-} +unsafeNewIORef :: a -> b -> IORef b +unsafeNewIORef a b = unsafePerformIO $ do + touch a + newIORef b + instance HasSpiderTimeline x => Functor (Event x) where fmap f = push $ return . Just . f @@ -1224,35 +1235,26 @@ push f e = cacheEvent (pushCheap f e) {-# INLINABLE pull #-} pull :: BehaviorM x a -> Behavior x a -pull a = unsafePerformIO $ do - ref <- newIORef Nothing +pull a = behaviorPull $ Pull + { pullCompute = a + , pullValue = unsafeNewIORef a Nothing #ifdef DEBUG_NODEIDS - nid <- newNodeId + , pullNodeId = unsafeNodeId a #endif - pure $ behaviorPull $ Pull - { pullCompute = a - , pullValue = ref -#ifdef DEBUG_NODEIDS - , pullNodeId = nid -#endif - } + } {-# INLINABLE switch #-} switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a -switch a = unsafePerformIO $ do - ref <- newIORef Nothing - pure $ eventSwitch $ Switch - { switchParent = a - , switchSubscribed = ref - } +switch a = eventSwitch $ Switch + { switchParent = a + , switchSubscribed = unsafeNewIORef a Nothing + } coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a -coincidence a = unsafePerformIO $ do - ref <- newIORef Nothing - pure $ eventCoincidence $ Coincidence - { coincidenceParent = a - , coincidenceSubscribed = ref - } +coincidence a = eventCoincidence $ Coincidence + { coincidenceParent = a + , coincidenceSubscribed = unsafeNewIORef a Nothing + } -- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b @@ -1456,9 +1458,6 @@ getRootSubscribed k r sub = do when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit" uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k) writeIORef uninitRef $! uninit -#ifdef DEBUG_NODEIDS - nid <- newNodeId -#endif let !subscribed = RootSubscribed { rootSubscribedKey = k , rootSubscribedCachedSubscribed = cached @@ -1467,7 +1466,7 @@ getRootSubscribed k r sub = do , rootSubscribedUninit = uninit , rootSubscribedWeakSelf = weakSelf #ifdef DEBUG_NODEIDS - , rootSubscribedNodeId = nid + , rootSubscribedNodeId = unsafeNodeId (k, r, subs) #endif } -- If we die at the same moment that all our children die, they will @@ -1516,10 +1515,16 @@ newFanInt = do , _fanInt_occRef = occRef } +{-# NOINLINE unsafeNewFanInt #-} +unsafeNewFanInt :: b -> FanInt x a +unsafeNewFanInt b = unsafePerformIO $ do + touch b + newFanInt + fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a -fanInt p = unsafePerformIO $ do - self <- newFanInt - pure $ EventSelectorInt $ \k -> Event $ \sub -> do +fanInt p = + let self = unsafeNewFanInt p + in EventSelectorInt $ \k -> Event $ \sub -> do isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self) when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input (subscription, parentOcc) <- subscribeAndRead p $ Subscriber @@ -1573,16 +1578,13 @@ getFanSubscribed k f sub = do subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized" occRef <- liftIO $ newIORef parentOcc when (isJust parentOcc) $ scheduleClear occRef -#ifdef DEBUG_NODEIDS - nid <- liftIO newNodeId -#endif let subscribed = FanSubscribed { fanSubscribedCachedSubscribed = fanSubscribed f , fanSubscribedOccurrence = occRef , fanSubscribedParent = subscription , fanSubscribedSubscribers = subscribersRef #ifdef DEBUG_NODEIDS - , fanSubscribedNodeId = nid + , fanSubscribedNodeId = unsafeNodeId f #endif } let !self = (k, subscribed) @@ -1642,9 +1644,6 @@ getSwitchSubscribed s sub = do when (isJust parentOcc) $ scheduleClear occRef weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized" (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed -#ifdef DEBUG_NODEIDS - nid <- liftIO newNodeId -#endif let !subscribed = SwitchSubscribed { switchSubscribedCachedSubscribed = switchSubscribed s , switchSubscribedOccurrence = occRef @@ -1657,7 +1656,7 @@ getSwitchSubscribed s sub = do , switchSubscribedCurrentParent = subscriptionRef , switchSubscribedWeakSelf = weakSelf #ifdef DEBUG_NODEIDS - , switchSubscribedNodeId = nid + , switchSubscribedNodeId = unsafeNodeId s #endif } liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf" @@ -1702,9 +1701,6 @@ getCoincidenceSubscribed c sub = do scheduleClear innerSubdRef weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented" (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed -#ifdef DEBUG_NODEIDS - nid <- liftIO newNodeId -#endif let subscribed = CoincidenceSubscribed { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c , coincidenceSubscribedOccurrence = occRef @@ -1715,7 +1711,7 @@ getCoincidenceSubscribed c sub = do , coincidenceSubscribedInnerParent = innerSubdRef , coincidenceSubscribedWeakSelf = weakSelf #ifdef DEBUG_NODEIDS - , coincidenceSubscribedNodeId = nid + , coincidenceSubscribedNodeId = unsafeNodeId c #endif } liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed" @@ -2089,13 +2085,12 @@ newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) } fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v -fanG e = unsafePerformIO $ do - ref <- newIORef Nothing +fanG e = let f = Fan { fanParent = e - , fanSubscribed = ref + , fanSubscribed = unsafeNewIORef e Nothing } - pure $ EventSelectorG $ \k -> eventFan k f + in EventSelectorG $ \k -> eventFan k f runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x () runHoldInits holdInitRef dynInitRef mergeInitRef = do