From b0c46848af7e431a2898af1a8aa1fbb0d2499137 Mon Sep 17 00:00:00 2001 From: Roman Leshchinskiy Date: Mon, 16 Jul 2007 03:57:39 +0000 Subject: [PATCH] Adapt interface file code for vectorisation For the most part, this patch simply renames functions which had been used for closure conversion and hence have CC in their name. It also changes the OccNames generated by vectorisation. --- compiler/basicTypes/OccName.lhs | 12 ++++---- compiler/iface/LoadIface.lhs | 12 ++++---- compiler/iface/MkIface.lhs | 20 ++++++------- compiler/iface/TcIface.lhs | 62 +++++++++++++++++++-------------------- compiler/main/HscTypes.lhs | 43 ++++++++++++++------------- compiler/vectorise/VectMonad.hs | 8 ++--- 6 files changed, 79 insertions(+), 78 deletions(-) diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index bc11cbd..c747bf8 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -32,7 +32,7 @@ module OccName ( mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc, mkInstTyCoOcc, mkEqPredCoOcc, - mkCloOcc, mkCloTyConOcc, mkCloDataConOcc, mkCloIsoOcc, + mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc, -- ** Deconstruction occNameFS, occNameString, occNameSpace, @@ -458,11 +458,11 @@ mkGenOcc2 = mk_simple_deriv varName "$gto" mkDataTOcc = mk_simple_deriv varName "$t" mkDataCOcc = mk_simple_deriv varName "$c" --- Closure conversion -mkCloOcc = mk_simple_deriv varName "$CC_" -mkCloTyConOcc = mk_simple_deriv tcName ":CC_" -mkCloDataConOcc = mk_simple_deriv dataName ":CD_" -mkCloIsoOcc = mk_simple_deriv varName "$CCiso_" +-- Vectorisation +mkVectOcc = mk_simple_deriv varName "$v_" +mkVectTyConOcc = mk_simple_deriv tcName ":V_" +mkVectDataConOcc = mk_simple_deriv dataName ":VD_" +mkVectIsoOcc = mk_simple_deriv varName "$VI_" mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ) diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 1ebbd39..6835fe6 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -677,14 +677,14 @@ pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes pprFix (occ,fix) = ppr fix <+> ppr occ pprVectInfo :: IfaceVectInfo -> SDoc -pprVectInfo (IfaceVectInfo { ifaceVectInfoCCVar = vars - , ifaceVectInfoCCTyCon = tycons - , ifaceVectInfoCCTyConReuse = tyconsReuse +pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars + , ifaceVectInfoTyCon = tycons + , ifaceVectInfoTyConReuse = tyconsReuse }) = vcat - [ ptext SLIT("CC'ed variables:") <+> hsep (map ppr vars) - , ptext SLIT("CC'ed tycons:") <+> hsep (map ppr tycons) - , ptext SLIT("CC reused tycons:") <+> hsep (map ppr tyconsReuse) + [ ptext SLIT("vectorised variables:") <+> hsep (map ppr vars) + , ptext SLIT("vectorised tycons:") <+> hsep (map ppr tycons) + , ptext SLIT("vectorised reused tycons:") <+> hsep (map ppr tyconsReuse) ] pprDeprecs NoDeprecs = empty diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 8213cb1..de191de 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -339,18 +339,18 @@ mkIface hsc_env maybe_old_iface deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x) ifFamInstTcName = ifaceTyConName . ifFamInstTyCon - flattenVectInfo (VectInfo { vectInfoCCVar = ccVar - , vectInfoCCTyCon = ccTyCon + flattenVectInfo (VectInfo { vectInfoVar = vVar + , vectInfoTyCon = vTyCon }) = IfaceVectInfo { - ifaceVectInfoCCVar = [ Var.varName v - | (v, _) <- varEnvElts ccVar], - ifaceVectInfoCCTyCon = [ tyConName t - | (t, t_CC) <- nameEnvElts ccTyCon - , t /= t_CC], - ifaceVectInfoCCTyConReuse = [ tyConName t - | (t, t_CC) <- nameEnvElts ccTyCon - , t == t_CC] + ifaceVectInfoVar = [ Var.varName v + | (v, _) <- varEnvElts vVar], + ifaceVectInfoTyCon = [ tyConName t + | (t, t_v) <- nameEnvElts vTyCon + , t /= t_v], + ifaceVectInfoTyConReuse = [ tyConName t + | (t, t_v) <- nameEnvElts vTyCon + , t == t_v] } ----------------------------- diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 1b24684..7416a5f 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -593,57 +593,57 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd \begin{code} tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo tcIfaceVectInfo mod typeEnv (IfaceVectInfo - { ifaceVectInfoCCVar = vars - , ifaceVectInfoCCTyCon = tycons - , ifaceVectInfoCCTyConReuse = tyconsReuse + { ifaceVectInfoVar = vars + , ifaceVectInfoTyCon = tycons + , ifaceVectInfoTyConReuse = tyconsReuse }) - = do { ccVars <- mapM ccVarMapping vars - ; tyConRes1 <- mapM ccTyConMapping tycons - ; tyConRes2 <- mapM ccTyConReuseMapping tycons - ; let (ccTyCons, ccDataCons, ccIsos) = unzip3 (tyConRes1 ++ tyConRes2) + = do { vVars <- mapM vectVarMapping vars + ; tyConRes1 <- mapM vectTyConMapping tycons + ; tyConRes2 <- mapM vectTyConReuseMapping tycons + ; let (vTyCons, vDataCons, vIsos) = unzip3 (tyConRes1 ++ tyConRes2) ; return $ VectInfo - { vectInfoCCVar = mkVarEnv ccVars - , vectInfoCCTyCon = mkNameEnv ccTyCons - , vectInfoCCDataCon = mkNameEnv (concat ccDataCons) - , vectInfoCCIso = mkNameEnv ccIsos + { vectInfoVar = mkVarEnv vVars + , vectInfoTyCon = mkNameEnv vTyCons + , vectInfoDataCon = mkNameEnv (concat vDataCons) + , vectInfoIso = mkNameEnv vIsos } } where - ccVarMapping name - = do { ccName <- lookupOrig mod (mkCloOcc (nameOccName name)) - ; let { var = lookupVar name - ; ccVar = lookupVar ccName + vectVarMapping name + = do { vName <- lookupOrig mod (mkVectOcc (nameOccName name)) + ; let { var = lookupVar name + ; vVar = lookupVar vName } - ; return (var, (var, ccVar)) + ; return (var, (var, vVar)) } - ccTyConMapping name - = do { ccName <- lookupOrig mod (mkCloTyConOcc (nameOccName name)) - ; isoName <- lookupOrig mod (mkCloIsoOcc (nameOccName name)) + vectTyConMapping name + = do { vName <- lookupOrig mod (mkVectTyConOcc (nameOccName name)) + ; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name)) ; let { tycon = lookupTyCon name - ; ccTycon = lookupTyCon ccName + ; vTycon = lookupTyCon vName ; isoTycon = lookupVar isoName } - ; ccDataCons <- mapM ccDataConMapping (tyConDataCons tycon) - ; return ((name, (tycon, ccTycon)), -- (T, T_CC) - ccDataCons, -- list of (Ci, Ci_CC) + ; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon) + ; return ((name, (tycon, vTycon)), -- (T, T_v) + vDataCons, -- list of (Ci, Ci_v) (name, (tycon, isoTycon))) -- (T, isoT) } - ccTyConReuseMapping name - = do { isoName <- lookupOrig mod (mkCloIsoOcc (nameOccName name)) + vectTyConReuseMapping name + = do { isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name)) ; let { tycon = lookupTyCon name ; isoTycon = lookupVar isoName - ; ccDataCons = [ (dataConName dc, (dc, dc)) + ; vDataCons = [ (dataConName dc, (dc, dc)) | dc <- tyConDataCons tycon] } ; return ((name, (tycon, tycon)), -- (T, T) - ccDataCons, -- list of (Ci, Ci) + vDataCons, -- list of (Ci, Ci) (name, (tycon, isoTycon))) -- (T, isoT) } - ccDataConMapping datacon + vectDataConMapping datacon = do { let name = dataConName datacon - ; ccName <- lookupOrig mod (mkCloDataConOcc (nameOccName name)) - ; let ccDataCon = lookupDataCon ccName - ; return (name, (datacon, ccDataCon)) + ; vName <- lookupOrig mod (mkVectDataConOcc (nameOccName name)) + ; let vDataCon = lookupDataCon vName + ; return (name, (datacon, vDataCon)) } -- lookupVar name = case lookupTypeEnv typeEnv name of diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index bb7acef..a74b1b3 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -1275,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 @@ -1313,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 [] [] [] diff --git a/compiler/vectorise/VectMonad.hs b/compiler/vectorise/VectMonad.hs index dc26b4b..d4fa8f8 100644 --- a/compiler/vectorise/VectMonad.hs +++ b/compiler/vectorise/VectMonad.hs @@ -133,9 +133,9 @@ data LocalEnv = LocalEnv { initGlobalEnv :: VectInfo -> (InstEnv, InstEnv) -> FamInstEnvs -> GlobalEnv initGlobalEnv info instEnvs famInstEnvs = GlobalEnv { - global_vars = mapVarEnv (Var . snd) $ vectInfoCCVar info + global_vars = mapVarEnv (Var . snd) $ vectInfoVar info , global_exported_vars = emptyVarEnv - , global_tycons = mapNameEnv snd $ vectInfoCCTyCon info + , global_tycons = mapNameEnv snd $ vectInfoTyCon info , global_tycon_pa = emptyNameEnv , global_inst_env = instEnvs , global_fam_inst_env = famInstEnvs @@ -151,8 +151,8 @@ emptyLocalEnv = LocalEnv { updVectInfo :: GlobalEnv -> TypeEnv -> VectInfo -> VectInfo updVectInfo env tyenv info = info { - vectInfoCCVar = global_exported_vars env - , vectInfoCCTyCon = tc_env + vectInfoVar = global_exported_vars env + , vectInfoTyCon = tc_env } where tc_env = mkNameEnv [(tc_name, (tc,tc')) -- 1.7.10.4