summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/codeGen/CodeGen.lhs3
-rw-r--r--compiler/codeGen/StgCmmHpc.hs15
-rw-r--r--compiler/deSugar/Coverage.lhs7
-rw-r--r--compiler/deSugar/Desugar.lhs5
-rw-r--r--compiler/main/DynFlags.hs4
-rw-r--r--compiler/main/StaticFlags.hs7
-rw-r--r--compiler/parser/Lexer.x7
-rw-r--r--compiler/parser/Parser.y.pp8
-rw-r--r--docs/users_guide/flags.xml2
9 files changed, 28 insertions, 30 deletions
diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index 29193137a7..311f947248 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -35,7 +35,6 @@ import OldPprCmm ()
import StgSyn
import PrelNames
import DynFlags
-import StaticFlags
import HscTypes
import CostCentre
@@ -101,7 +100,7 @@ mkModuleInit
mkModuleInit dflags cost_centre_info this_mod hpc_info
= do { -- Allocate the static boolean that records if this
- ; whenC (opt_Hpc) $
+ ; whenC (dopt Opt_Hpc dflags) $
hpcTable this_mod hpc_info
; whenC (dopt Opt_SccProfilingOn dflags) $ do
diff --git a/compiler/codeGen/StgCmmHpc.hs b/compiler/codeGen/StgCmmHpc.hs
index 4465e30b04..8f4c8d9223 100644
--- a/compiler/codeGen/StgCmmHpc.hs
+++ b/compiler/codeGen/StgCmmHpc.hs
@@ -17,7 +17,7 @@ import Module
import CmmUtils
import StgCmmUtils
import HscTypes
-import StaticFlags
+import DynFlags
mkTickBox :: Module -> Int -> CmmAGraph
mkTickBox mod n
@@ -35,9 +35,10 @@ initHpc :: Module -> HpcInfo -> FCode ()
initHpc _ (NoHpcInfo {})
= return ()
initHpc this_mod (HpcInfo tickCount _hashNo)
- = whenC opt_Hpc $
- do { emitDataLits (mkHpcTicksLabel this_mod)
- [ (CmmInt 0 W64)
- | _ <- take tickCount [0::Int ..]
- ]
- }
+ = do dflags <- getDynFlags
+ whenC (dopt Opt_Hpc dflags) $
+ do emitDataLits (mkHpcTicksLabel this_mod)
+ [ (CmmInt 0 W64)
+ | _ <- take tickCount [0 :: Int ..]
+ ]
+
diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs
index 34500bb109..d93f85602d 100644
--- a/compiler/deSugar/Coverage.lhs
+++ b/compiler/deSugar/Coverage.lhs
@@ -23,7 +23,6 @@ import VarSet
import Data.List
import FastString
import HscTypes
-import StaticFlags
import TyCon
import Unique
import BasicTypes
@@ -91,7 +90,7 @@ addTicksToBinds dflags mod mod_loc exports tyCons binds =
, this_mod = mod
, tickishType = case hscTarget dflags of
HscInterpreted -> Breakpoints
- _ | opt_Hpc -> HpcTicks
+ _ | dopt Opt_Hpc dflags -> HpcTicks
| dopt Opt_SccProfilingOn dflags
-> ProfNotes
| otherwise -> error "addTicksToBinds: No way to annotate!"
@@ -146,7 +145,7 @@ mkModBreaks count entries = do
writeMixEntries :: DynFlags -> Module -> Int -> [MixEntry_] -> FilePath -> IO Int
writeMixEntries dflags mod count entries filename
- | not opt_Hpc = return 0
+ | not (dopt Opt_Hpc dflags) = return 0
| otherwise = do
let
hpc_dir = hpcDir dflags
@@ -184,7 +183,7 @@ data TickDensity
mkDensity :: DynFlags -> TickDensity
mkDensity dflags
- | opt_Hpc = TickForCoverage
+ | dopt Opt_Hpc dflags = TickForCoverage
| HscInterpreted <- hscTarget dflags = TickForBreakPoints
| ProfAutoAll <- profAuto dflags = TickAllFunctions
| ProfAutoTop <- profAuto dflags = TickTopFunctions
diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index 5d0e83f1f6..ee606808d9 100644
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -16,7 +16,6 @@ The Desugarer: turning HsSyn into Core.
module Desugar ( deSugar, deSugarExpr ) where
import DynFlags
-import StaticFlags
import HscTypes
import HsSyn
import TcRnTypes
@@ -109,7 +108,7 @@ deSugar hsc_env
Just ([], nilOL, [], [], NoStubs, hpcInfo, emptyModBreaks))
_ -> do
- let want_ticks = opt_Hpc
+ let want_ticks = dopt Opt_Hpc dflags
|| target == HscInterpreted
|| (dopt Opt_SccProfilingOn dflags
&& case profAuto dflags of
@@ -130,7 +129,7 @@ deSugar hsc_env
; ds_rules <- mapMaybeM dsRule rules
; ds_vects <- mapM dsVect vects
; let hpc_init
- | opt_Hpc = hpcInitCode mod ds_hpc_info
+ | dopt Opt_Hpc dflags = hpcInitCode mod ds_hpc_info
| otherwise = empty
; return ( ds_ev_binds
, foreign_prs `appOL` core_prs `appOL` spec_prs
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 3451dfdf18..723bf44b8b 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -327,6 +327,7 @@ data DynFlag
| Opt_SccProfilingOn
| Opt_Ticky
| Opt_Static
+ | Opt_Hpc
-- output style opts
| Opt_PprCaseAsLet
@@ -2275,7 +2276,8 @@ fFlags = [
( "building-cabal-package", Opt_BuildingCabalPackage, nop ),
( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ),
( "prof-count-entries", Opt_ProfCountEntries, nop ),
- ( "prof-cafs", Opt_AutoSccsOnIndividualCafs, nop )
+ ( "prof-cafs", Opt_AutoSccsOnIndividualCafs, nop ),
+ ( "hpc", Opt_Hpc, nop )
]
-- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index df6d9245b4..3165c6944b 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -37,9 +37,6 @@ module StaticFlags (
opt_SuppressTypeSignatures,
opt_SuppressVarKinds,
- -- Hpc opts
- opt_Hpc,
-
-- language opts
opt_DictsStrict,
@@ -219,10 +216,6 @@ opt_PprStyle_Debug = lookUp (fsLit "-dppr-debug")
opt_NoDebugOutput :: Bool
opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output")
--- Hpc opts
-opt_Hpc :: Bool
-opt_Hpc = lookUp (fsLit "-fhpc")
-
-- language opts
opt_DictsStrict :: Bool
opt_DictsStrict = lookUp (fsLit "-fdicts-strict")
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index b872a7d953..91f00ecf2f 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -57,7 +57,7 @@ module Lexer (
extension, bangPatEnabled, datatypeContextsEnabled,
traditionalRecordSyntaxEnabled,
typeLiteralsEnabled,
- explicitNamespacesEnabled, sccProfilingOn,
+ explicitNamespacesEnabled, sccProfilingOn, hpcEnabled,
addWarning,
lexTokenStream
) where
@@ -1851,6 +1851,8 @@ rawTokenStreamBit :: Int
rawTokenStreamBit = 20 -- producing a token stream with all comments included
sccProfilingOnBit :: Int
sccProfilingOnBit = 21
+hpcBit :: Int
+hpcBit = 22
alternativeLayoutRuleBit :: Int
alternativeLayoutRuleBit = 23
relaxedLayoutBit :: Int
@@ -1907,6 +1909,8 @@ rawTokenStreamEnabled :: Int -> Bool
rawTokenStreamEnabled flags = testBit flags rawTokenStreamBit
alternativeLayoutRule :: Int -> Bool
alternativeLayoutRule flags = testBit flags alternativeLayoutRuleBit
+hpcEnabled :: Int -> Bool
+hpcEnabled flags = testBit flags hpcBit
relaxedLayout :: Int -> Bool
relaxedLayout flags = testBit flags relaxedLayoutBit
nondecreasingIndentation :: Int -> Bool
@@ -1977,6 +1981,7 @@ mkPState flags buf loc =
.|. transformComprehensionsBit `setBitIf` xopt Opt_TransformListComp flags
.|. transformComprehensionsBit `setBitIf` xopt Opt_MonadComprehensions flags
.|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags
+ .|. hpcBit `setBitIf` dopt Opt_Hpc flags
.|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags
.|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags
.|. sccProfilingOnBit `setBitIf` dopt Opt_SccProfilingOn flags
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index ac6a73784b..718adcabfd 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -53,7 +53,6 @@ import OccName ( varName, dataName, tcClsName, tvName )
import DataCon ( DataCon, dataConName )
import SrcLoc
import Module
-import StaticFlags ( opt_Hpc )
import Kind ( Kind, liftedTypeKind, unliftedTypeKind, mkArrowKind )
import Class ( FunDep )
import BasicTypes
@@ -1416,9 +1415,10 @@ exp10 :: { LHsExpr RdrName }
; return $ LL $ if on
then HsSCC (unLoc $1) $2
else HsPar $2 } }
- | hpc_annot exp { LL $ if opt_Hpc
- then HsTickPragma (unLoc $1) $2
- else HsPar $2 }
+ | hpc_annot exp {% do { on <- extension hpcEnabled
+ ; return $ LL $ if on
+ then HsTickPragma (unLoc $1) $2
+ else HsPar $2 } }
| 'proc' aexp '->' exp
{% checkPattern $2 >>= \ p ->
diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 00c9b449c7..c2e226cf38 100644
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -1847,7 +1847,7 @@
<row>
<entry><option>-fhpc</option></entry>
<entry>Turn on Haskell program coverage instrumentation</entry>
- <entry>static</entry>
+ <entry>dynamic</entry>
<entry><option>-</option></entry>
</row>
<row>
View Lorry Controller Status