diff options
author | doyougnu <jeffrey.young@iohk.io> | 2022-12-12 14:37:00 -0500 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-12-23 19:10:09 -0500 |
commit | aebef31cd8857749c7e25fe4b0d3ce4e12ae225a (patch) | |
tree | eb40413e7c7c32d00c9b9090a1963babc6e5cbea | |
parent | 36c9f23c9dc52928b5d2971f38f6e0b15e38528e (diff) | |
download | haskell-aebef31cd8857749c7e25fe4b0d3ce4e12ae225a.tar.gz |
add GHC.Utils.Binary.foldGet' and use for Iface
A minor optimization to remove lazy IO and a lazy accumulator
strictify foldGet'
IFace.Binary: use strict foldGet'
remove superfluous bang
-rw-r--r-- | compiler/GHC/Iface/Binary.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Utils/Binary.hs | 19 |
2 files changed, 19 insertions, 2 deletions
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs index 78045aa782..a1611fe263 100644 --- a/compiler/GHC/Iface/Binary.hs +++ b/compiler/GHC/Iface/Binary.hs @@ -292,7 +292,7 @@ getSymbolTable bh name_cache = do -- create an array of Names for the symbols and add them to the NameCache updateNameCache' name_cache $ \cache0 -> do mut_arr <- newArray_ (0, sz-1) :: IO (IOArray Int Name) - cache <- foldGet (fromIntegral sz) bh cache0 $ \i (uid, mod_name, occ) cache -> do + cache <- foldGet' (fromIntegral sz) bh cache0 $ \i (uid, mod_name, occ) cache -> do let mod = mkModule uid mod_name case lookupOrigNameCache cache mod occ of Just name -> do diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs index 99d5a01665..7d07cfeba0 100644 --- a/compiler/GHC/Utils/Binary.hs +++ b/compiler/GHC/Utils/Binary.hs @@ -44,7 +44,7 @@ module GHC.Utils.Binary castBin, withBinBuffer, - foldGet, + foldGet, foldGet', writeBinMem, readBinMem, @@ -332,6 +332,23 @@ foldGet n bh init_b f = go 0 init_b b' <- f i a b go (i+1) b' +foldGet' + :: Binary a + => Word -- n elements + -> BinHandle + -> b -- initial accumulator + -> (Word -> a -> b -> IO b) + -> IO b +{-# INLINE foldGet' #-} +foldGet' n bh init_b f = go 0 init_b + where + go i !b + | i == n = return b + | otherwise = do + !a <- get bh + b' <- f i a b + go (i+1) b' + -- ----------------------------------------------------------------------------- -- Low-level reading/writing of bytes |