Store ModIface exports in an arraywip/D4170

Summary:
To lessen cascading changes, the old field name mi_exports (returning a list) is
exported as an accessor function and the field is replaced with mi_exports_arr.

There are many more lists that would likely benefit from the same treatment,
but one thing at a time.

Test Plan: Check gipedia

Reviewers: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D4170

1 files changed, 23 insertions, 0 deletions

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index a7bbfd51ad..9dfe2d7d80 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -73,6 +73,8 @@ import SrcLoc
 
 import Foreign
 import Data.Array
+import Data.Array.IO
+import Data.Array.Unsafe
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Internal as BS
 import qualified Data.ByteString.Unsafe   as BS
@@ -93,6 +95,7 @@ import System.IO.Unsafe         ( unsafeInterleaveIO )
 import System.IO.Error          ( mkIOError, eofErrorType )
 import GHC.Real                 ( Ratio(..) )
 import GHC.Serialized
+import Data.Foldable
 
 type BinArray = ForeignPtr Word8
 
@@ -413,6 +416,26 @@ instance Binary a => Binary [a] where
             loop n = do a <- get bh; as <- loop (n-1); return (a:as)
         loop len
 
+instance Binary a => Binary (Array Int a) where
+    put_ bh l = do
+        let len = length l
+        if (len < 0xff)
+          then putByte bh (fromIntegral len :: Word8)
+          else do putByte bh 0xff; put_ bh (fromIntegral len :: Word32)
+        mapM_ (put_ bh) l
+    get bh = do
+        b <- getByte bh
+        len <- if b == 0xff
+                  then get bh
+                  else return (fromIntegral b :: Word32)
+        let last_index = fromIntegral len - 1
+        arr <- newIOArray_ (0, last_index)
+        when (len > 0) $ for_ [0..last_index] $
+          \i -> get bh >>= writeArray arr i
+        unsafeFreeze arr
+      where
+        newIOArray_ = newArray_ :: (Int, Int) -> IO (IOArray Int a)
+
 instance (Binary a, Binary b) => Binary (a,b) where
     put_ bh (a,b) = do put_ bh a; put_ bh b
     get bh        = do a <- get bh