Opened 2 years ago

Closed 2 years ago

#7582 closed bug (invalid)

Created thunk gets immediately evaluated

Reported by: tibbe Owned by:
Priority: normal Milestone:
Component: Compiler Version: 7.6.1
Keywords: Cc:
Operating System: Unknown/Multiple Architecture: Unknown/Multiple
Type of failure: None/Unknown Test Case:
Blocked By: Blocking:
Related Tickets: Differential Revisions:

Description

The following function, taken from the unordered-containers package, is obviously strict in go:

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  -- TODO: Split test in two
        | 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
{-# INLINABLE lookup #-}

Here's a small test program that uses lookup:

module Test (test) where

import qualified Data.HashMap.Strict as HM

test :: Int -> HM.HashMap Int Int -> Maybe Int
test k m = HM.lookup k m

And here's part of the Core:

$slookup :: forall v_aBR. Int -> HashMap Int v_aBR -> Maybe v_aBR
$slookup =
  \ (@ v_XBT) (k0_aBU :: Int) ->
    let {
      w_sM9 :: Hash
      w_sM9 =
        case defaultSalt of _ { I# x#_aJq ->
        case k0_aBU of _ { I# i_aJv ->
        case {__pkg_ccall hashable-1.2.0.5 hashable_wang_64 Word#
                                               -> State# RealWorld -> (# State# RealWorld, Word# #)}_aJu
               (xor# (int2Word# x#_aJq) (int2Word# i_aJv)) realWorld#
        of _ { (# _, ds1_aJA #) ->
        W# ds1_aJA
        }
        }
        } } in
    \ (w1_sMl :: HashMap Int v_XBT) ->
      case w_sM9 of _ { W# ww_sMb ->
      case k0_aBU of _ { I# ww1_sMf ->
      $wpoly_go @ v_XBT ww_sMb ww1_sMf 0 w1_sMl
      }
      }

test :: Int -> HashMap Int Int -> Maybe Int
test =
  \ (k_asN :: Int) (m_asO :: HashMap Int Int) ->
    $slookup @ Int k_asN m_asO

Note how w_sM9, corresponding to h0 in the source program, has wedged itself in-between two lambdas, causing unnecessary allocation. If we put a bang on h0 in the definition of lookup, we get this much better looking Core:

$w$slookup
  :: forall v_aBQ. Int# -> HashMap Int v_aBQ -> Maybe v_aBQ
$w$slookup =
  \ (@ v_aBQ) (ww_sMt :: Int#) ->
    case defaultSalt of _ { I# x#_aJt ->
    case {__pkg_ccall hashable-1.2.0.5 hashable_wang_64 Word#
                                               -> State# RealWorld -> (# State# RealWorld, Word# #)}_aJx
           (xor# (int2Word# x#_aJt) (int2Word# ww_sMt)) realWorld#
    of _ { (# _, ds1_aJD #) ->
    \ (w_sMo :: HashMap Int v_aBQ) ->
      $wpoly_go @ v_aBQ ds1_aJD ww_sMt 0 w_sMo
    }
    }

$slookup :: forall v_aBQ. Int -> HashMap Int v_aBQ -> Maybe v_aBQ
$slookup =
  \ (@ v_aBQ) (w_sMr :: Int) ->
    case w_sMr of _ { I# ww_sMt -> $w$slookup @ v_aBQ ww_sMt }

test :: Int -> HashMap Int Int -> Maybe Int
test =
  \ (k_asM :: Int) (m_asN :: HashMap Int Int) ->
    case k_asM of _ { I# ww_sMt -> $w$slookup @ Int ww_sMt m_asN }

This bothers me. h0 gets immediately passed to go, which is strict. Why does it get boxed? Why does the extra bang make a difference?

Change History (2)

comment:1 Changed 2 years ago by simonmar

  • difficulty set to Unknown

go takes 4 arguments, but it is passed only 3 in the call. So in fact h0 is not strict here: the bang patterns only evaluate when the function is fully applied. Try eta-expanding?

comment:2 Changed 2 years ago by simonpj

  • Resolution set to invalid
  • Status changed from new to closed

Yes, consider (lookup undefined seq True). In your original program this should yield True. When you add the bang on h0 you change the semantics so that the expression yields undefined. Different semantics, different code. I don't see how to get better behaviour while preserving semantics. Please re-open if you can see a way.

Simon

Note: See TracTickets for help on using tickets.