diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2012-01-18 13:19:38 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2012-01-18 13:54:52 +0000 |
commit | 51d89a55c3b98fab0bcbdf69020e9527dfb130d9 (patch) | |
tree | d04bedb18e0245a4ba84135d639326fa87dda386 | |
parent | 16b628319561f54260b5d9fef070195c2047c5cd (diff) | |
download | haskell-51d89a55c3b98fab0bcbdf69020e9527dfb130d9.tar.gz |
Do not inherit "SPECIALISE instance" for INLINE default methods
Nor should we generate specialised dfuns;
see Note [SPECIALISE instance pragmas]
-rw-r--r-- | compiler/typecheck/TcInstDcls.lhs | 37 |
1 files changed, 21 insertions, 16 deletions
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs index ac9769ca25..2bf6164a31 100644 --- a/compiler/typecheck/TcInstDcls.lhs +++ b/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 |