Adding pushing of hpc translation status through hi files.

[ghc-hetmet.git] / compiler / iface / MkIface.lhs

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index b74c233..564d3a4 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -195,6 +195,8 @@ import TcRnMonad
 import HscTypes
 
 import DynFlags
+import VarEnv
+import Var
 import Name
 import NameEnv
 import NameSet
@@ -242,10 +244,12 @@ mkIface hsc_env maybe_old_iface
                      mg_deps      = deps,
                      mg_rdr_env   = rdr_env,
                      mg_fix_env   = fix_env,
-                     mg_deprecs   = src_deprecs })
+                     mg_deprecs   = src_deprecs,
+                     mg_hpc_info  = hpc_info })
        (ModDetails{  md_insts     = insts, 
                      md_fam_insts = fam_insts,
                      md_rules     = rules,
+                      md_vect_info = vect_info,
                      md_types     = type_env,
                      md_exports   = exports })
        
@@ -271,6 +275,7 @@ mkIface hsc_env maybe_old_iface
                ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
                ; iface_insts = map instanceToIfaceInst insts
                ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
+                ; iface_vect_info = flattenVectInfo vect_info
 
                ; intermediate_iface = ModIface { 
                        mi_module   = this_mod,
@@ -285,6 +290,8 @@ mkIface hsc_env maybe_old_iface
                        mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
                        mi_rules    = sortLe le_rule iface_rules,
 
+                        mi_vect_info = iface_vect_info,
+
                        mi_fixities = fixities,
                        mi_deprecs  = deprecs,
                        mi_globals  = Just rdr_env,
@@ -298,6 +305,7 @@ mkIface hsc_env maybe_old_iface
                         mi_finsts    = False,   -- Ditto
                        mi_decls     = deliberatelyOmitted "decls",
                        mi_ver_fn    = deliberatelyOmitted "ver_fn",
+                       mi_hpc       = isHpcUsed hpc_info,
 
                        -- And build the cached values
                        mi_dep_fn = mkIfaceDepCache deprecs,
@@ -333,6 +341,20 @@ mkIface hsc_env maybe_old_iface
      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
      ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
 
+     flattenVectInfo (VectInfo { vectInfoVar   = vVar
+                               , vectInfoTyCon = vTyCon
+                               }) = 
+       IfaceVectInfo { 
+         ifaceVectInfoVar        = [ Var.varName v 
+                                   | (v, _) <- varEnvElts vVar],
+         ifaceVectInfoTyCon      = [ tyConName t 
+                                   | (t, t_v) <- nameEnvElts vTyCon
+                                   , t /= t_v],
+         ifaceVectInfoTyConReuse = [ tyConName t
+                                   | (t, t_v) <- nameEnvElts vTyCon
+                                   , t == t_v]
+       } 
+
 -----------------------------
 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
 writeIfaceFile dflags location new_iface
@@ -452,7 +474,8 @@ addVersionInfo ver_fn (Just old_iface@(ModIface {
 
        -- If the usages havn't changed either, we don't need to write the interface file
     no_other_changes = mi_usages new_iface == mi_usages old_iface && 
-                      mi_deps new_iface == mi_deps old_iface
+                      mi_deps new_iface == mi_deps old_iface &&
+                      mi_hpc new_iface == mi_hpc old_iface
     no_change_at_all = no_output_change && no_other_changes
  
     pp_diffs = vcat [pp_change no_export_change "Export list" 
@@ -1061,10 +1084,12 @@ tyThingToIfaceDecl (AClass clas)
 
 tyThingToIfaceDecl (ATyCon tycon)
   | isSynTyCon tycon
-  = IfaceSyn { ifName   = getOccName tycon,
-               ifTyVars = toIfaceTvBndrs tyvars,
+  = IfaceSyn { ifName    = getOccName tycon,
+               ifTyVars  = toIfaceTvBndrs tyvars,
                ifOpenSyn = syn_isOpen,
-               ifSynRhs  = toIfaceType syn_tyki }
+               ifSynRhs  = toIfaceType syn_tyki,
+                ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
+             }
 
   | isAlgTyCon tycon
   = IfaceData {        ifName    = getOccName tycon,
@@ -1091,8 +1116,7 @@ tyThingToIfaceDecl (ATyCon tycon)
       IfNewTyCon  (ifaceConDecl con)
     ifaceConDecls (DataTyCon { data_cons = cons })  = 
       IfDataTyCon (map ifaceConDecl cons)
-    ifaceConDecls OpenTyCon { otIsNewtype = False } = IfOpenDataTyCon
-    ifaceConDecls OpenTyCon { otIsNewtype = True  } = IfOpenNewTyCon
+    ifaceConDecls OpenTyCon {}                      = IfOpenDataTyCon
     ifaceConDecls AbstractTyCon                            = IfAbstractTyCon
        -- The last case happens when a TyCon has been trimmed during tidying
        -- Furthermore, tyThingToIfaceDecl is also used
@@ -1174,6 +1198,22 @@ famInstToIfaceFamInst fi@(FamInst { fi_tycon = tycon,
     do_rough (Just n) = Just (toIfaceTyCon_name n)
 
 --------------------------
+toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
+                              (toIfaceType (idType id)) 
+                              prag_info
+  where
+       -- Stripped-down version of tcIfaceIdInfo
+       -- Change this if you want to export more IdInfo for
+       -- non-top-level Ids.  Don't forget to change
+       -- CoreTidy.tidyLetBndr too!
+       --
+       -- See Note [IdInfo on nested let-bindings] in IfaceSyn
+    id_info = idInfo id
+    inline_prag = inlinePragInfo id_info
+    prag_info | isAlwaysActive inline_prag = NoInfo
+             | otherwise                  = HasInfo [HsInline inline_prag]
+
+--------------------------
 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
 toIfaceIdInfo id_info
   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, 
@@ -1282,8 +1322,8 @@ toIfaceNote InlineMe      = IfaceInlineMe
 toIfaceNote (CoreNote s)  = IfaceCoreNote s
 
 ---------------------
-toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceIdBndr b) (toIfaceExpr r)
-toIfaceBind (Rec prs)    = IfaceRec [(toIfaceIdBndr b, toIfaceExpr r) | (b,r) <- prs]
+toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
+toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
 
 ---------------------
 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
@@ -1322,6 +1362,8 @@ toIfaceVar v
   | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
          -- Foreign calls have special syntax
   | isExternalName name                    = IfaceExt name
+  | Just (TickBox m ix) <- isTickBoxOp_maybe v
+                                   = IfaceTick m ix
   | otherwise                      = IfaceLcl (getFS name)
   where
     name = idName v