Revert "Use unsafePerformIO better (#325)"

This reverts commit dc3ce15.

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