IfaceVectInfo and propagation through EPS

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 9bdb7b6..3c62db9 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -293,7 +293,8 @@ instance Binary ModIface where
                 mi_insts     = insts,
                 mi_fam_insts = fam_insts,
                 mi_rules     = rules,
                 mi_insts     = insts,
                 mi_fam_insts = fam_insts,
                 mi_rules     = rules,

-                mi_rule_vers = rule_vers }) = do
+                mi_rule_vers = rule_vers,
+                 mi_vect_info = vect_info }) = do

        put_ bh mod
        put_ bh is_boot
        put_ bh mod_vers
        put_ bh mod
        put_ bh is_boot
        put_ bh mod_vers

@@ -310,6 +311,7 @@ instance Binary ModIface where
        put_ bh fam_insts
        lazyPut bh rules
        put_ bh rule_vers
        put_ bh fam_insts
        lazyPut bh rules
        put_ bh rule_vers

+        put_ bh vect_info

 
    get bh = do
        mod_name  <- get bh
 
    get bh = do
        mod_name  <- get bh

@@ -328,6 +330,7 @@ instance Binary ModIface where
        fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
        rules     <- {-# SCC "bin_rules" #-} lazyGet bh
        rule_vers <- get bh
        fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
        rules     <- {-# SCC "bin_rules" #-} lazyGet bh
        rule_vers <- get bh

+        vect_info <- get bh

        return (ModIface {
                 mi_module    = mod_name,
                 mi_boot      = is_boot,
        return (ModIface {
                 mi_module    = mod_name,
                 mi_boot      = is_boot,

@@ -346,6 +349,7 @@ instance Binary ModIface where
                 mi_fam_insts = fam_insts,
                 mi_rules     = rules,
                 mi_rule_vers = rule_vers,
                 mi_fam_insts = fam_insts,
                 mi_rules     = rules,
                 mi_rule_vers = rule_vers,

+                 mi_vect_info = vect_info,

                        -- And build the cached values
                 mi_dep_fn    = mkIfaceDepCache deprecs,
                 mi_fix_fn    = mkIfaceFixCache fixities,
                        -- And build the cached values
                 mi_dep_fn    = mkIfaceDepCache deprecs,
                 mi_fix_fn    = mkIfaceFixCache fixities,

@@ -1217,4 +1221,11 @@ instance Binary IfaceRule where
            a7 <- get bh
            return (IfaceRule a1 a2 a3 a4 a5 a6 a7)
 
            a7 <- get bh
            return (IfaceRule a1 a2 a3 a4 a5 a6 a7)
 

+instance Binary IfaceVectInfo where
+    put_ bh (IfaceVectInfo a1) = do
+           put_ bh a1
+    get bh = do
+           a1 <- get bh
+           return (IfaceVectInfo a1)
+

 
 

diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index 571f96b..00e9e7a 100644 (file)
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -38,6 +38,7 @@ import InstEnv
 import FamInstEnv
 import Name
 import NameEnv
 import FamInstEnv
 import Name
 import NameEnv

+import NameSet

 import MkId
 import Module
 import OccName
 import MkId
 import Module
 import OccName

@@ -225,7 +226,7 @@ loadInterface doc_str mod from
        --
        -- The main thing is to add the ModIface to the PIT, but
        -- we also take the
        --
        -- The main thing is to add the ModIface to the PIT, but
        -- we also take the

-       --      IfaceDecls, IfaceInst, IfaceRules
+       --      IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo

        -- out of the ModIface and put them into the big EPS pools
 
        -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
        -- out of the ModIface and put them into the big EPS pools
 
        -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined

@@ -244,7 +245,13 @@ loadInterface doc_str mod from
                                mi_insts     = panic "No mi_insts in PIT",
                                mi_fam_insts = panic "No mi_fam_insts in PIT",
                                mi_rules     = panic "No mi_rules in PIT"
                                mi_insts     = panic "No mi_insts in PIT",
                                mi_fam_insts = panic "No mi_fam_insts in PIT",
                                mi_rules     = panic "No mi_rules in PIT"

-                              } }
+                              }
+              ; new_eps_vect_info =
+                  VectInfo {
+                    vectInfoCCVar = mkNameSet 
+                                     (ifaceVectInfoCCVar . mi_vect_info $ iface)
+                  }     
+               }

 
        ; updateEps_  $ \ eps -> 
            eps { 
 
        ; updateEps_  $ \ eps -> 
            eps { 

@@ -256,6 +263,8 @@ loadInterface doc_str mod from
                                                   new_eps_insts,
              eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
                                                      new_eps_fam_insts,
                                                   new_eps_insts,
              eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
                                                      new_eps_fam_insts,

+              eps_vect_info    = plusVectInfo (eps_vect_info eps) 
+                                              new_eps_vect_info,

               eps_mod_fam_inst_env
                               = let
                                   fam_inst_env = 
               eps_mod_fam_inst_env
                               = let
                                   fam_inst_env = 

@@ -490,6 +499,7 @@ initExternalPackageState
        -- Initialise the EPS rule pool with the built-in rules
       eps_mod_fam_inst_env
                        = emptyModuleEnv,
        -- Initialise the EPS rule pool with the built-in rules
       eps_mod_fam_inst_env
                        = emptyModuleEnv,

+      eps_vect_info    = noVectInfo,

       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
                           , n_insts_in = 0, n_insts_out = 0
                           , n_rules_in = length builtinRules, n_rules_out = 0 }
       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
                           , n_insts_in = 0, n_insts_out = 0
                           , n_rules_in = length builtinRules, n_rules_out = 0 }

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 6f3e336..df5bc08 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -242,7 +242,8 @@ mkIface hsc_env maybe_old_iface
                      mg_deps      = deps,
                      mg_rdr_env   = rdr_env,
                      mg_fix_env   = fix_env,
                      mg_deps      = deps,
                      mg_rdr_env   = rdr_env,
                      mg_fix_env   = fix_env,

-                     mg_deprecs   = src_deprecs })
+                     mg_deprecs   = src_deprecs,
+                      mg_vect_info = vect_info })

        (ModDetails{  md_insts     = insts, 
                      md_fam_insts = fam_insts,
                      md_rules     = rules,
        (ModDetails{  md_insts     = insts, 
                      md_fam_insts = fam_insts,
                      md_rules     = rules,

@@ -299,6 +300,8 @@ mkIface hsc_env maybe_old_iface
                        mi_decls     = deliberatelyOmitted "decls",
                        mi_ver_fn    = deliberatelyOmitted "ver_fn",
 
                        mi_decls     = deliberatelyOmitted "decls",
                        mi_ver_fn    = deliberatelyOmitted "ver_fn",
 

+                        mi_vect_info = flattenVectInfo vect_info,
+

                        -- And build the cached values
                        mi_dep_fn = mkIfaceDepCache deprecs,
                        mi_fix_fn = mkIfaceFixCache fixities }
                        -- And build the cached values
                        mi_dep_fn = mkIfaceDepCache deprecs,
                        mi_fix_fn = mkIfaceFixCache fixities }

@@ -333,6 +336,8 @@ mkIface hsc_env maybe_old_iface
      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
      ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
 
      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
      ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
 

+     flattenVectInfo (VectInfo ccVar) = IfaceVectInfo (nameSetToList ccVar)
+

 -----------------------------
 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
 writeIfaceFile dflags location new_iface
 -----------------------------
 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
 writeIfaceFile dflags location new_iface

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index cbe09bc..4797770 100644 (file)
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -66,7 +66,8 @@ module HscTypes (
         ModBreaks (..), BreakIndex, emptyModBreaks,
 
         -- Vectorisation information
         ModBreaks (..), BreakIndex, emptyModBreaks,
 
         -- Vectorisation information

-        VectInfo(..), noVectInfo
+        VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo, 
+        noIfaceVectInfo

     ) where
 
 #include "HsVersions.h"
     ) where
 
 #include "HsVersions.h"

@@ -449,6 +450,9 @@ data ModIface
                                        -- instances (for classes and families)
                                        -- combined
 
                                        -- 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
                -- Cached environments for easy lookup
                -- These are computed (lazily) from other fields
                -- and are not put into the interface file

@@ -601,6 +605,7 @@ emptyModIface mod
               mi_decls     = [],
               mi_globals   = Nothing,
               mi_rule_vers = initialVersion,
               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
               mi_dep_fn = emptyIfaceDepCache,
               mi_fix_fn = emptyIfaceFixCache,
               mi_ver_fn = emptyIfaceVerCache

@@ -1027,6 +1032,7 @@ type PackageTypeEnv    = TypeEnv
 type PackageRuleBase   = RuleBase
 type PackageInstEnv    = InstEnv
 type PackageFamInstEnv = FamInstEnv
 type PackageRuleBase   = RuleBase
 type PackageInstEnv    = InstEnv
 type PackageFamInstEnv = FamInstEnv

+type PackageVectInfo   = VectInfo

 
 data ExternalPackageState
   = EPS {
 
 data ExternalPackageState
   = EPS {

@@ -1063,10 +1069,10 @@ data ExternalPackageState
                                               -- modules 
        eps_fam_inst_env :: !PackageFamInstEnv,-- Ditto FamInstEnv
        eps_rule_base    :: !PackageRuleBase,  -- Ditto RuleEnv
                                               -- 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
 
         eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- identifies family

-                                                      -- instances of each mod
-
+                                                      -- instances of each mod 

        eps_stats :: !EpsStats
   }
 
        eps_stats :: !EpsStats
   }
 

@@ -1219,13 +1225,30 @@ noHpcInfo = NoHpcInfo
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

+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}
 \begin{code}

-data VectInfo = VectInfo {
-                  vectInfoCCVar :: NameSet
-                }
+-- ModGuts version
+data VectInfo      = VectInfo {
+                       vectInfoCCVar :: NameSet
+                     }
+
+-- ModIface version
+data IfaceVectInfo = IfaceVectInfo {
+                       ifaceVectInfoCCVar :: [Name]
+                     }

 
 noVectInfo :: VectInfo
 noVectInfo = VectInfo emptyNameSet
 
 noVectInfo :: VectInfo
 noVectInfo = VectInfo emptyNameSet

+
+plusVectInfo :: VectInfo -> VectInfo -> VectInfo
+plusVectInfo vi1 vi2 = 
+  VectInfo (vectInfoCCVar vi1 `unionNameSets` vectInfoCCVar vi2)
+
+noIfaceVectInfo :: IfaceVectInfo
+noIfaceVectInfo = IfaceVectInfo []

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