[GHC] #5928: INLINABLE fails to specialize in presence of simple wrapper

GHC ghc-devs at haskell.org
Sun Jan 17 03:21:46 UTC 2016


#5928: INLINABLE fails to specialize in presence of simple wrapper
-------------------------------------+-------------------------------------
        Reporter:  tibbe             |                Owner:
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:  8.0.1
       Component:  Compiler          |              Version:  7.4.1
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
 Type of failure:  Runtime           |  Unknown/Multiple
  performance bug                    |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------
Description changed by danilo2:

Old description:

> If a function marked as `INLINABLE` is called indirectly through a simple
> wrapper defined in a different module, specialization never happens (i.e.
> none of the dictionaries are removed.)
>
> Here's an example where it fails. First, the simple wrapper module:
>
> {{{
> module Repro where
>
> import Data.Hashable
> import Data.HashMap.Strict as M
>
> infixl 9  !
> (!) :: (Eq a, Hashable a) => M.HashMap a b -> a -> b
> m ! x = case M.lookup x m of  -- lookup is INLINABLE
>     Just y -> y
>     Nothing -> error "Repro.!"
> }}}
>
> and then the call site:
>
> {{{
> module Test (test) where
>
> import Data.HashMap.Strict as M
>
> import Repro
>
> test :: M.HashMap Int Int -> Int
> test m = m ! 42
> }}}
>
> To compile the code you need to `cabal install unordered-containers`. The
> relevant function (which is not getting specialized) from unordered-
> containers is:
>
> {{{
> lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
> lookup k0 = go h0 k0 0
>   where
>     h0 = hash k0
>     go !_ !_ !_ Empty = Nothing
>     go h k _ (Leaf hx (L kx x))
>         | h == hx && k == kx = Just x
>         | otherwise          = Nothing
>     go h k s (BitmapIndexed b v)
>         | b .&. m == 0 = Nothing
>         | otherwise    = go h k (s+bitsPerSubkey) (A.index v (sparseIndex
> b m))
>       where m = mask h s
>     go h k s (Full v) = go h k (s+bitsPerSubkey) (A.index v (index h s))
>     go h k _ (Collision hx v)
>         | h == hx   = lookupInArray k v
>         | otherwise = Nothing
> #if __GLASGOW_HASKELL__ >= 700
> {-# INLINABLE lookup #-}
> #endif
> }}}
>
> If `test` calls `lookup` directly, without using the `(!)` wrapper,
> things get specialized. Manually marking `(!)` as `INLINABLE` works, but
> users shouldn't have to do that.
>
> The core for `Repro` and `Test` is:
>
> {{{
> $ ghc -O2 Test.hs -fforce-recomp -ddump-simpl
> [1 of 2] Compiling Repro            ( Repro.hs, Repro.o )
>
> ==================== Tidy Core ====================
> Result size = 28
>
> lvl_rNZ :: [GHC.Types.Char]
> [GblId]
> lvl_rNZ = GHC.CString.unpackCString# "Repro.!"
>
> Repro.!1 :: forall b_aBU. b_aBU
> [GblId, Str=DmdType b]
> Repro.!1 = \ (@ b_aBU) -> GHC.Err.error @ b_aBU lvl_rNZ
>
> Repro.!
>   :: forall a_atJ b_atK.
>      (GHC.Classes.Eq a_atJ, Data.Hashable.Hashable a_atJ) =>
>      Data.HashMap.Base.HashMap a_atJ b_atK -> a_atJ -> b_atK
> [GblId,
>  Arity=4,
>  Str=DmdType LLLL,
>  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=4, Value=True,
>          ConLike=True, Cheap=True, Expandable=True,
>          Guidance=IF_ARGS [0 0 0 0] 70 0}]
> Repro.! =
>   \ (@ a_aBT)
>     (@ b_aBU)
>     ($dEq_aBV :: GHC.Classes.Eq a_aBT)
>     ($dHashable_aBW :: Data.Hashable.Hashable a_aBT)
>     (m_atL :: Data.HashMap.Base.HashMap a_aBT b_aBU)
>     (x_atM :: a_aBT) ->
>     case Data.HashMap.Base.lookup
>            @ a_aBT @ b_aBU $dEq_aBV $dHashable_aBW x_atM m_atL
>     of _ {
>       Data.Maybe.Nothing -> Repro.!1 @ b_aBU;
>       Data.Maybe.Just y_atN -> y_atN
>     }
>

>
> [2 of 2] Compiling Test             ( Test.hs, Test.o )
>
> ==================== Tidy Core ====================
> Result size = 20
>
> Test.test2 :: GHC.Types.Int
> [GblId,
>  Caf=NoCafRefs,
>  Str=DmdType m,
>  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
>          ConLike=True, Cheap=True, Expandable=True,
>          Guidance=IF_ARGS [] 10 110}]
> Test.test2 = GHC.Types.I# 42
>
> Test.test1
>   :: Data.HashMap.Base.HashMap GHC.Types.Int GHC.Types.Int
>      -> Data.Maybe.Maybe GHC.Types.Int
> [GblId,
>  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
>          ConLike=False, Cheap=False, Expandable=False,
>          Guidance=IF_ARGS [] 40 0}]
> Test.test1 =
>   Data.HashMap.Base.lookup
>     @ GHC.Types.Int
>     @ GHC.Types.Int
>     GHC.Classes.$fEqInt
>     Data.Hashable.$fHashableInt
>     Test.test2
>
> Test.test
>   :: Data.HashMap.Base.HashMap GHC.Types.Int GHC.Types.Int
>      -> GHC.Types.Int
> [GblId,
>  Arity=1,
>  Str=DmdType L,
>  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
>          ConLike=True, Cheap=True, Expandable=True,
>          Guidance=IF_ARGS [0] 40 0}]
> Test.test =
>   \ (m_aPx
>        :: Data.HashMap.Base.HashMap GHC.Types.Int GHC.Types.Int) ->
>     case Test.test1 m_aPx of _ {
>       Data.Maybe.Nothing -> Repro.!1 @ GHC.Types.Int;
>       Data.Maybe.Just y_atN -> y_atN
>     }
> }}}
>
> **EDIT**
>
> There is yet another funny issue here. If I try to compile the modules
> like so: `time ghc -O2 -fenable-rewrite-rules -ddump-spec B.hs` GHC
> prints the following lines and hangs forever:
>
> {{{
>
> [1 of 2] Compiling A                ( A.hs, A.o )
>
> ==================== Specialise ====================
> Result size of Specialise
>   = {terms: 60, types: 80, coercions: 3,048,032}
>
> Rec {
> $dShow_a20B :: Show String
> [LclId,
>  Str=DmdType,
>  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
>          WorkFree=True, Expandable=True,
>          Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
> $dShow_a20B = GHC.Show.$fShow[]_$s$fShow[]1
>
> $dPerfC1_a1Rk :: PerfC1 Int
> [LclId,
>  Arity=1,
>  Str=DmdType,
>  Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
>          WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
>
> }}}

New description:

 If a function marked as `INLINABLE` is called indirectly through a simple
 wrapper defined in a different module, specialization never happens (i.e.
 none of the dictionaries are removed.)

 Here's an example where it fails. First, the simple wrapper module:

 {{{
 module Repro where

 import Data.Hashable
 import Data.HashMap.Strict as M

 infixl 9  !
 (!) :: (Eq a, Hashable a) => M.HashMap a b -> a -> b
 m ! x = case M.lookup x m of  -- lookup is INLINABLE
     Just y -> y
     Nothing -> error "Repro.!"
 }}}

 and then the call site:

 {{{
 module Test (test) where

 import Data.HashMap.Strict as M

 import Repro

 test :: M.HashMap Int Int -> Int
 test m = m ! 42
 }}}

 To compile the code you need to `cabal install unordered-containers`. The
 relevant function (which is not getting specialized) from unordered-
 containers is:

 {{{
 lookup :: (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
 lookup k0 = go h0 k0 0
   where
     h0 = hash k0
     go !_ !_ !_ Empty = Nothing
     go h k _ (Leaf hx (L kx x))
         | h == hx && k == kx = Just x
         | otherwise          = Nothing
     go h k s (BitmapIndexed b v)
         | b .&. m == 0 = Nothing
         | otherwise    = go h k (s+bitsPerSubkey) (A.index v (sparseIndex
 b m))
       where m = mask h s
     go h k s (Full v) = go h k (s+bitsPerSubkey) (A.index v (index h s))
     go h k _ (Collision hx v)
         | h == hx   = lookupInArray k v
         | otherwise = Nothing
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE lookup #-}
 #endif
 }}}

 If `test` calls `lookup` directly, without using the `(!)` wrapper, things
 get specialized. Manually marking `(!)` as `INLINABLE` works, but users
 shouldn't have to do that.

 The core for `Repro` and `Test` is:

 {{{
 $ ghc -O2 Test.hs -fforce-recomp -ddump-simpl
 [1 of 2] Compiling Repro            ( Repro.hs, Repro.o )

 ==================== Tidy Core ====================
 Result size = 28

 lvl_rNZ :: [GHC.Types.Char]
 [GblId]
 lvl_rNZ = GHC.CString.unpackCString# "Repro.!"

 Repro.!1 :: forall b_aBU. b_aBU
 [GblId, Str=DmdType b]
 Repro.!1 = \ (@ b_aBU) -> GHC.Err.error @ b_aBU lvl_rNZ

 Repro.!
   :: forall a_atJ b_atK.
      (GHC.Classes.Eq a_atJ, Data.Hashable.Hashable a_atJ) =>
      Data.HashMap.Base.HashMap a_atJ b_atK -> a_atJ -> b_atK
 [GblId,
  Arity=4,
  Str=DmdType LLLL,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=4, Value=True,
          ConLike=True, Cheap=True, Expandable=True,
          Guidance=IF_ARGS [0 0 0 0] 70 0}]
 Repro.! =
   \ (@ a_aBT)
     (@ b_aBU)
     ($dEq_aBV :: GHC.Classes.Eq a_aBT)
     ($dHashable_aBW :: Data.Hashable.Hashable a_aBT)
     (m_atL :: Data.HashMap.Base.HashMap a_aBT b_aBU)
     (x_atM :: a_aBT) ->
     case Data.HashMap.Base.lookup
            @ a_aBT @ b_aBU $dEq_aBV $dHashable_aBW x_atM m_atL
     of _ {
       Data.Maybe.Nothing -> Repro.!1 @ b_aBU;
       Data.Maybe.Just y_atN -> y_atN
     }



 [2 of 2] Compiling Test             ( Test.hs, Test.o )

 ==================== Tidy Core ====================
 Result size = 20

 Test.test2 :: GHC.Types.Int
 [GblId,
  Caf=NoCafRefs,
  Str=DmdType m,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=True,
          ConLike=True, Cheap=True, Expandable=True,
          Guidance=IF_ARGS [] 10 110}]
 Test.test2 = GHC.Types.I# 42

 Test.test1
   :: Data.HashMap.Base.HashMap GHC.Types.Int GHC.Types.Int
      -> Data.Maybe.Maybe GHC.Types.Int
 [GblId,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
          ConLike=False, Cheap=False, Expandable=False,
          Guidance=IF_ARGS [] 40 0}]
 Test.test1 =
   Data.HashMap.Base.lookup
     @ GHC.Types.Int
     @ GHC.Types.Int
     GHC.Classes.$fEqInt
     Data.Hashable.$fHashableInt
     Test.test2

 Test.test
   :: Data.HashMap.Base.HashMap GHC.Types.Int GHC.Types.Int
      -> GHC.Types.Int
 [GblId,
  Arity=1,
  Str=DmdType L,
  Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
          ConLike=True, Cheap=True, Expandable=True,
          Guidance=IF_ARGS [0] 40 0}]
 Test.test =
   \ (m_aPx
        :: Data.HashMap.Base.HashMap GHC.Types.Int GHC.Types.Int) ->
     case Test.test1 m_aPx of _ {
       Data.Maybe.Nothing -> Repro.!1 @ GHC.Types.Int;
       Data.Maybe.Just y_atN -> y_atN
     }
 }}}

--

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/5928#comment:28>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler


More information about the ghc-tickets mailing list