Adding pushing of hpc translation status through hi files.

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

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index bb7acef..85cf73e 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -61,7 +61,7 @@ module HscTypes (
        Linkable(..), isObjectLinkable,
        Unlinked(..), CompiledByteCode,
        isObject, nameOfObject, isInterpretable, byteCodeOfObject,
        Linkable(..), isObjectLinkable,
        Unlinked(..), CompiledByteCode,
        isObject, nameOfObject, isInterpretable, byteCodeOfObject,

-        HpcInfo(..), noHpcInfo,
+        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,

 
         -- Breakpoints
         ModBreaks (..), BreakIndex, emptyModBreaks,
 
         -- Breakpoints
         ModBreaks (..), BreakIndex, emptyModBreaks,

@@ -473,12 +473,14 @@ data ModIface
                -- and are not put into the interface file
        mi_dep_fn  :: Name -> Maybe DeprecTxt,  -- Cached lookup for mi_deprecs
        mi_fix_fn  :: OccName -> Fixity,        -- Cached lookup for mi_fixities
                -- and are not put into the interface file
        mi_dep_fn  :: Name -> Maybe DeprecTxt,  -- Cached lookup for mi_deprecs
        mi_fix_fn  :: OccName -> Fixity,        -- Cached lookup for mi_fixities

-       mi_ver_fn  :: OccName -> Maybe (OccName, Version)
+       mi_ver_fn  :: OccName -> Maybe (OccName, Version),

                         -- Cached lookup for mi_decls
                        -- The Nothing in mi_ver_fn means that the thing
                        -- isn't in decls. It's useful to know that when
                        -- seeing if we are up to date wrt the old interface
                         -- The 'OccName' is the parent of the name, if it has one.
                         -- Cached lookup for mi_decls
                        -- The Nothing in mi_ver_fn means that the thing
                        -- isn't in decls. It's useful to know that when
                        -- seeing if we are up to date wrt the old interface
                         -- The 'OccName' is the parent of the name, if it has one.

+       mi_hpc    :: !AnyHpcUsage
+         -- True if this program uses Hpc at any point in the program.

      }
 
 -- Should be able to construct ModDetails from mi_decls in ModIface
      }
 
 -- Should be able to construct ModDetails from mi_decls in ModIface

@@ -629,7 +631,8 @@ emptyModIface mod
                mi_vect_info = noIfaceVectInfo,
               mi_dep_fn = emptyIfaceDepCache,
               mi_fix_fn = emptyIfaceFixCache,
                mi_vect_info = noIfaceVectInfo,
               mi_dep_fn = emptyIfaceDepCache,
               mi_fix_fn = emptyIfaceFixCache,

-              mi_ver_fn = emptyIfaceVerCache
+              mi_ver_fn = emptyIfaceVerCache,
+              mi_hpc    = False

     }          
 \end{code}
 
     }          
 \end{code}
 

@@ -1255,14 +1258,26 @@ showModMsg target recomp mod_summary
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-data HpcInfo = HpcInfo 
+data HpcInfo 
+  = HpcInfo 

      { hpcInfoTickCount :: Int 
      , hpcInfoHash      :: Int  
      }
      { hpcInfoTickCount :: Int 
      , hpcInfoHash      :: Int  
      }

-     | NoHpcInfo
+  | NoHpcInfo 
+     { hpcUsed          :: AnyHpcUsage  -- is hpc used anywhere on the module tree?
+     }
+
+-- This is used to mean there is no module-local hpc usage,
+-- but one of my imports used hpc instrumentation.
+
+type AnyHpcUsage = Bool
+
+emptyHpcInfo :: AnyHpcUsage -> HpcInfo
+emptyHpcInfo = NoHpcInfo 

 
 

-noHpcInfo :: HpcInfo
-noHpcInfo = NoHpcInfo
+isHpcUsed :: HpcInfo -> AnyHpcUsage
+isHpcUsed (HpcInfo {})                  = True
+isHpcUsed (NoHpcInfo { hpcUsed = used }) = used

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -1275,37 +1290,38 @@ The following information is generated and consumed by the vectorisation
 subsystem.  It communicates the vectorisation status of declarations from one
 module to another.
 
 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
+Why do we need both f and f_v in the ModGuts/ModDetails/EPS version VectInfo

 below?  We need to know `f' when converting to IfaceVectInfo.  However, during
 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
+vectorisation, we need to know `f_v', whose `Var' we cannot lookup based

 on just the OccName easily in a Core pass.
 
 \begin{code}
 -- ModGuts/ModDetails/EPS version
 data VectInfo      
   = VectInfo {
 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
+      vectInfoVar     :: VarEnv  (Var    , Var  ),   -- (f, f_v) keyed on f
+      vectInfoTyCon   :: NameEnv (TyCon  , TyCon),   -- (T, T_v) keyed on T
+      vectInfoDataCon :: NameEnv (DataCon, DataCon), -- (C, C_v) keyed on C
+      vectInfoIso     :: NameEnv (TyCon  , Var)      -- (T, isoT) keyed on T

     }
     -- all of this is always tidy, even in ModGuts
 
 -- ModIface version
 data IfaceVectInfo 
   = IfaceVectInfo {
     }
     -- 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
+      ifaceVectInfoVar        :: [Name],
+        -- all variables in here have a vectorised variant;
+        -- the name of the vectorised variant is determined by `mkCloVect'
+      ifaceVectInfoTyCon      :: [Name],
+        -- all tycons in here have a vectorised variant;
+        -- the name of the vectorised variant and those of its
+        -- data constructors are determined by `mkVectTyConOcc'
+        -- and `mkVectDataConOcc'; the names of
+        -- the isomorphisms is determined by `mkVectIsoOcc'
+      ifaceVectInfoTyConReuse :: [Name]              
+        -- the vectorised form of all the tycons in here coincids with

         -- the unconverted from; the names of the isomorphisms is determined
         -- the unconverted from; the names of the isomorphisms is determined

-        -- by `mkCloIsoOcc'
+        -- by `mkVectIsoOcc'

     }
 
 noVectInfo :: VectInfo
     }
 
 noVectInfo :: VectInfo

@@ -1313,10 +1329,10 @@ noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv
 
 plusVectInfo :: VectInfo -> VectInfo -> VectInfo
 plusVectInfo vi1 vi2 = 
 
 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)
+  VectInfo (vectInfoVar     vi1 `plusVarEnv`  vectInfoVar     vi2)
+           (vectInfoTyCon   vi1 `plusNameEnv` vectInfoTyCon   vi2)
+           (vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
+           (vectInfoIso     vi1 `plusNameEnv` vectInfoIso     vi2)

 
 noIfaceVectInfo :: IfaceVectInfo
 noIfaceVectInfo = IfaceVectInfo [] [] []
 
 noIfaceVectInfo :: IfaceVectInfo
 noIfaceVectInfo = IfaceVectInfo [] [] []