Skip to content

INLINABLE fails to specialize in presence of simple wrapper

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
    }
Edited by danilo2
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information