Skip to content

Commit

Permalink
Do not inherit "SPECIALISE instance" for INLINE default methods
Browse files Browse the repository at this point in the history
Nor should we generate specialised dfuns;
see Note [SPECIALISE instance pragmas]
  • Loading branch information
Simon Peyton Jones committed Jan 18, 2012
1 parent 16b6283 commit 51d89a5
Showing 1 changed file with 21 additions and 16 deletions.
37 changes: 21 additions & 16 deletions compiler/typecheck/TcInstDcls.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -716,7 +716,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
-- Deal with 'SPECIALISE instance' pragmas
-- See Note [SPECIALISE instance pragmas]
; spec_info@(spec_inst_prags,_) <- tcSpecInstPrags dfun_id ibinds
; spec_inst_info <- tcSpecInstPrags dfun_id ibinds
-- Typecheck the methods
; (meth_ids, meth_binds)
Expand All @@ -725,7 +725,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
-- Those tyvars are inside the dfun_id's type, which is a bit
-- bizarre, but OK so long as you realise it!
tcInstanceMethods dfun_id clas inst_tyvars dfun_ev_vars
inst_tys spec_info
inst_tys spec_inst_info
op_items ibinds
-- Create the result bindings
Expand Down Expand Up @@ -776,7 +776,8 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
map Var meth_ids
export = ABE { abe_wrap = idHsWrapper, abe_poly = dfun_id_w_fun
, abe_mono = self_dict, abe_prags = SpecPrags spec_inst_prags }
, abe_mono = self_dict, abe_prags = noSpecPrags }
-- NB: noSpecPrags, see Note [SPECIALISE instance pragmas]
main_bind = AbsBinds { abs_tvs = inst_tyvars
, abs_ev_vars = dfun_ev_vars
, abs_exports = [export]
Expand Down Expand Up @@ -895,16 +896,12 @@ Consider
range (x,y) = ...
We do *not* want to make a specialised version of the dictionary
function. Rather, we want specialised versions of each method.
function. Rather, we want specialised versions of each *method*.
Thus we should generate something like this:
$dfIx :: (Ix a, Ix x) => Ix (a,b)
{- DFUN [$crange, ...] -}
$dfIx da db = Ix ($crange da db) (...other methods...)
$dfIxPair :: (Ix a, Ix x) => Ix (a,b)
$dfIxPair :: (Ix a, Ix b) => Ix (a,b)
{- DFUN [$crangePair, ...] -}
$dfIxPair = Ix ($crangePair da db) (...other methods...)
$dfIxPair da db = Ix ($crangePair da db) (...other methods...)
$crange :: (Ix a, Ix b) -> ((a,b),(a,b)) -> [(a,b)]
{-# SPECIALISE $crange :: ((Int,Int),(Int,Int)) -> [(Int,Int)] #-}
Expand Down Expand Up @@ -1067,14 +1064,22 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
mk_meth_spec_prags :: Id -> [LTcSpecPrag] -> TcSpecPrags
-- Adapt the SPECIALISE pragmas to work for this method Id
-- There are two sources:
-- * spec_inst_prags: {-# SPECIALISE instance :: <blah> #-}
-- These ones have the dfun inside, but [perhaps surprisingly]
-- the correct wrapper
-- * spec_prags_for_me: {-# SPECIALISE op :: <blah> #-}
-- * spec_prags_from_inst: derived from {-# SPECIALISE instance :: <blah> #-}
-- These ones have the dfun inside, but [perhaps surprisingly]
-- the correct wrapper.
mk_meth_spec_prags meth_id spec_prags_for_me
= SpecPrags (spec_prags_for_me ++
[ L loc (SpecPrag meth_id wrap inl)
| L loc (SpecPrag _ wrap inl) <- spec_inst_prags])
= SpecPrags (spec_prags_for_me ++ spec_prags_from_inst)
where
spec_prags_from_inst
| isInlinePragma (idInlinePragma meth_id)
= [] -- Do not inherit SPECIALISE from the instance if the
-- method is marked INLINE, because then it'll be inlined
-- and the specialisation would do nothing. (Indeed it'll provoke
-- a warning from the desugarer
| otherwise
= [ L loc (SpecPrag meth_id wrap inl)
| L loc (SpecPrag _ wrap inl) <- spec_inst_prags]
loc = getSrcSpan dfun_id
sig_fn = mkSigFun sigs
Expand Down

0 comments on commit 51d89a5

Please sign in to comment.