X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=a74b1b34167e42be49ebf5dbc2fb6e3de8f3110c;hb=b0c46848af7e431a2898af1a8aa1fbb0d2499137;hp=b353caad24559b20e1a9c61493420ecc89b7e61a;hpb=f493bc7c7325a3809dda3637c12e5d9383ba8117;p=ghc-hetmet.git diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index b353caa..a74b1b3 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -29,6 +29,7 @@ module HscTypes ( InteractiveContext(..), emptyInteractiveContext, icPrintUnqual, mkPrintUnqualified, extendInteractiveContext, + substInteractiveContext, ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache, emptyIfaceDepCache, @@ -92,9 +93,9 @@ import Rules ( RuleBase ) import CoreSyn ( CoreBind ) import VarEnv import VarSet -import Var +import Var hiding ( setIdType ) import Id -import Type ( TyThing(..) ) +import Type import Class ( Class, classSelIds, classATs, classTyCon ) import TyCon @@ -120,6 +121,7 @@ import StringBuffer ( StringBuffer ) import System.Time ( ClockTime ) import Data.IORef import Data.Array ( Array, array ) +import Data.List \end{code} @@ -521,9 +523,12 @@ data ModGuts mg_fix_env :: !FixityEnv, -- Fixity env, for things declared in -- this module + mg_inst_env :: InstEnv, -- Class instance enviroment fro + -- *home-package* modules (including + -- this one); c.f. tcg_inst_env mg_fam_inst_env :: FamInstEnv, -- Type-family instance enviroment -- for *home-package* modules (including - -- this one). c.f. tcg_fam_inst_env + -- this one); c.f. tcg_fam_inst_env mg_types :: !TypeEnv, mg_insts :: ![Instance], -- Instances @@ -688,6 +693,22 @@ extendInteractiveContext ictxt ids tyvars -- NB. must be this way around, because we want -- new ids to shadow existing bindings. ic_tyvars = ic_tyvars ictxt `unionVarSet` tyvars } + + +substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext +substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt +substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst = + let ids' = map (\id -> id `setIdType` substTy subst (idType id)) ids + subst_dom= varEnvKeys$ getTvSubstEnv subst + subst_ran= varEnvElts$ getTvSubstEnv subst + new_tvs = [ tv | Just tv <- map getTyVar_maybe subst_ran] + ic_tyvars'= (`delVarSetListByKey` subst_dom) + . (`extendVarSetList` new_tvs) + $ ic_tyvars ictxt + in ictxt { ic_tmp_ids = ids' + , ic_tyvars = ic_tyvars' } + + where delVarSetListByKey = foldl' delVarSetByKey \end{code} %************************************************************************ @@ -1254,37 +1275,38 @@ The following information is generated and consumed by the vectorisation subsystem. It communicates the vectorisation status of declarations from one module to another. -Why do we need both f and f_CC in the ModGuts/ModDetails/EPS version VectInfo +Why do we need both f and f_v in the ModGuts/ModDetails/EPS version VectInfo below? We need to know `f' when converting to IfaceVectInfo. However, during -closure conversion, we need to know `f_CC', whose `Var' we cannot lookup based +vectorisation, we need to know `f_v', whose `Var' we cannot lookup based on just the OccName easily in a Core pass. \begin{code} -- ModGuts/ModDetails/EPS version data VectInfo = VectInfo { - vectInfoCCVar :: VarEnv (Var , Var ), -- (f, f_CC) keyed on f - vectInfoCCTyCon :: NameEnv (TyCon , TyCon), -- (T, T_CC) keyed on T - vectInfoCCDataCon :: NameEnv (DataCon, DataCon), -- (C, C_CC) keyed on C - vectInfoCCIso :: NameEnv (TyCon , Var) -- (T, isoT) keyed on T + vectInfoVar :: VarEnv (Var , Var ), -- (f, f_v) keyed on f + vectInfoTyCon :: NameEnv (TyCon , TyCon), -- (T, T_v) keyed on T + vectInfoDataCon :: NameEnv (DataCon, DataCon), -- (C, C_v) keyed on C + vectInfoIso :: NameEnv (TyCon , Var) -- (T, isoT) keyed on T } -- all of this is always tidy, even in ModGuts -- ModIface version data IfaceVectInfo = IfaceVectInfo { - ifaceVectInfoCCVar :: [Name], - -- all variables in here have a closure-converted variant; - -- the name of the CC'ed variant is determined by `mkCloOcc' - ifaceVectInfoCCTyCon :: [Name], - -- all tycons in here have a closure-converted variant; - -- the name of the CC'ed variant and those of its data constructors are - -- determined by `mkCloTyConOcc' and `mkCloDataConOcc'; the names of - -- the isomorphisms is determined by `mkCloIsoOcc' - ifaceVectInfoCCTyConReuse :: [Name] - -- the closure-converted form of all the tycons in here coincids with + ifaceVectInfoVar :: [Name], + -- all variables in here have a vectorised variant; + -- the name of the vectorised variant is determined by `mkCloVect' + ifaceVectInfoTyCon :: [Name], + -- all tycons in here have a vectorised variant; + -- the name of the vectorised variant and those of its + -- data constructors are determined by `mkVectTyConOcc' + -- and `mkVectDataConOcc'; the names of + -- the isomorphisms is determined by `mkVectIsoOcc' + ifaceVectInfoTyConReuse :: [Name] + -- the vectorised form of all the tycons in here coincids with -- the unconverted from; the names of the isomorphisms is determined - -- by `mkCloIsoOcc' + -- by `mkVectIsoOcc' } noVectInfo :: VectInfo @@ -1292,10 +1314,10 @@ noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv plusVectInfo :: VectInfo -> VectInfo -> VectInfo plusVectInfo vi1 vi2 = - VectInfo (vectInfoCCVar vi1 `plusVarEnv` vectInfoCCVar vi2) - (vectInfoCCTyCon vi1 `plusNameEnv` vectInfoCCTyCon vi2) - (vectInfoCCDataCon vi1 `plusNameEnv` vectInfoCCDataCon vi2) - (vectInfoCCIso vi1 `plusNameEnv` vectInfoCCIso vi2) + VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2) + (vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2) + (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2) + (vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2) noIfaceVectInfo :: IfaceVectInfo noIfaceVectInfo = IfaceVectInfo [] [] []