Refactoring only: remove [Id] field from ForeignStubs

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

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index b353caa..cb5022e 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -29,6 +29,7 @@ module HscTypes (
 
        InteractiveContext(..), emptyInteractiveContext, 
        icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
 
        InteractiveContext(..), emptyInteractiveContext, 
        icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,

+        substInteractiveContext,

 
        ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
        emptyIfaceDepCache,
 
        ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
        emptyIfaceDepCache,

@@ -60,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,

@@ -92,9 +93,9 @@ import Rules          ( RuleBase )
 import CoreSyn         ( CoreBind )
 import VarEnv
 import VarSet
 import CoreSyn         ( CoreBind )
 import VarEnv
 import VarSet

-import Var
+import Var       hiding ( setIdType )

 import Id
 import Id

-import Type            ( TyThing(..) )
+import Type            

 
 import Class           ( Class, classSelIds, classATs, classTyCon )
 import TyCon
 
 import Class           ( Class, classSelIds, classATs, classTyCon )
 import TyCon

@@ -120,6 +121,7 @@ import StringBuffer ( StringBuffer )
 import System.Time     ( ClockTime )
 import Data.IORef
 import Data.Array       ( Array, array )
 import System.Time     ( ClockTime )
 import Data.IORef
 import Data.Array       ( Array, array )

+import Data.List

 \end{code}
 
 
 \end{code}
 
 

@@ -471,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

@@ -518,13 +522,9 @@ data ModGuts
        mg_usages    :: ![Usage],        -- Version info for what it needed
 
         mg_rdr_env   :: !GlobalRdrEnv,  -- Top-level lexical environment
        mg_usages    :: ![Usage],        -- Version info for what it needed
 
         mg_rdr_env   :: !GlobalRdrEnv,  -- Top-level lexical environment

-       mg_fix_env   :: !FixityEnv,      -- Fixity env, for things declared in
-                                        --   this module 
-
-       mg_fam_inst_env :: FamInstEnv,   -- Type-family instance enviroment
-                                        -- for *home-package* modules (including
-                                        -- this one).  c.f. tcg_fam_inst_env

 
 

+       -- These fields all describe the things **declared in this module**
+       mg_fix_env   :: !FixityEnv,      -- Fixities

        mg_types     :: !TypeEnv,
        mg_insts     :: ![Instance],     -- Instances 
        mg_fam_insts :: ![FamInst],      -- Instances 
        mg_types     :: !TypeEnv,
        mg_insts     :: ![Instance],     -- Instances 
        mg_fam_insts :: ![FamInst],      -- Instances 

@@ -534,7 +534,19 @@ data ModGuts
        mg_deprecs   :: !Deprecations,   -- Deprecations declared in the module
        mg_hpc_info  :: !HpcInfo,        -- info about coverage tick boxes
         mg_modBreaks :: !ModBreaks,
        mg_deprecs   :: !Deprecations,   -- Deprecations declared in the module
        mg_hpc_info  :: !HpcInfo,        -- info about coverage tick boxes
         mg_modBreaks :: !ModBreaks,

-        mg_vect_info :: !VectInfo        -- Pool of vectorised declarations
+        mg_vect_info :: !VectInfo,        -- Pool of vectorised declarations
+
+       -- The next two fields are unusual, because they give instance
+       -- environments for *all* modules in the home package, including
+       -- this module, rather than for *just* this module.  
+       -- Reason: when looking up an instance we don't want to have to
+       --        look at each module in the home package in turn
+       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

     }
 
 -- The ModGuts takes on several slightly different forms:
     }
 
 -- The ModGuts takes on several slightly different forms:

@@ -596,8 +608,6 @@ data ForeignStubs = NoStubs
                                         --     "foreign exported" functions
                        [FastString]    -- Headers that need to be included
                                        --      into C code generated for this module
                                         --     "foreign exported" functions
                        [FastString]    -- Headers that need to be included
                                        --      into C code generated for this module

-                       [Id]            -- Foreign-exported binders
-                                       --      we have to generate code to register these

 
 \end{code}
 
 
 \end{code}
 

@@ -624,7 +634,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}
 

@@ -688,6 +699,22 @@ extendInteractiveContext ictxt ids tyvars
                           -- NB. must be this way around, because we want
                           -- new ids to shadow existing bindings.
             ic_tyvars   = ic_tyvars ictxt `unionVarSet` tyvars }
                           -- NB. must be this way around, because we want
                           -- new ids to shadow existing bindings.
             ic_tyvars   = ic_tyvars ictxt `unionVarSet` tyvars }

+
+
+substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
+substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt
+substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst =
+   let ids'     = map (\id -> id `setIdType` substTy subst (idType id)) ids
+       subst_dom= varEnvKeys$ getTvSubstEnv subst
+       subst_ran= varEnvElts$ getTvSubstEnv subst
+       new_tvs  = [ tv | Just tv <- map getTyVar_maybe subst_ran]  
+       ic_tyvars'= (`delVarSetListByKey` subst_dom) 
+                 . (`extendVarSetList`   new_tvs)
+                   $ ic_tyvars ictxt
+    in ictxt { ic_tmp_ids = ids'
+             , ic_tyvars   = ic_tyvars' }
+
+          where delVarSetListByKey = foldl' delVarSetByKey

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

@@ -1234,14 +1261,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}
 
 %************************************************************************

@@ -1254,48 +1293,51 @@ 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
+      vectInfoPADFun  :: NameEnv (TyCon  , Var),     -- (T_v, paT) keyed on T_v
+      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

-noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv
+noVectInfo = VectInfo emptyVarEnv emptyNameEnv 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)
+           (vectInfoPADFun  vi1 `plusNameEnv` vectInfoPADFun  vi2)
+           (vectInfoIso     vi1 `plusNameEnv` vectInfoIso     vi2)

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

@@ -1388,6 +1430,8 @@ data ModBreaks
         -- An array giving the source span of each breakpoint.
    , modBreaks_vars :: !(Array BreakIndex [OccName])
         -- An array giving the names of the free variables at each breakpoint.
         -- An array giving the source span of each breakpoint.
    , modBreaks_vars :: !(Array BreakIndex [OccName])
         -- An array giving the names of the free variables at each breakpoint.

+   , modBreaks_decls:: !(Array BreakIndex SrcSpan)
+        -- An array giving the span of the enclosing expression

    }
 
 emptyModBreaks :: ModBreaks
    }
 
 emptyModBreaks :: ModBreaks

@@ -1396,5 +1440,6 @@ emptyModBreaks = ModBreaks
          -- Todo: can we avoid this? 
    , modBreaks_locs = array (0,-1) []
    , modBreaks_vars = array (0,-1) []
          -- Todo: can we avoid this? 
    , modBreaks_locs = array (0,-1) []
    , modBreaks_vars = array (0,-1) []

+   , modBreaks_decls= array (0,-1) []

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