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

4 files changed, 29 insertions, 14 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
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index b80900d0f0..41b2af8df9 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -658,7 +658,7 @@ test('T5837',
              # 2017-02-19                       59161648 (x64/Windows) - Unknown
              # 2017-04-21                       54985248 (x64/Windows) - Unknown
 
-           (wordsize(64), 56782344, 7)])
+           (wordsize(64), 52089424, 7)])
              # sample: 3926235424 (amd64/Linux, 15/2/2012)
              # 2012-10-02 81879216
              # 2012-09-20 87254264 amd64/Linux
@@ -695,6 +695,7 @@ test('T5837',
              # 2017-02-28 54151864  amd64/Linux Likely drift due to recent simplifier improvements
              # 2017-02-25 52625920  amd64/Linux Early inlining patch
              # 2017-09-06 56782344  amd64/Linux Drift manifest in unrelated LLVM patch
+             # 2017-10-24 52089424  amd64/linux Fix space leak in BinIface.getSymbolTable
       ],
       compile, ['-freduction-depth=50'])
 
@@ -1114,10 +1115,11 @@ test('T12707',
 test('T12150',
      [ only_ways(['optasm']),
        compiler_stats_num_field('bytes allocated',
-          [(wordsize(64), 78300680, 5)
+          [(wordsize(64), 73769936, 5)
           # initial:    70773000
           # 2017-08-25: 74358208  Refactor the Mighty Simplifier
           # 2017-08-25: 78300680  Drift
+          # 2017-10-25: 73769936  amd64/linux Fix space leak in BinIface.getSymbolTable
           ]),
      ],
     compile,
diff --git a/testsuite/tests/rename/should_compile/T1792_imports.stdout b/testsuite/tests/rename/should_compile/T1792_imports.stdout
index 9c502c61b5..b497d12ec6 100644
--- a/testsuite/tests/rename/should_compile/T1792_imports.stdout
+++ b/testsuite/tests/rename/should_compile/T1792_imports.stdout
@@ -1 +1 @@
-import qualified Data.ByteString as B ( readFile, putStr )
+import qualified Data.ByteString as B ( putStr, readFile )
diff --git a/testsuite/tests/rename/should_compile/T4239.stdout b/testsuite/tests/rename/should_compile/T4239.stdout
index 6e55a4ea26..a1f53d2c9e 100644
--- a/testsuite/tests/rename/should_compile/T4239.stdout
+++ b/testsuite/tests/rename/should_compile/T4239.stdout
@@ -1 +1 @@
-import T4239A ( type (:+++)((:---), X, (:+++)), (·) )
+import T4239A ( (·), type (:+++)((:---), X, (:+++)) )