IfaceVectInfo and propagation through EPS

[ghc-hetmet.git] / compiler / main / HscTypes.lhs

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 126f07f..4797770 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -63,7 +63,11 @@ module HscTypes (
         HpcInfo(..), noHpcInfo,
 
         -- Breakpoints
-        ModBreaks (..), BreakIndex, emptyModBreaks
+        ModBreaks (..), BreakIndex, emptyModBreaks,
+
+        -- Vectorisation information
+        VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo, 
+        noIfaceVectInfo
     ) where
 
 #include "HsVersions.h"
@@ -73,8 +77,7 @@ import ByteCodeAsm    ( CompiledByteCode )
 import {-# SOURCE #-}  InteractiveEval ( Resume )
 #endif
 
-import RdrName         ( GlobalRdrEnv, emptyGlobalRdrEnv,
-                         LocalRdrEnv, emptyLocalRdrEnv, GlobalRdrElt(..), 
+import RdrName         ( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..), 
                           unQualOK, ImpDeclSpec(..), Provenance(..),
                           ImportSpec(..), lookupGlobalRdrEnv )
 import Name            ( Name, NamedThing, getName, nameOccName, nameModule )
@@ -96,7 +99,7 @@ import TyCon
 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 )
@@ -447,6 +450,9 @@ data ModIface
                                        -- 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
@@ -511,7 +517,8 @@ data ModGuts
        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:
@@ -598,6 +605,7 @@ emptyModIface mod
               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
@@ -624,8 +632,8 @@ data InteractiveContext
                                        -- 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
@@ -660,7 +668,9 @@ extendInteractiveContext
         -> 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}
 
@@ -1022,6 +1032,7 @@ type PackageTypeEnv    = TypeEnv
 type PackageRuleBase   = RuleBase
 type PackageInstEnv    = InstEnv
 type PackageFamInstEnv = FamInstEnv
+type PackageVectInfo   = VectInfo
 
 data ExternalPackageState
   = EPS {
@@ -1058,10 +1069,10 @@ data ExternalPackageState
                                               -- 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
   }
 
@@ -1210,6 +1221,38 @@ noHpcInfo = NoHpcInfo
 
 %************************************************************************
 %*                                                                     *
+\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.
+
+\begin{code}
+-- ModGuts version
+data VectInfo      = VectInfo {
+                       vectInfoCCVar :: NameSet
+                     }
+
+-- ModIface version
+data IfaceVectInfo = IfaceVectInfo {
+                       ifaceVectInfoCCVar :: [Name]
+                     }
+
+noVectInfo :: VectInfo
+noVectInfo = VectInfo emptyNameSet
+
+plusVectInfo :: VectInfo -> VectInfo -> VectInfo
+plusVectInfo vi1 vi2 = 
+  VectInfo (vectInfoCCVar vi1 `unionNameSets` vectInfoCCVar vi2)
+
+noIfaceVectInfo :: IfaceVectInfo
+noIfaceVectInfo = IfaceVectInfo []
+\end{code}
+
+%************************************************************************
+%*                                                                     *
 \subsection{Linkable stuff}
 %*                                                                     *
 %************************************************************************