compiler/iface: compress .hi fileswip/D1159

Summary:
Compress all interface files generated by the compiler with LZ4. While
having an extremely small amount of code, LZ4 is both very fast at
compression and decompression while having quite good space saving
properties.

Non-scientific size test: size of stage2 compiler .hi files:

`find ./compiler/stage2 -type f -iname '*.hi' -exec du -ch {} + | grep total$`

Without this patch: 22MB of .hi files for stage2.
With this patch: 9.2MB of .hi files for stage2.

Signed-off-by: Austin Seipp <austin@well-typed.com>

Test Plan: I ran `./validate`

Reviewers: hvr, bgamari, thomie

Subscribers: duncan

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

1 files changed, 18 insertions, 19 deletions

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 8f0d8e50dc..e06891da11 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -70,10 +70,12 @@ import FastMutInt
 import Fingerprint
 import BasicTypes
 import SrcLoc
+import qualified LZ4 as LZ4
 
 import Foreign
 import Data.Array
 import Data.ByteString (ByteString)
+import qualified Data.ByteString          as B
 import qualified Data.ByteString.Internal as BS
 import qualified Data.ByteString.Unsafe   as BS
 import Data.IORef
@@ -81,8 +83,7 @@ import Data.Char                ( ord, chr )
 import Data.Time
 import Data.Typeable
 import Data.Typeable.Internal
-import Control.Monad            ( when )
-import System.IO as IO
+import Control.Monad            ( when, liftM )
 import System.IO.Unsafe         ( unsafeInterleaveIO )
 import System.IO.Error          ( mkIOError, eofErrorType )
 import GHC.Real                 ( Ratio(..) )
@@ -184,29 +185,27 @@ isEOFBin (BinMem _ ix_r sz_r _) = do
 
 writeBinMem :: BinHandle -> FilePath -> IO ()
 writeBinMem (BinMem _ ix_r _ arr_r) fn = do
-  h <- openBinaryFile fn WriteMode
   arr <- readIORef arr_r
   ix  <- readFastMutInt ix_r
-  withForeignPtr arr $ \p -> hPutBuf h p ix
-  hClose h
+  let bs = LZ4.compress $ BS.fromForeignPtr arr 0 ix
+  case bs of
+    Nothing -> error "Binary.writeBinMem: compression failed"
+    Just x  -> B.writeFile fn x
 
 readBinMem :: FilePath -> IO BinHandle
 -- Return a BinHandle with a totally undefined State
 readBinMem filename = do
-  h <- openBinaryFile filename ReadMode
-  filesize' <- hFileSize h
-  let filesize = fromIntegral filesize'
-  arr <- mallocForeignPtrBytes (filesize*2)
-  count <- withForeignPtr arr $ \p -> hGetBuf h p filesize
-  when (count /= filesize) $
-       error ("Binary.readBinMem: only read " ++ show count ++ " bytes")
-  hClose h
-  arr_r <- newIORef arr
-  ix_r <- newFastMutInt
-  writeFastMutInt ix_r 0
-  sz_r <- newFastMutInt
-  writeFastMutInt sz_r filesize
-  return (BinMem noUserData ix_r sz_r arr_r)
+  bs <- liftM LZ4.decompress (B.readFile filename)
+  case bs of
+    Nothing -> error "Binary.readBinMem: decompression failed"
+    Just x  -> do
+      let (arr, ix, size) = BS.toForeignPtr x
+      arr_r <- newIORef arr
+      ix_r <- newFastMutInt
+      writeFastMutInt ix_r ix
+      sz_r <- newFastMutInt
+      writeFastMutInt sz_r size
+      return (BinMem noUserData ix_r sz_r arr_r)
 
 fingerprintBinMem :: BinHandle -> IO Fingerprint
 fingerprintBinMem (BinMem _ ix_r _ arr_r) = do