Permalink
Browse files

Do not inherit "SPECIALISE instance" for INLINE default methods

Nor should we generate specialised dfuns;
see Note [SPECIALISE instance pragmas]
  • Loading branch information...
1 parent 16b6283 commit 51d89a55c3b98fab0bcbdf69020e9527dfb130d9 @simonpj simonpj committed Jan 18, 2012
Showing with 21 additions and 16 deletions.
  1. +21 −16 compiler/typecheck/TcInstDcls.lhs
@@ -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)
@@ -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
@@ -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]
@@ -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)] #-}
@@ -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

0 comments on commit 51d89a5

Please sign in to comment.