diff options
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/DynFlags.hs | 20 | ||||
| -rw-r--r-- | compiler/main/HscMain.lhs | 7 | ||||
| -rw-r--r-- | compiler/main/HscTypes.lhs | 22 | ||||
| -rw-r--r-- | compiler/main/TidyPgm.lhs | 14 |
4 files changed, 53 insertions, 10 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 20376f05dc..53fa11aa28 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -121,6 +121,7 @@ data DynFlag | Opt_D_dump_splices | Opt_D_dump_BCOs | Opt_D_dump_vect + | Opt_D_dump_hpc | Opt_D_source_stats | Opt_D_verbose_core2core | Opt_D_verbose_stg2stg @@ -198,6 +199,8 @@ data DynFlag | Opt_HideAllPackages | Opt_PrintBindResult | Opt_Haddock + | Opt_Hpc + | Opt_Hpc_Trace -- keeping stuff | Opt_KeepHiDiffs @@ -255,6 +258,8 @@ data DynFlags = DynFlags { ghcUsagePath :: FilePath, -- Filled in by SysTools ghciUsagePath :: FilePath, -- ditto + hpcDir :: String, -- ^ path to store the .mix files + -- options for particular phases opt_L :: [String], opt_P :: [String], @@ -392,6 +397,8 @@ defaultDynFlags = cmdlineFrameworks = [], tmpDir = cDEFAULT_TMPDIR, + hpcDir = ".hpc", + opt_L = [], opt_P = [], opt_F = [], @@ -875,6 +882,7 @@ dynamic_flags = [ , ( "no-hs-main" , NoArg (setDynFlag Opt_NoHsMain)) , ( "main-is" , SepArg setMainIs ) , ( "haddock" , NoArg (setDynFlag Opt_Haddock) ) + , ( "hpcdir" , SepArg setOptHpcDir ) ------- recompilation checker (DEPRECATED, use -fforce-recomp) ----- , ( "recomp" , NoArg (unSetDynFlag Opt_ForceRecomp) ) @@ -938,6 +946,8 @@ dynamic_flags = [ , ( "ddump-hi", setDumpFlag Opt_D_dump_hi) , ( "ddump-minimal-imports", NoArg (setDynFlag Opt_D_dump_minimal_imports)) , ( "ddump-vect", setDumpFlag Opt_D_dump_vect) + , ( "ddump-hpc", setDumpFlag Opt_D_dump_hpc) + , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting)) , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting)) , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting)) @@ -1041,7 +1051,9 @@ fFlags = [ ( "excess-precision", Opt_ExcessPrecision ), ( "asm-mangling", Opt_DoAsmMangling ), ( "print-bind-result", Opt_PrintBindResult ), - ( "force-recomp", Opt_ForceRecomp ) + ( "force-recomp", Opt_ForceRecomp ), + ( "hpc", Opt_Hpc ), + ( "hpc-tracer", Opt_Hpc ) ] @@ -1244,6 +1256,12 @@ setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir } #endif ----------------------------------------------------------------------------- +-- Hpc stuff + +setOptHpcDir :: String -> DynP () +setOptHpcDir arg = upd $ \ d -> d{hpcDir = arg} + +----------------------------------------------------------------------------- -- Via-C compilation stuff machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs index 31995f0962..6c09b97c93 100644 --- a/compiler/main/HscMain.lhs +++ b/compiler/main/HscMain.lhs @@ -466,7 +466,7 @@ hscFileFrontEnd = ------------------- -- DESUGAR ------------------- - -> {-# SCC "DeSugar" #-} deSugar hsc_env tc_result + -> {-# SCC "DeSugar" #-} deSugar hsc_env (ms_location mod_summary) tc_result -------------------------------------------------------------- -- Simplifiers @@ -583,7 +583,8 @@ hscCompile cgguts cg_tycons = tycons, cg_dir_imps = dir_imps, cg_foreign = foreign_stubs, - cg_dep_pkgs = dependencies } = cgguts + cg_dep_pkgs = dependencies, + cg_hpc_info = hpc_info } = cgguts dflags = hsc_dflags hsc_env location = ms_location mod_summary data_tycons = filter isDataTyCon tycons @@ -603,7 +604,7 @@ hscCompile cgguts abstractC <- {-# SCC "CodeGen" #-} codeGen dflags this_mod data_tycons foreign_stubs dir_imps cost_centre_info - stg_binds + stg_binds hpc_info ------------------ Code output ----------------------- (stub_h_exists,stub_c_exists) <- codeOutput dflags this_mod location foreign_stubs diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index c5483b90e1..4dc7894133 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -58,7 +58,8 @@ module HscTypes ( -- Linker stuff Linkable(..), isObjectLinkable, Unlinked(..), CompiledByteCode, - isObject, nameOfObject, isInterpretable, byteCodeOfObject + isObject, nameOfObject, isInterpretable, byteCodeOfObject, + HpcInfo, noHpcInfo ) where #include "HsVersions.h" @@ -480,7 +481,8 @@ data ModGuts mg_fam_insts :: ![FamInst], -- Instances mg_rules :: ![CoreRule], -- Rules from this module mg_binds :: ![CoreBind], -- Bindings for this module - mg_foreign :: !ForeignStubs + mg_foreign :: !ForeignStubs, + mg_hpc_info :: !HpcInfo -- info about coverage tick boxes } -- The ModGuts takes on several slightly different forms: @@ -517,7 +519,8 @@ data CgGuts -- initialisation code cg_foreign :: !ForeignStubs, - cg_dep_pkgs :: ![PackageId] -- Used to generate #includes for C code gen + cg_dep_pkgs :: ![PackageId], -- Used to generate #includes for C code gen + cg_hpc_info :: !HpcInfo -- info about coverage tick boxes } ----------------------------------- @@ -1139,6 +1142,19 @@ showModMsg target recomp mod_summary %************************************************************************ %* * +\subsection{Hpc Support} +%* * +%************************************************************************ + +\begin{code} +type HpcInfo = Int -- just the number of ticks in a module + +noHpcInfo :: HpcInfo +noHpcInfo = 0 -- default = 0 +\end{code} + +%************************************************************************ +%* * \subsection{Linkable stuff} %* * %************************************************************************ diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index b95d4d31ab..331d921489 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -239,7 +239,8 @@ tidyProgram hsc_env mg_binds = binds, mg_rules = imp_rules, mg_dir_imps = dir_imps, mg_deps = deps, - mg_foreign = foreign_stubs }) + mg_foreign = foreign_stubs, + mg_hpc_info = hpc_info }) = do { let dflags = hsc_dflags hsc_env ; showPass dflags "Tidy Core" @@ -290,7 +291,8 @@ tidyProgram hsc_env cg_binds = all_tidy_binds, cg_dir_imps = dir_imps, cg_foreign = foreign_stubs, - cg_dep_pkgs = dep_pkgs deps }, + cg_dep_pkgs = dep_pkgs deps, + cg_hpc_info = hpc_info }, ModDetails { md_types = tidy_type_env, md_rules = tidy_rules, @@ -789,11 +791,17 @@ CAF list to keep track of non-collectable CAFs. \begin{code} hasCafRefs :: PackageId -> VarEnv Var -> Arity -> CoreExpr -> CafInfo hasCafRefs this_pkg p arity expr - | is_caf || mentions_cafs = MayHaveCafRefs + | is_caf || mentions_cafs || is_tick + = MayHaveCafRefs | otherwise = NoCafRefs where mentions_cafs = isFastTrue (cafRefs p expr) is_caf = not (arity > 0 || rhsIsStatic this_pkg expr) + is_tick = case expr of + Note (TickBox {}) _ -> True + Note (BinaryTickBox {}) _ -> True + _ -> False + -- NB. we pass in the arity of the expression, which is expected -- to be calculated by exprArity. This is because exprArity -- knows how much eta expansion is going to be done by |