[GHC] #5928: INLINABLE fails to specialize in presence of simple wrapper
GHC
ghc-devs at haskell.org
Sun Jan 17 03:20:48 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
> }
> }}}
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
}
}}}
**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}]
}}}
--
--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/5928#comment:27>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
More information about the ghc-tickets
mailing list