diff options
Diffstat (limited to 'compiler/iface/TcIface.hs')
| -rw-r--r-- | compiler/iface/TcIface.hs | 139 |
1 files changed, 1 insertions, 138 deletions
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 1d18c125d5..9d04bf2fb3 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -15,7 +15,7 @@ module TcIface ( typecheckIfacesForMerging, typecheckIfaceForInstantiate, tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, - tcIfaceVectInfo, tcIfaceAnnotations, tcIfaceCompleteSigs, + tcIfaceAnnotations, tcIfaceCompleteSigs, tcIfaceExpr, -- Desired by HERMIT (Trac #7683) tcIfaceGlobal ) where @@ -55,7 +55,6 @@ import PrelNames import TysWiredIn import Literal import Var -import VarEnv import VarSet import Name import NameEnv @@ -173,9 +172,6 @@ typecheckIface iface ; rules <- tcIfaceRules ignore_prags (mi_rules iface) ; anns <- tcIfaceAnnotations (mi_anns iface) - -- Vectorisation information - ; vect_info <- tcIfaceVectInfo (mi_semantic_module iface) type_env (mi_vect_info iface) - -- Exports ; exports <- ifaceExportNames (mi_exports iface) @@ -193,7 +189,6 @@ typecheckIface iface , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns - , md_vect_info = vect_info , md_exports = exports , md_complete_sigs = complete_sigs } @@ -393,7 +388,6 @@ typecheckIfacesForMerging mod ifaces tc_env_var = fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface) rules <- tcIfaceRules ignore_prags (mi_rules iface) anns <- tcIfaceAnnotations (mi_anns iface) - vect_info <- tcIfaceVectInfo (mi_semantic_module iface) type_env (mi_vect_info iface) exports <- ifaceExportNames (mi_exports iface) complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) return $ ModDetails { md_types = type_env @@ -401,7 +395,6 @@ typecheckIfacesForMerging mod ifaces tc_env_var = , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns - , md_vect_info = vect_info , md_exports = exports , md_complete_sigs = complete_sigs } @@ -434,7 +427,6 @@ typecheckIfaceForInstantiate nsubst iface = fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface) rules <- tcIfaceRules ignore_prags (mi_rules iface) anns <- tcIfaceAnnotations (mi_anns iface) - vect_info <- tcIfaceVectInfo (mi_semantic_module iface) type_env (mi_vect_info iface) exports <- ifaceExportNames (mi_exports iface) complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) return $ ModDetails { md_types = type_env @@ -442,7 +434,6 @@ typecheckIfaceForInstantiate nsubst iface = , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns - , md_vect_info = vect_info , md_exports = exports , md_complete_sigs = complete_sigs } @@ -1131,134 +1122,6 @@ tcIfaceCompleteSig (IfaceCompleteMatch ms t) = return (CompleteMatch ms t) {- ************************************************************************ * * - Vectorisation information -* * -************************************************************************ --} - --- We need access to the type environment as we need to look up information about type constructors --- (i.e., their data constructors and whether they are class type constructors). If a vectorised --- type constructor or class is defined in the same module as where it is vectorised, we cannot --- look that information up from the type constructor that we obtained via a 'forkM'ed --- 'tcIfaceTyCon' without recursively loading the interface that we are already type checking again --- and again and again... --- -tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo -tcIfaceVectInfo mod typeEnv (IfaceVectInfo - { ifaceVectInfoVar = vars - , ifaceVectInfoTyCon = tycons - , ifaceVectInfoTyConReuse = tyconsReuse - , ifaceVectInfoParallelVars = parallelVars - , ifaceVectInfoParallelTyCons = parallelTyCons - }) - = do { let parallelTyConsSet = mkNameSet parallelTyCons - ; vVars <- mapM vectVarMapping vars - ; let varsSet = mkVarSet (map fst vVars) - ; tyConRes1 <- mapM (vectTyConVectMapping varsSet) tycons - ; tyConRes2 <- mapM (vectTyConReuseMapping varsSet) tyconsReuse - ; vParallelVars <- mapM vectVar parallelVars - ; let (vTyCons, vDataCons, vScSels) = unzip3 (tyConRes1 ++ tyConRes2) - ; return $ VectInfo - { vectInfoVar = mkDVarEnv vVars `extendDVarEnvList` concat vScSels - , vectInfoTyCon = mkNameEnv vTyCons - , vectInfoDataCon = mkNameEnv (concat vDataCons) - , vectInfoParallelVars = mkDVarSet vParallelVars - , vectInfoParallelTyCons = parallelTyConsSet - } - } - where - vectVarMapping name - = do { vName <- lookupIfaceTop (mkLocalisedOccName mod mkVectOcc name) - ; var <- forkM (text "vect var" <+> ppr name) $ - tcIfaceExtId name - ; vVar <- forkM (text "vect vVar [mod =" <+> - ppr mod <> text "; nameModule =" <+> - ppr (nameModule name) <> text "]" <+> ppr vName) $ - tcIfaceExtId vName - ; return (var, (var, vVar)) - } - -- where - -- lookupLocalOrExternalId name - -- = do { let mb_id = lookupTypeEnv typeEnv name - -- ; case mb_id of - -- -- id is local - -- Just (AnId id) -> return id - -- -- name is not an Id => internal inconsistency - -- Just _ -> notAnIdErr - -- -- Id is external - -- Nothing -> tcIfaceExtId name - -- } - -- - -- notAnIdErr = pprPanic "TcIface.tcIfaceVectInfo: not an id" (ppr name) - - vectVar name - = forkM (text "vect scalar var" <+> ppr name) $ - tcIfaceExtId name - - vectTyConVectMapping vars name - = do { vName <- lookupIfaceTop (mkLocalisedOccName mod mkVectTyConOcc name) - ; vectTyConMapping vars name vName - } - - vectTyConReuseMapping vars name - = vectTyConMapping vars name name - - vectTyConMapping vars name vName - = do { tycon <- lookupLocalOrExternalTyCon name - ; vTycon <- forkM (text "vTycon of" <+> ppr vName) $ - lookupLocalOrExternalTyCon vName - - -- Map the data constructors of the original type constructor to those of the - -- vectorised type constructor /unless/ the type constructor was vectorised - -- abstractly; if it was vectorised abstractly, the workers of its data constructors - -- do not appear in the set of vectorised variables. - -- - -- NB: This is lazy! We don't pull at the type constructors before we actually use - -- the data constructor mapping. - ; let isAbstract | isClassTyCon tycon = False - | datacon:_ <- tyConDataCons tycon - = not $ dataConWrapId datacon `elemVarSet` vars - | otherwise = True - vDataCons | isAbstract = [] - | otherwise = [ (dataConName datacon, (datacon, vDatacon)) - | (datacon, vDatacon) <- zip (tyConDataCons tycon) - (tyConDataCons vTycon) - ] - - -- Map the (implicit) superclass and methods selectors as they don't occur in - -- the var map. - vScSels | Just cls <- tyConClass_maybe tycon - , Just vCls <- tyConClass_maybe vTycon - = [ (sel, (sel, vSel)) - | (sel, vSel) <- zip (classAllSelIds cls) (classAllSelIds vCls) - ] - | otherwise - = [] - - ; return ( (name, (tycon, vTycon)) -- (T, T_v) - , vDataCons -- list of (Ci, Ci_v) - , vScSels -- list of (seli, seli_v) - ) - } - where - -- we need a fully defined version of the type constructor to be able to extract - -- its data constructors etc. - lookupLocalOrExternalTyCon name - = do { let mb_tycon = lookupTypeEnv typeEnv name - ; case mb_tycon of - -- tycon is local - Just (ATyCon tycon) -> return tycon - -- name is not a tycon => internal inconsistency - Just _ -> notATyConErr - -- tycon is external - Nothing -> tcIfaceTyConByName name - } - - notATyConErr = pprPanic "TcIface.tcIfaceVectInfo: not a tycon" (ppr name) - -{- -************************************************************************ -* * Types * * ************************************************************************ |