diff options
author | Douglas Wilson <douglas.wilson@gmail.com> | 2017-10-25 14:20:06 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2017-10-25 15:47:25 -0400 |
commit | 1c15d8ed112bccf2635d571767733b2a26d8fb21 (patch) | |
tree | a952104e64fd898c8698a0c6e75c81c944a96651 /compiler/iface/BinIface.hs | |
parent | 980e1270ed7f681ef666ca36fe291cfb8613348c (diff) | |
download | haskell-1c15d8ed112bccf2635d571767733b2a26d8fb21.tar.gz |
Fix space leak in BinIface.getSymbolTable
Replace a call to mapAccumR, which uses linear stack space, with a
gadget that uses constant space.
Remove an unused parameter from fromOnDiskName.
The tests T1292_imports and T4239 are now reporting imported names in a
different order. I don't completely understand why, but I presume it is
because the symbol tables are now read more strictly. The new order
seems better in T1792_imports, and equally random in T4239.
There are several performance test improvements.
Test Plan: ./validate
Reviewers: austin, bgamari
Reviewed By: bgamari
Subscribers: alexbiehl, rwbarton, thomie
Differential Revision: https://phabricator.haskell.org/D4124
Diffstat (limited to 'compiler/iface/BinIface.hs')
-rw-r--r-- | compiler/iface/BinIface.hs | 33 |
1 files changed, 23 insertions, 10 deletions
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 969dc85c04..8ab2310bc4 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BinaryLiterals, CPP, ScopedTypeVariables #-} +{-# LANGUAGE BinaryLiterals, CPP, ScopedTypeVariables, BangPatterns #-} -- -- (c) The University of Glasgow 2002-2006 @@ -44,14 +44,18 @@ import FastString import Constants import Util +import Data.Array +import Data.Array.ST +import Data.Array.Unsafe import Data.Bits import Data.Char -import Data.List import Data.Word -import Data.Array import Data.IORef +import Data.Foldable import Control.Monad - +import Control.Monad.ST +import Control.Monad.Trans.Class +import qualified Control.Monad.Trans.State.Strict as State -- --------------------------------------------------------------------------- -- Reading and writing binary interface files @@ -261,15 +265,24 @@ getSymbolTable bh ncu = do sz <- get bh od_names <- sequence (replicate sz (get bh)) updateNameCache ncu $ \namecache -> - let arr = listArray (0,sz-1) names - (namecache', names) = - mapAccumR (fromOnDiskName arr) namecache od_names - in (namecache', arr) + runST $ flip State.evalStateT namecache $ do + mut_arr <- lift $ newSTArray_ (0, sz-1) + for_ (zip [0..] od_names) $ \(i, odn) -> do + (nc, !n) <- State.gets $ \nc -> fromOnDiskName nc odn + lift $ writeArray mut_arr i n + State.put nc + arr <- lift $ unsafeFreeze mut_arr + namecache' <- State.get + return (namecache', arr) + where + -- This binding is required because the type of newArray_ cannot be inferred + newSTArray_ :: forall s. (Int, Int) -> ST s (STArray s Int Name) + newSTArray_ = newArray_ type OnDiskName = (UnitId, ModuleName, OccName) -fromOnDiskName :: Array Int Name -> NameCache -> OnDiskName -> (NameCache, Name) -fromOnDiskName _ nc (pid, mod_name, occ) = +fromOnDiskName :: NameCache -> OnDiskName -> (NameCache, Name) +fromOnDiskName nc (pid, mod_name, occ) = let mod = mkModule pid mod_name cache = nsNames nc in case lookupOrigNameCache cache mod occ of |