Use record syntax for IVar

Summary:
Simply add record definition and getter for newtype IVar.
The only behavior change is that we added bang patterns for a few cases where
the IORef is already used. This was done for most cases before but missed in
a few places.
This almost no-op change will make it easier to change the definition of IVar
in profiled version in stacked change.

Reviewed By: josefs

Differential Revision: D19855621

fbshipit-source-id: eddbcba48c83f5ba9eb8b1ea312760568c390fd5

Haxl/Core/Fetch.hs

@@ -114,10 +114,10 @@ cachedWithInsert showFn insertFn Env{..} req = do
   mbRes <- DataCache.lookup req dataCache
   case mbRes of
     Nothing -> doFetch
-    Just (IVar cr) -> do
+    Just i@IVar{ivarRef = cr} -> do
       e <- readIORef cr
       case e of
-        IVarEmpty _ -> return (CachedNotFetched (IVar cr))
+        IVarEmpty _ -> return (CachedNotFetched i)
         IVarFull r -> do
           ifTrace flags 3 $ putStrLn $ case r of
             ThrowIO{} -> "Cached error: " ++ showFn req
@@ -287,7 +287,7 @@ cacheResultWithInsert showFn insertFn req val = GenHaxl $ \Env{..} -> do
       ivar <- newFullIVar result
       insertFn req ivar dataCache
       done result
-    Just (IVar cr) -> do
+    Just IVar{ivarRef = cr} -> do
       e <- readIORef cr
       case e of
         IVarEmpty _ -> corruptCache

Haxl/Core/Monad.hs

@@ -408,7 +408,9 @@ lengthJobList (JobCons _ _ _ j) = 1 + lengthJobList j
 
 -- | A synchronisation point.  It either contains a value, or a list
 -- of computations waiting for the value.
-newtype IVar u w a = IVar (IORef (IVarContents u w a))
+newtype IVar u w a = IVar
+  { ivarRef :: IORef (IVarContents u w a)
+  }
 
 data IVarContents u w a
   = IVarFull (ResultVal a w)
@@ -419,13 +421,17 @@ data IVarContents u w a
     -- faster (benchmarked with tests/MonadBench.hs).
 
 newIVar :: IO (IVar u w a)
-newIVar = IVar <$> newIORef (IVarEmpty JobNil)
+newIVar = do
+  ivarRef <- newIORef (IVarEmpty JobNil)
+  return IVar{..}
 
 newFullIVar :: ResultVal a w -> IO (IVar u w a)
-newFullIVar r = IVar <$> newIORef (IVarFull r)
+newFullIVar r = do
+  ivarRef <- newIORef (IVarFull r)
+  return IVar{..}
 
 getIVar :: IVar u w a -> GenHaxl u w a
-getIVar i@(IVar !ref) = GenHaxl $ \Env{..} -> do
+getIVar i@IVar{ivarRef = !ref} = GenHaxl $ \Env{..} -> do
   e <- readIORef ref
   case e of
     IVarFull (Ok a _wt) -> return (Done a)
@@ -435,18 +441,18 @@ getIVar i@(IVar !ref) = GenHaxl $ \Env{..} -> do
 
 -- Just a specialised version of getIVar, for efficiency in <*>
 getIVarApply :: IVar u w (a -> b) -> a -> GenHaxl u w b
-getIVarApply (IVar !ref) a = GenHaxl $ \Env{..} -> do
+getIVarApply i@IVar{ivarRef = !ref} a = GenHaxl $ \Env{..} -> do
   e <- readIORef ref
   case e of
     IVarFull (Ok f _wt) -> return (Done (f a))
     IVarFull (ThrowHaxl e _wt) -> return (Throw e)
     IVarFull (ThrowIO e) -> throwIO e
     IVarEmpty _ ->
-      return (Blocked (IVar ref) (Cont (getIVarApply (IVar ref) a)))
+      return (Blocked i (Cont (getIVarApply i a)))
 
 -- Another specialised version of getIVar, for efficiency in cachedComputation
 getIVarWithWrites :: IVar u w a -> GenHaxl u w a
-getIVarWithWrites (IVar !ref) = GenHaxl $ \Env{..} -> do
+getIVarWithWrites i@IVar{ivarRef = !ref} = GenHaxl $ \Env{..} -> do
   e <- readIORef ref
   case e of
     IVarFull (Ok a wt) -> do
@@ -457,10 +463,10 @@ getIVarWithWrites (IVar !ref) = GenHaxl $ \Env{..} -> do
       return  (Throw e)
     IVarFull (ThrowIO e) -> throwIO e
     IVarEmpty _ ->
-      return (Blocked (IVar ref) (Cont (getIVarWithWrites (IVar ref))))
+      return (Blocked i (Cont (getIVarWithWrites i)))
 
 putIVar :: IVar u w a -> ResultVal a w -> Env u w -> IO ()
-putIVar (IVar ref) a Env{..} = do
+putIVar IVar{ivarRef = !ref} a Env{..} = do
   e <- readIORef ref
   case e of
     IVarEmpty jobs -> do
@@ -474,7 +480,7 @@ putIVar (IVar ref) a Env{..} = do
 
 {-# INLINE addJob #-}
 addJob :: Env u w -> GenHaxl u w b -> IVar u w b -> IVar u w a -> IO ()
-addJob env !haxl !resultIVar (IVar !ref) =
+addJob env !haxl !resultIVar IVar{ivarRef = !ref} =
   modifyIORef' ref $ \contents ->
     case contents of
       IVarEmpty list -> IVarEmpty (JobCons env haxl resultIVar list)
@@ -921,7 +927,7 @@ dumpCacheAsHaskellFn fnName fnType cacheFn = do
   cache <- env dataCache  -- NB. dataCache, not memoCache.  We ignore memoized
                        -- results when dumping the cache.
   let
-    readIVar (IVar ref) = do
+    readIVar IVar{ivarRef = !ref} = do
       r <- readIORef ref
       case r of
         IVarFull (Ok a _) -> return (Just (Right a))

Haxl/Core/Run.hs

@@ -54,7 +54,7 @@ runHaxl env haxl = fst <$> runHaxlWithWrites env haxl
 
 runHaxlWithWrites :: forall u w a. Env u w -> GenHaxl u w a -> IO (a, [w])
 runHaxlWithWrites env@Env{..} haxl = do
-  result@(IVar resultRef) <- newIVar -- where to put the final result
+  result@IVar{ivarRef = resultRef} <- newIVar -- where to put the final result
   ifTraceLog <- do
     if trace flags < 3
     then return $ \_ -> return ()
@@ -67,7 +67,7 @@ runHaxlWithWrites env@Env{..} haxl = do
   let
     -- Run a job, and put its result in the given IVar
     schedule :: Env u w -> JobList u w -> GenHaxl u w b -> IVar u w b -> IO ()
-    schedule env@Env{..} rq (GenHaxl run) (IVar !ref) = do
+    schedule env@Env{..} rq (GenHaxl run) ivar@IVar{ivarRef = !ref} = do
       ifTraceLog $ printf "schedule: %d\n" (1 + lengthJobList rq)
       let {-# INLINE result #-}
           result r = do
@@ -109,8 +109,8 @@ runHaxlWithWrites env@Env{..} haxl = do
         Right (Throw ex) -> do
           wt <- readIORef writeLogsRef
           result (ThrowHaxl ex wt)
-        Right (Blocked ivar fn) -> do
-          addJob env (toHaxl fn) (IVar ref) ivar
+        Right (Blocked i fn) -> do
+          addJob env (toHaxl fn) ivar i
           reschedule env rq
 
     -- Here we have a choice:
@@ -178,7 +178,7 @@ runHaxlWithWrites env@Env{..} haxl = do
         _ -> do
           ifTraceLog $ printf "%d complete\n" (length comps)
           let
-              getComplete (CompleteReq a (IVar cr) allocs) = do
+              getComplete (CompleteReq a IVar{ivarRef = !cr} allocs) = do
                 when (allocs < 0) $ do
                   cur <- getAllocationCounter
                   setAllocationCounter (cur + allocs)