Adding pushing of hpc translation status through hi files.

[ghc-hetmet.git] / compiler / deSugar / Desugar.lhs

diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index cb861ae..9a4c261 100644 (file)
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -71,13 +71,15 @@ deSugar hsc_env
                            tcg_keep         = keep_var,
                            tcg_rdr_env      = rdr_env,
                            tcg_fix_env      = fix_env,
+                           tcg_inst_env     = inst_env,
                            tcg_fam_inst_env = fam_inst_env,
                            tcg_deprecs      = deprecs,
                            tcg_binds        = binds,
                            tcg_fords        = fords,
                            tcg_rules        = rules,
                            tcg_insts        = insts,
-                           tcg_fam_insts    = fam_insts })
+                           tcg_fam_insts    = fam_insts,
+                           tcg_hpc          = other_hpc_info })
 
   = do { let dflags = hsc_dflags hsc_env
         ; showPass dflags "Desugar"
@@ -86,12 +88,15 @@ deSugar hsc_env
         ; let export_set = availsToNameSet exports
        ; let auto_scc = mkAutoScc mod export_set
         ; let target = hscTarget dflags
+        ; let hpcInfo = emptyHpcInfo other_hpc_info
        ; mb_res <- case target of
-                    HscNothing -> return (Just ([], [], NoStubs, noHpcInfo, emptyModBreaks))
+                    HscNothing -> return (Just ([], [], NoStubs, hpcInfo, emptyModBreaks))
                      _        -> do (binds_cvr,ds_hpc_info, modBreaks) 
-                                             <- if opt_Hpc || target == HscInterpreted
+                                             <- if (opt_Hpc 
+                                                       || target == HscInterpreted)
+                                                    && (not (isHsBoot hsc_src))                                                        
                                                  then addCoverageTicksToBinds dflags mod mod_loc (typeEnvTyCons type_env) binds 
-                                                 else return (binds, noHpcInfo, emptyModBreaks)
+                                                 else return (binds, hpcInfo, emptyModBreaks)
                                     initDs hsc_env mod rdr_env type_env $ do
                                        { core_prs <- dsTopLHsBinds auto_scc binds_cvr
                                        ; (ds_fords, foreign_prs) <- dsForeigns fords
@@ -168,6 +173,7 @@ deSugar hsc_env
                mg_types        = type_env,
                mg_insts        = insts,
                mg_fam_insts    = fam_insts,
+               mg_inst_env     = inst_env,
                mg_fam_inst_env = fam_inst_env,
                mg_rules        = ds_rules,
                mg_binds        = ds_binds,