FIX #1110: the linker also needs the workaround

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

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index eeea9d9..fb8e87e 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -21,7 +21,7 @@ module HscTypes (
        HscSource(..), isHsBoot, hscSourceString,       -- Re-exported from DriverPhases
        
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
        HscSource(..), isHsBoot, hscSourceString,       -- Re-exported from DriverPhases
        
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,

-       hptInstances, hptRules,
+       hptInstances, hptRules, hptVectInfo,

 
        ExternalPackageState(..), EpsStats(..), addEpsInStats,
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
 
        ExternalPackageState(..), EpsStats(..), addEpsInStats,
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,

@@ -90,7 +90,9 @@ import InstEnv                ( InstEnv, Instance )
 import FamInstEnv      ( FamInstEnv, FamInst )
 import Rules           ( RuleBase )
 import CoreSyn         ( CoreBind )
 import FamInstEnv      ( FamInstEnv, FamInst )
 import Rules           ( RuleBase )
 import CoreSyn         ( CoreBind )

+import VarEnv

 import VarSet
 import VarSet

+import Var

 import Id
 import Type            ( TyThing(..) )
 
 import Id
 import Type            ( TyThing(..) )
 

@@ -330,6 +332,15 @@ hptRules hsc_env deps
 
        -- And get its dfuns
     , rule <- rules ]
 
        -- 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}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -475,10 +486,11 @@ data ModDetails
        -- The next two fields are created by the typechecker
        md_exports   :: [AvailInfo],
         md_types     :: !TypeEnv,
        -- 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_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,
      }
 
 emptyModDetails = ModDetails { md_types = emptyTypeEnv,

@@ -486,7 +498,9 @@ emptyModDetails = ModDetails { md_types = emptyTypeEnv,
                               md_insts     = [],
                               md_rules     = [],
                               md_fam_insts = [],
                               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
 
 -- 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

@@ -1232,26 +1246,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
+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}
 \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
 
 -- 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

-noVectInfo = VectInfo emptyNameSet
+noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv

 
 plusVectInfo :: VectInfo -> VectInfo -> VectInfo
 plusVectInfo vi1 vi2 = 
 
 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 []
+noIfaceVectInfo = IfaceVectInfo [] [] []

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