#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