X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=f36b2054a9d75c6f7e33a515cde853e4c9ae39e3;hb=8e73f2c0cf07a4b235fcc1d1903ec69b41107dee;hp=bf7d676fc7375dd737f2d12fc63934257c08fabd;hpb=e5f78a4a5309b598d5195aa49a0bf7a206942cea;p=ghc-hetmet.git diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index bf7d676..f36b205 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -78,8 +78,8 @@ import {-# SOURCE #-} InteractiveEval ( Resume ) #endif import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..), - unQualOK, ImpDeclSpec(..), Provenance(..), - ImportSpec(..), lookupGlobalRdrEnv ) + mkRdrUnqual, ImpDeclSpec(..), Provenance(..), + ImportSpec(..), lookupGlobalRdrEnv, lookupGRE_RdrName ) import Name ( Name, NamedThing, getName, nameOccName, nameModule ) import NameEnv import NameSet @@ -90,7 +90,9 @@ import InstEnv ( InstEnv, Instance ) import FamInstEnv ( FamInstEnv, FamInst ) import Rules ( RuleBase ) import CoreSyn ( CoreBind ) +import VarEnv import VarSet +import Var import Id import Type ( TyThing(..) ) @@ -113,7 +115,6 @@ import SrcLoc ( SrcSpan, Located ) import UniqFM ( lookupUFM, eltsUFM, emptyUFM ) import UniqSupply ( UniqSupply ) import FastString ( FastString ) - import StringBuffer ( StringBuffer ) import System.Time ( ClockTime ) @@ -520,9 +521,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 @@ -699,19 +703,28 @@ extendInteractiveContext ictxt ids tyvars mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified mkPrintUnqualified env = (qual_name, qual_mod) where - qual_name mod occ - | null gres = Just (moduleName mod) + qual_name mod occ -- The (mod,occ) pair is the original name of the thing + | [gre] <- unqual_gres, right_name gre = Nothing + -- If there's a unique entity that's in scope unqualified with 'occ' + -- AND that entity is the right one, then we can use the unqualified name + + | [gre] <- qual_gres = Just (get_qual_mod (gre_prov gre)) + + | null qual_gres = Just (moduleName mod) -- it isn't in scope at all, this probably shouldn't happen, -- but we'll qualify it by the original module anyway. - | any unQualOK gres = Nothing - | (Imported is : _) <- map gre_prov gres, (idecl : _) <- is - = Just (is_as (is_decl idecl)) - | otherwise = panic "mkPrintUnqualified" + + | otherwise = panic "mkPrintUnqualified" where - gres = [ gre | gre <- lookupGlobalRdrEnv env occ, - nameModule (gre_name gre) == mod ] + right_name gre = nameModule (gre_name gre) == mod + + unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env + qual_gres = filter right_name (lookupGlobalRdrEnv env occ) - qual_mod mod = Nothing -- For now... + get_qual_mod LocalDef = moduleName mod + get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is)) + + qual_mod mod = Nothing -- For now, we never qualify module names with their packages \end{code} @@ -1244,26 +1257,51 @@ 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 +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 +on just the OccName easily in a Core pass. + \begin{code} --- ModGuts version -data VectInfo = VectInfo { - vectInfoCCVar :: NameSet - } +-- 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 + } + -- all of this is always tidy, even in ModGuts -- ModIface version -data IfaceVectInfo = IfaceVectInfo { - ifaceVectInfoCCVar :: [Name] - } +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 + -- the unconverted from; the names of the isomorphisms is determined + -- by `mkCloIsoOcc' + } noVectInfo :: VectInfo -noVectInfo = VectInfo emptyNameSet +noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv plusVectInfo :: VectInfo -> VectInfo -> VectInfo plusVectInfo vi1 vi2 = - VectInfo (vectInfoCCVar vi1 `unionNameSets` vectInfoCCVar vi2) + VectInfo (vectInfoCCVar vi1 `plusVarEnv` vectInfoCCVar vi2) + (vectInfoCCTyCon vi1 `plusNameEnv` vectInfoCCTyCon vi2) + (vectInfoCCDataCon vi1 `plusNameEnv` vectInfoCCDataCon vi2) + (vectInfoCCIso vi1 `plusNameEnv` vectInfoCCIso vi2) noIfaceVectInfo :: IfaceVectInfo -noIfaceVectInfo = IfaceVectInfo [] +noIfaceVectInfo = IfaceVectInfo [] [] [] \end{code} %************************************************************************