diff options
Diffstat (limited to 'compiler/iface')
| -rw-r--r-- | compiler/iface/IfaceType.hs | 1 | ||||
| -rw-r--r-- | compiler/iface/LoadIface.hs | 24 | ||||
| -rw-r--r-- | compiler/iface/MkIface.hs | 25 | ||||
| -rw-r--r-- | compiler/iface/TcIface.hs | 139 | ||||
| -rw-r--r-- | compiler/iface/TcIface.hs-boot | 4 |
5 files changed, 6 insertions, 187 deletions
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs index 6f548f5b12..2524593663 100644 --- a/compiler/iface/IfaceType.hs +++ b/compiler/iface/IfaceType.hs @@ -1100,7 +1100,6 @@ pprIfaceCoTcApp ctxt_prec tc tys = ppr_iface_tc_app ppr_co ctxt_prec tc tys ppr_iface_tc_app :: (PprPrec -> a -> SDoc) -> PprPrec -> IfaceTyCon -> [a] -> SDoc ppr_iface_tc_app pp _ tc [ty] | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp topPrec ty) - | tc `ifaceTyConHasKey` parrTyConKey = pprPromotionQuote tc <> paBrackets (pp topPrec ty) ppr_iface_tc_app pp ctxt_prec tc tys | tc `ifaceTyConHasKey` starKindTyConKey diff --git a/compiler/iface/LoadIface.hs b/compiler/iface/LoadIface.hs index 0845208a32..02e7d50969 100644 --- a/compiler/iface/LoadIface.hs +++ b/compiler/iface/LoadIface.hs @@ -36,7 +36,7 @@ module LoadIface ( import GhcPrelude import {-# SOURCE #-} TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst, - tcIfaceFamInst, tcIfaceVectInfo, + tcIfaceFamInst, tcIfaceAnnotations, tcIfaceCompleteSigs ) import DynFlags @@ -453,7 +453,7 @@ loadInterface doc_str mod from -- -- The main thing is to add the ModIface to the PIT, but -- we also take the - -- IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules, IfaceVectInfo + -- IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules, -- out of the ModIface and put them into the big EPS pools -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined @@ -467,7 +467,6 @@ loadInterface doc_str mod from ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface) ; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface) ; new_eps_anns <- tcIfaceAnnotations (mi_anns iface) - ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls) (mi_vect_info iface) ; new_eps_complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) ; let { final_iface = iface { @@ -495,8 +494,6 @@ loadInterface doc_str mod from new_eps_insts, eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps) new_eps_fam_insts, - eps_vect_info = plusVectInfo (eps_vect_info eps) - new_eps_vect_info, eps_ann_env = extendAnnEnvList (eps_ann_env eps) new_eps_anns, eps_mod_fam_inst_env @@ -979,7 +976,6 @@ initExternalPackageState -- Initialise the EPS rule pool with the built-in rules eps_mod_fam_inst_env = emptyModuleEnv, - eps_vect_info = noVectInfo, eps_complete_matches = emptyUFM, eps_ann_env = emptyAnnEnv, eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0 @@ -1087,7 +1083,6 @@ pprModIface iface , vcat (map ppr (mi_insts iface)) , vcat (map ppr (mi_fam_insts iface)) , vcat (map ppr (mi_rules iface)) - , pprVectInfo (mi_vect_info iface) , ppr (mi_warns iface) , pprTrustInfo (mi_trust iface) , pprTrustPkg (mi_trust_pkg iface) @@ -1161,21 +1156,6 @@ pprFixities fixes = text "fixities" <+> pprWithCommas pprFix fixes where pprFix (occ,fix) = ppr fix <+> ppr occ -pprVectInfo :: IfaceVectInfo -> SDoc -pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars - , ifaceVectInfoTyCon = tycons - , ifaceVectInfoTyConReuse = tyconsReuse - , ifaceVectInfoParallelVars = parallelVars - , ifaceVectInfoParallelTyCons = parallelTyCons - }) = - vcat - [ text "vectorised variables:" <+> hsep (map ppr vars) - , text "vectorised tycons:" <+> hsep (map ppr tycons) - , text "vectorised reused tycons:" <+> hsep (map ppr tyconsReuse) - , text "parallel variables:" <+> hsep (map ppr parallelVars) - , text "parallel tycons:" <+> hsep (map ppr parallelTyCons) - ] - pprTrustInfo :: IfaceTrustInfo -> SDoc pprTrustInfo trust = text "trusted:" <+> ppr trust diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 3375abd6e5..5c6912dca6 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -86,7 +86,6 @@ import HscTypes import Finder import DynFlags import VarEnv -import VarSet import Var import Name import Avail @@ -222,7 +221,6 @@ mkIface_ hsc_env maybe_old_fingerprint md_fam_insts = fam_insts, md_rules = rules, md_anns = anns, - md_vect_info = vect_info, md_types = type_env, md_exports = exports, md_complete_sigs = complete_sigs } @@ -257,7 +255,6 @@ mkIface_ hsc_env maybe_old_fingerprint iface_rules = map coreRuleToIfaceRule rules iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts iface_fam_insts = map famInstToIfaceFamInst fam_insts - iface_vect_info = flattenVectInfo vect_info trust_info = setSafeMode safe_mode annotations = map mkIfaceAnnotation anns icomplete_sigs = map mkIfaceCompleteSig complete_sigs @@ -280,8 +277,6 @@ mkIface_ hsc_env maybe_old_fingerprint mi_fam_insts = sortBy cmp_fam_inst iface_fam_insts, mi_rules = sortBy cmp_rule iface_rules, - mi_vect_info = iface_vect_info, - mi_fixities = fixities, mi_warns = warns, mi_anns = annotations, @@ -352,19 +347,6 @@ mkIface_ hsc_env maybe_old_fingerprint ifFamInstTcName = ifFamInstFam - flattenVectInfo (VectInfo { vectInfoVar = vVar - , vectInfoTyCon = vTyCon - , vectInfoParallelVars = vParallelVars - , vectInfoParallelTyCons = vParallelTyCons - }) = - IfaceVectInfo - { ifaceVectInfoVar = [Var.varName v | (v, _ ) <- dVarEnvElts vVar] - , ifaceVectInfoTyCon = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t /= t_v] - , ifaceVectInfoTyConReuse = [tyConName t | (t, t_v) <- nameEnvElts vTyCon, t == t_v] - , ifaceVectInfoParallelVars = [Var.varName v | v <- dVarSetElems vParallelVars] - , ifaceVectInfoParallelTyCons = nameSetElemsStable vParallelTyCons - } - ----------------------------- writeIfaceFile :: DynFlags -> FilePath -> ModIface -> IO () writeIfaceFile dflags hi_file_path new_iface @@ -686,13 +668,11 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls -- - export list -- - orphans -- - deprecations - -- - vect info -- - flag abi hash mod_hash <- computeFingerprint putNameLiterally (map fst sorted_decls, export_hash, -- includes orphan_hash - mi_warns iface0, - mi_vect_info iface0) + mi_warns iface0) -- The interface hash depends on: -- - the ABI hash, plus @@ -722,8 +702,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls mi_orphan = not ( all ifRuleAuto orph_rules -- See Note [Orphans and auto-generated rules] && null orph_insts - && null orph_fis - && isNoIfaceVectInfo (mi_vect_info iface0)), + && null orph_fis), mi_finsts = not . null $ mi_fam_insts iface0, mi_decls = sorted_decls, mi_hash_fn = lookupOccEnv local_env } 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 * * ************************************************************************ diff --git a/compiler/iface/TcIface.hs-boot b/compiler/iface/TcIface.hs-boot index dbc5ff14f8..f137f13305 100644 --- a/compiler/iface/TcIface.hs-boot +++ b/compiler/iface/TcIface.hs-boot @@ -8,13 +8,11 @@ import TcRnTypes ( IfL ) import InstEnv ( ClsInst ) import FamInstEnv ( FamInst ) import CoreSyn ( CoreRule ) -import HscTypes ( TypeEnv, VectInfo, IfaceVectInfo, CompleteMatch ) -import Module ( Module ) +import HscTypes ( CompleteMatch ) import Annotations ( Annotation ) tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule] -tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo tcIfaceInst :: IfaceClsInst -> IfL ClsInst tcIfaceFamInst :: IfaceFamInst -> IfL FamInst tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation] |