HscSource(..), isHsBoot, hscSourceString, -- Re-exported from DriverPhases
HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
- hptInstances, hptRules,
+ hptInstances, hptRules, hptVectInfo,
ExternalPackageState(..), EpsStats(..), addEpsInStats,
PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
HpcInfo(..), noHpcInfo,
-- Breakpoints
- ModBreaks (..), BreakIndex, emptyModBreaks
+ ModBreaks (..), BreakIndex, emptyModBreaks,
+
+ -- Vectorisation information
+ VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
+ noIfaceVectInfo
) where
#include "HsVersions.h"
import {-# SOURCE #-} InteractiveEval ( Resume )
#endif
-import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv,
- LocalRdrEnv, emptyLocalRdrEnv, GlobalRdrElt(..),
- unQualOK, ImpDeclSpec(..), Provenance(..),
- ImportSpec(..), lookupGlobalRdrEnv )
+import RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..),
+ mkRdrUnqual, ImpDeclSpec(..), Provenance(..),
+ ImportSpec(..), lookupGlobalRdrEnv, lookupGRE_RdrName )
import Name ( Name, NamedThing, getName, nameOccName, nameModule )
import NameEnv
import NameSet
import FamInstEnv ( FamInstEnv, FamInst )
import Rules ( RuleBase )
import CoreSyn ( CoreBind )
+import VarEnv
import VarSet
+import Var
import Id
import Type ( TyThing(..) )
import DataCon ( DataCon, dataConImplicitIds )
import PrelNames ( gHC_PRIM )
import Packages ( PackageId )
-import DynFlags ( DynFlags(..), DynFlag(..), isOneShot, HscTarget (..) )
+import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) )
import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase )
import BasicTypes ( Version, initialVersion, IPName,
Fixity, defaultFixity, DeprecTxt )
import UniqFM ( lookupUFM, eltsUFM, emptyUFM )
import UniqSupply ( UniqSupply )
import FastString ( FastString )
-
import StringBuffer ( StringBuffer )
import System.Time ( ClockTime )
\begin{code}
-hptInstances :: HscEnv -> (ModuleName -> Bool) -> [Instance]
--- Find all the instance declarations that are in modules imported
--- by this one, directly or indirectly, and are in the Home Package Table
--- This ensures that we don't see instances from modules --make compiled
--- before this one, but which are not below this one
+hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([Instance], [FamInst])
+-- Find all the instance declarations (of classes and families) that are in
+-- modules imported by this one, directly or indirectly, and are in the Home
+-- Package Table. This ensures that we don't see instances from modules --make
+-- compiled before this one, but which are not below this one.
hptInstances hsc_env want_this_module
- = [ ispec
- | mod_info <- eltsUFM (hsc_HPT hsc_env)
- , want_this_module (moduleName (mi_module (hm_iface mod_info)))
- , ispec <- md_insts (hm_details mod_info) ]
+ = let (insts, famInsts) = unzip
+ [ (md_insts details, md_fam_insts details)
+ | mod_info <- eltsUFM (hsc_HPT hsc_env)
+ , want_this_module (moduleName (mi_module (hm_iface mod_info)))
+ , let details = hm_details mod_info ]
+ in
+ (concat insts, concat famInsts)
hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
-- Get rules from modules "below" this one (in the dependency sense)
-- And get its dfuns
, rule <- rules ]
+
+hptVectInfo :: HscEnv -> VectInfo
+-- Get the combined VectInfo of all modules in the home package table. In
+-- contrast to instances and rules, we don't care whether the modules are
+-- "below" or us. The VectInfo of those modules not "below" us does not
+-- affect the compilation of the current module.
+hptVectInfo hsc_env
+ = foldr plusVectInfo noVectInfo [ md_vect_info (hm_details mod_info)
+ | mod_info <- eltsUFM (hsc_HPT hsc_env)]
\end{code}
%************************************************************************
-- instances (for classes and families)
-- combined
+ -- Vectorisation information
+ mi_vect_info :: !IfaceVectInfo,
+
-- Cached environments for easy lookup
-- These are computed (lazily) from other fields
-- and are not put into the interface file
-- The next two fields are created by the typechecker
md_exports :: [AvailInfo],
md_types :: !TypeEnv,
- md_insts :: ![Instance], -- Dfun-ids for the instances in this module
+ md_insts :: ![Instance], -- Dfun-ids for the instances in this module
md_fam_insts :: ![FamInst],
- md_rules :: ![CoreRule], -- Domain may include Ids from other modules
- md_modBreaks :: !ModBreaks -- breakpoint information for this module
+ md_rules :: ![CoreRule], -- Domain may include Ids from other modules
+ md_modBreaks :: !ModBreaks, -- Breakpoint information for this module
+ md_vect_info :: !VectInfo -- Vectorisation information
}
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
md_insts = [],
md_rules = [],
md_fam_insts = [],
- md_modBreaks = emptyModBreaks }
+ md_modBreaks = emptyModBreaks,
+ md_vect_info = noVectInfo
+ }
-- A ModGuts is carried through the compiler, accumulating stuff as it goes
-- There is only one ModGuts at any time, the one for the module
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
mg_foreign :: !ForeignStubs,
mg_deprecs :: !Deprecations, -- Deprecations declared in the module
mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes
- mg_modBreaks :: !ModBreaks
+ mg_modBreaks :: !ModBreaks,
+ mg_vect_info :: !VectInfo -- Pool of vectorised declarations
}
-- The ModGuts takes on several slightly different forms:
mi_decls = [],
mi_globals = Nothing,
mi_rule_vers = initialVersion,
+ mi_vect_info = noIfaceVectInfo,
mi_dep_fn = emptyIfaceDepCache,
mi_fix_fn = emptyIfaceFixCache,
mi_ver_fn = emptyIfaceVerCache
-- ic_toplev_scope and ic_exports
ic_tmp_ids :: [Id], -- Names bound during interaction.
- -- Earlier Ids shadow
- -- later ones with the same OccName.
+ -- Later Ids shadow
+ -- earlier ones with the same OccName.
ic_tyvars :: TyVarSet -- skolem type variables free in
-- ic_tmp_ids. These arise at
-> TyVarSet
-> InteractiveContext
extendInteractiveContext ictxt ids tyvars
- = ictxt { ic_tmp_ids = ids ++ ic_tmp_ids ictxt,
+ = ictxt { ic_tmp_ids = ic_tmp_ids ictxt ++ ids,
+ -- NB. must be this way around, because we want
+ -- new ids to shadow existing bindings.
ic_tyvars = ic_tyvars ictxt `unionVarSet` tyvars }
\end{code}
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)
+
+ 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...
+ qual_mod mod = Nothing -- For now, we never qualify module names with their packages
\end{code}
type PackageRuleBase = RuleBase
type PackageInstEnv = InstEnv
type PackageFamInstEnv = FamInstEnv
+type PackageVectInfo = VectInfo
data ExternalPackageState
= EPS {
-- modules
eps_fam_inst_env :: !PackageFamInstEnv,-- Ditto FamInstEnv
eps_rule_base :: !PackageRuleBase, -- Ditto RuleEnv
+ eps_vect_info :: !PackageVectInfo, -- Ditto VectInfo
eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- identifies family
- -- instances of each mod
-
+ -- instances of each mod
eps_stats :: !EpsStats
}
%************************************************************************
%* *
+\subsection{Vectorisation Support}
+%* *
+%************************************************************************
+
+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/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],
+ -- 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 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)
+
+noIfaceVectInfo :: IfaceVectInfo
+noIfaceVectInfo = IfaceVectInfo [] [] []
+\end{code}
+
+%************************************************************************
+%* *
\subsection{Linkable stuff}
%* *
%************************************************************************