#5928: INLINABLE fails to specialize in presence of simple wrapper
------------------------------+---------------------------------------------
Reporter: tibbe | Owner:
Type: bug | Status: new
Priority: normal | Component: Compiler
Version: 7.4.1 | Keywords:
Os: Unknown/Multiple | Architecture: Unknown/Multiple
Failure: None/Unknown | Testcase:
Blockedby: | Blocking:
Related: |
------------------------------+---------------------------------------------
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://hackage.haskell.org/trac/ghc/ticket/5928>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
