Re: [GHC] #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0

25 Sep 2018

      #15488: GHC takes up huge amount of memory when compiling accelerate 1.2.0
-------------------------------------+-------------------------------------
        Reporter:  noah              |                Owner:  tdammers
            Type:  bug               |               Status:  new
        Priority:  high              |            Milestone:  8.6.1
       Component:  Compiler          |              Version:  8.4.3
      Resolution:                    |             Keywords:
                                     |  accelerate,memory,compile
Operating System:  Linux             |         Architecture:  x86_64
                                     |  (amd64)
 Type of failure:  Compile-time      |            Test Case:  accelerate
  performance bug                    |  1.2.0
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by tdammers):

 Here's a reduced version:

 {{{#!haskell
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE PatternGuards       #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell     #-}
 {-# OPTIONS_HADDOCK hide #-}
 -- |
 -- Module      : Repro
 --
 -- based on Data.Array.Accelerate.Analysis.Hash from accelerate
 --
 -- Copyright   : [2017] Manuel M T Chakravarty, Gabriele Keller, Trevor L.
 McDonell
 -- License     : BSD3

 module Repro where

 import Data.ByteString.Builder
 import Data.ByteString.Builder.Extra
 import Data.Monoid
 import Foreign.C.Types
 import System.IO.Unsafe                                             (
 unsafePerformIO )
 import System.Mem.StableName                                        (
 hashStableName, makeStableName )
 import Prelude                                                      hiding
 ( exp )

 import Data.Array.Accelerate.Type
 import Data.Array.Accelerate.Analysis.Hash.TH

 {-# INLINE encodeSingleConst #-}
 encodeSingleConst :: SingleType t -> t -> Builder
 encodeSingleConst (NumSingleType t)    = encodeNumConst t
 encodeSingleConst (NonNumSingleType t) = encodeNonNumConst t

 {-# INLINE encodeVectorConst #-}
 encodeVectorConst :: VectorType t -> t -> Builder
 encodeVectorConst (Vector2Type t) (V2 a b)     = intHost $(hashQ "V2") <>
 encodeSingleConst t a <> encodeSingleConst t b
 encodeVectorConst (Vector3Type t) (V3 a b c)   = intHost $(hashQ "V3") <>
 encodeSingleConst t a <> encodeSingleConst t b <> encodeSingleConst t c
 encodeVectorConst (Vector4Type t) (V4 a b c d) = intHost $(hashQ "V4") <>
 encodeSingleConst t a <> encodeSingleConst t b <> encodeSingleConst t c <>
 encodeSingleConst t d
 encodeVectorConst (Vector8Type t) (V8 a b c d e f g h) =
   intHost $(hashQ "V8") <> encodeSingleConst t a <> encodeSingleConst t b
 <> encodeSingleConst t c <> encodeSingleConst t d
                         <> encodeSingleConst t e <> encodeSingleConst t f
 <> encodeSingleConst t g <> encodeSingleConst t h
 encodeVectorConst (Vector16Type t) (V16 a b c d e f g h i j k l m n o p) =
   intHost $(hashQ "V16") <> encodeSingleConst t a <> encodeSingleConst t b
 <> encodeSingleConst t c <> encodeSingleConst t d
                          <> encodeSingleConst t e <> encodeSingleConst t f
 <> encodeSingleConst t g <> encodeSingleConst t h
                          <> encodeSingleConst t i <> encodeSingleConst t j
 <> encodeSingleConst t k <> encodeSingleConst t l
                          <> encodeSingleConst t m <> encodeSingleConst t n
 <> encodeSingleConst t o <> encodeSingleConst t p

 {-# INLINE encodeNonNumConst #-}
 encodeNonNumConst :: NonNumType t -> t -> Builder
 encodeNonNumConst TypeBool{}   x          = intHost $(hashQ "Bool")   <>
 word8 (fromBool x)
 encodeNonNumConst TypeChar{}   x          = intHost $(hashQ "Char")   <>
 charUtf8 x
 encodeNonNumConst TypeCSChar{} (CSChar x) = intHost $(hashQ "CSChar") <>
 int8 x
 encodeNonNumConst TypeCUChar{} (CUChar x) = intHost $(hashQ "CUChar") <>
 word8 x
 encodeNonNumConst TypeCChar{}  (CChar  x) = intHost $(hashQ "CChar")  <>
 $( [e| int8 |] ) x

 {-# INLINE fromBool #-}
 fromBool :: Bool -> Word8
 fromBool True  = 1
 fromBool False = 0

 {-# INLINE encodeNumConst #-}
 encodeNumConst :: NumType t -> t -> Builder
 encodeNumConst (IntegralNumType t) = encodeIntegralConst t
 encodeNumConst (FloatingNumType t) = encodeFloatingConst t

 {-# INLINE encodeIntegralConst #-}
 encodeIntegralConst :: IntegralType t -> t -> Builder
 encodeIntegralConst TypeInt{}     x           = intHost $(hashQ "Int")
 <> intHost x
 encodeIntegralConst TypeInt8{}    x           = intHost $(hashQ "Int8")
 <> int8 x
 encodeIntegralConst TypeInt16{}   x           = intHost $(hashQ "Int16")
 <> int16Host x
 encodeIntegralConst TypeInt32{}   x           = intHost $(hashQ "Int32")
 <> int32Host x
 encodeIntegralConst TypeInt64{}   x           = intHost $(hashQ "Int64")
 <> int64Host x
 encodeIntegralConst TypeWord{}    x           = intHost $(hashQ "Word")
 <> wordHost x
 encodeIntegralConst TypeWord8{}   x           = intHost $(hashQ "Word8")
 <> word8 x
 encodeIntegralConst TypeWord16{}  x           = intHost $(hashQ "Word16")
 <> word16Host x
 encodeIntegralConst TypeWord32{}  x           = intHost $(hashQ "Word32")
 <> word32Host x
 encodeIntegralConst TypeWord64{}  x           = intHost $(hashQ "Word64")
 <> word64Host x
 encodeIntegralConst TypeCShort{}  (CShort x)  = intHost $(hashQ "CShort")
 <> int16Host x
 encodeIntegralConst TypeCUShort{} (CUShort x) = intHost $(hashQ "CUShort")
 <> word16Host x
 encodeIntegralConst TypeCInt{}    (CInt x)    = intHost $(hashQ "CInt")
 <> int32Host x
 encodeIntegralConst TypeCUInt{}   (CUInt x)   = intHost $(hashQ "CUInt")
 <> word32Host x
 encodeIntegralConst TypeCLLong{}  (CLLong x)  = intHost $(hashQ "CLLong")
 <> int64Host x
 encodeIntegralConst TypeCULLong{} (CULLong x) = intHost $(hashQ "CULLong")
 <> word64Host x
 encodeIntegralConst TypeCLong{}   (CLong x)   = intHost $(hashQ "CLong")
 <> $( [e| int64Host |] ) x
 encodeIntegralConst TypeCULong{}  (CULong x)  = intHost $(hashQ "CULong")
 <> $( [e| word64Host |] ) x

 {-# INLINE encodeFloatingConst #-}
 encodeFloatingConst :: FloatingType t -> t -> Builder
 encodeFloatingConst TypeHalf{}    (Half (CUShort x)) = intHost $(hashQ
 "Half")    <> word16Host x
 encodeFloatingConst TypeFloat{}   x                  = intHost $(hashQ
 "Float")   <> floatHost x
 encodeFloatingConst TypeDouble{}  x                  = intHost $(hashQ
 "Double")  <> doubleHost x
 encodeFloatingConst TypeCFloat{}  (CFloat x)         = intHost $(hashQ
 "CFloat")  <> floatHost x
 encodeFloatingConst TypeCDouble{} (CDouble x)        = intHost $(hashQ
 "CDouble") <> doubleHost x
 }}}

 In order to compile this, only 3 dependencies need to be downloaded:
 `base-orphans`, `half`, and `hashable`. This makes it easy to build this
 without Cabal, plug in different compilers, and compile files
 individually.

 Now, it turns out that the above sample, after everything it depends on
 has been compiled, takes about 30 seconds to compile (with full
 optimizations), and Core size blows up to about 140k terms. Changing the
 pragmas for `encodeSingleConst` and `encodeVectorConst` to `NOINLINE`
 however brings this down to only 3 seconds; changing only
 `encodeVectorConst` still gets us 20 seconds.

 Tentative hypothesis: simplifier somehow chokes on the TH-generated code
 in `encodeVectorConst`.

-- 
Ticket URL: http://ghc.haskell.org/trac/ghc/ticket/15488#comment:10
GHC http://www.haskell.org/ghc/
The Glasgow Haskell Compiler