Commit 5e392a56 authored by simonpj's avatar simonpj

[project @ 2002-09-09 12:55:52 by simonpj]

--------------------------------------
	Attach inline pragmas to class methods
	--------------------------------------

This fix makes INLINE pragmas on method bindings (in class
or instance decls) work properly.

It seems to have been hanging around in my tree for some time.
To be on the safe side, let's not merge this into 5.04.1, although
it should be fine (an an improvement).
parent a63bd8f5
......@@ -17,7 +17,7 @@ import HsSyn ( TyClDecl(..), Sig(..), MonoBinds(..),
getClassDeclSysNames, placeHolderType
)
import BasicTypes ( RecFlag(..), StrictnessMark(..) )
import RnHsSyn ( RenamedTyClDecl,
import RnHsSyn ( RenamedTyClDecl, RenamedSig,
RenamedClassOpSig, RenamedMonoBinds,
maybeGenericMatch
)
......@@ -46,11 +46,11 @@ import Class ( classTyVars, classBigSig, classTyCon,
import TyCon ( tyConGenInfo )
import MkId ( mkDictSelId, mkDataConId, mkDataConWrapId, mkDefaultMethodId )
import DataCon ( mkDataCon )
import Id ( Id, idType, idName, setIdLocalExported )
import Id ( Id, idType, idName, setIdLocalExported, setInlinePragma )
import Module ( Module )
import Name ( Name, NamedThing(..) )
import NameEnv ( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, plusNameEnv )
import NameSet ( emptyNameSet )
import NameSet ( emptyNameSet, unitNameSet )
import Outputable
import Var ( TyVar )
import CmdLineOpts
......@@ -385,7 +385,7 @@ tcDefMeth clas tyvars binds_in prags op_item@(sel_id, DefMeth dm_name)
mkMethodBind origin clas inst_tys binds_in op_item `thenTc` \ (dm_inst, meth_info) ->
tcMethodBind xtve clas_tyvars theta
[this_dict] meth_info `thenTc` \ (defm_bind, insts_needed) ->
[this_dict] prags meth_info `thenTc` \ (defm_bind, insts_needed) ->
tcAddErrCtxt (defltMethCtxt clas) $
......@@ -436,10 +436,11 @@ tcMethodBind
-> TcThetaType -- Available theta; it's just used for the error message
-> [Inst] -- Available from context, used to simplify constraints
-- from the method body
-> [RenamedSig] -- Pragmas (e.g. inline pragmas)
-> (Id, TcSigInfo, RenamedMonoBinds) -- Details of this method
-> TcM (TcMonoBinds, LIE)
tcMethodBind xtve inst_tyvars inst_theta avail_insts
tcMethodBind xtve inst_tyvars inst_theta avail_insts prags
(sel_id, meth_sig, meth_bind)
=
-- Check the bindings; first adding inst_tyvars to the envt
......@@ -473,11 +474,22 @@ tcMethodBind xtve inst_tyvars inst_theta avail_insts
checkSigTyVars all_tyvars `thenTc` \ all_tyvars' ->
let
-- Attach inline pragmas as appropriate
(final_meth_id, inlines)
| (InlineSig inl _ phase _ : _) <- filter is_inline prags
= (meth_id `setInlinePragma` phase,
if inl then unitNameSet (idName meth_id) else emptyNameSet)
| otherwise
= (meth_id, emptyNameSet)
is_inline (InlineSig _ name _ _) = name == idName sel_id
is_inline other = False
meth_tvs' = take (length meth_tvs) all_tyvars'
poly_meth_bind = AbsBinds meth_tvs'
(map instToId meth_dicts)
[(meth_tvs', meth_id, local_meth_id)]
emptyNameSet -- Inlines?
[(meth_tvs', final_meth_id, local_meth_id)]
inlines
(lie_binds `andMonoBinds` meth_bind)
in
returnTc (poly_meth_bind, lie)
......
......@@ -569,7 +569,7 @@ tcInstDecl2 (InstInfo { iDFunId = dfun_id, iBinds = monobinds, iPrags = uprags }
sc_dicts ++ meth_insts
xtve = inst_tyvars `zip` inst_tyvars'
tc_meth = tcMethodBind xtve inst_tyvars' dfun_theta' avail_insts
tc_meth = tcMethodBind xtve inst_tyvars' dfun_theta' avail_insts uprags
in
mapAndUnzipTc tc_meth meth_infos `thenTc` \ (meth_binds_s, meth_lie_s) ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment