Ticky: Gate tag-inference dummy ticky-counters behind a flag.

Tag inference included a way to collect stats about avoided tag-checks.
This was dony by emitting "dummy" ticky entries with counts corresponding
to predicted/unpredicated tag checks.

This behaviour for ticky is now gated behind -fticky-tag-checks.

I also documented ticky-LNE in the process.

6 files changed, 14 insertions, 6 deletions

diff --git a/compiler/GHC/Driver/Config/StgToCmm.hs b/compiler/GHC/Driver/Config/StgToCmm.hs
index ab64076a79..4b0e126f98 100644
--- a/compiler/GHC/Driver/Config/StgToCmm.hs
+++ b/compiler/GHC/Driver/Config/StgToCmm.hs
@@ -29,6 +29,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
   , stgToCmmTickyAllocd   = gopt Opt_Ticky_Allocd          dflags
   , stgToCmmTickyLNE      = gopt Opt_Ticky_LNE             dflags
   , stgToCmmTickyDynThunk = gopt Opt_Ticky_Dyn_Thunk       dflags
+  , stgToCmmTickyTag      = gopt Opt_Ticky_Tag             dflags
   -- flags
   , stgToCmmLoopification = gopt Opt_Loopification         dflags
   , stgToCmmAlignCheck    = gopt Opt_AlignmentSanitisation dflags
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index f843b28bd8..b8abc2f9a2 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -295,6 +295,7 @@ data GeneralFlag
    | Opt_Ticky_Allocd
    | Opt_Ticky_LNE
    | Opt_Ticky_Dyn_Thunk
+   | Opt_Ticky_Tag
    | Opt_RPath
    | Opt_RelativeDynlibPaths
    | Opt_CompactUnwind               -- ^ @-fcompact-unwind@
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index f7d05d063d..bf4eaae513 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -2334,6 +2334,8 @@ dynamic_flags_deps = [
         (NoArg (setGeneralFlag Opt_Ticky_LNE))
   , make_ord_flag defGhcFlag "ticky-dyn-thunk"
         (NoArg (setGeneralFlag Opt_Ticky_Dyn_Thunk))
+  , make_ord_flag defGhcFlag "ticky-tag-checks"
+        (NoArg (setGeneralFlag Opt_Ticky_Tag))
         ------- recompilation checker --------------------------------------
   , make_dep_flag defGhcFlag "recomp"
         (NoArg $ unSetGeneralFlag Opt_ForceRecomp)
diff --git a/compiler/GHC/Iface/Recomp/Flags.hs b/compiler/GHC/Iface/Recomp/Flags.hs
index 90f3afebbc..b1f6c66e79 100644
--- a/compiler/GHC/Iface/Recomp/Flags.hs
+++ b/compiler/GHC/Iface/Recomp/Flags.hs
@@ -66,7 +66,7 @@ fingerprintDynFlags hsc_env this_mod nameio =
 
         -- Ticky
         ticky =
-          map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk]
+          map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag]
 
         flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters))
 
diff --git a/compiler/GHC/StgToCmm/Config.hs b/compiler/GHC/StgToCmm/Config.hs
index 28c11e1321..623a7b8f0a 100644
--- a/compiler/GHC/StgToCmm/Config.hs
+++ b/compiler/GHC/StgToCmm/Config.hs
@@ -35,6 +35,7 @@ data StgToCmmConfig = StgToCmmConfig
                                                  -- join-points (let-no-escape)
   , stgToCmmTickyDynThunk  :: !Bool              -- ^ True indicates ticky uses name-specific counters for
                                                  -- dynamic thunks
+  , stgToCmmTickyTag       :: !Bool              -- ^ True indicates ticky will count number of avoided tag checks by tag inference.
   ---------------------------------- Flags --------------------------------------
   , stgToCmmLoopification  :: !Bool              -- ^ Loopification enabled (cf @-floopification@)
   , stgToCmmAlignCheck     :: !Bool              -- ^ Insert alignment check (cf @-falignment-sanitisation@)
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index 57bf1a97b6..4aec817412 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -319,7 +319,7 @@ emitTickyCounterTag unique (NonVoid id) =
   let name = idName id
       ctr_lbl = mkTagHitLabel name unique in
     (>> return ctr_lbl) $
-    ifTicky $ do
+    ifTickyTag $ do
         { platform <- getPlatform
         ; parent <- getTickyCtrLabel
         ; mod_name <- getModuleName
@@ -664,18 +664,18 @@ tickyStackCheck = ifTicky $ bumpTickyCounter (fsLit "STK_CHK_ctr")
 
 -- | Predicted a pointer would be tagged correctly (GHC will crash if not so no miss case)
 tickyTagged :: FCode ()
-tickyTagged         = ifTicky $ bumpTickyCounter (fsLit "TAG_TAGGED_pred")
+tickyTagged         = ifTickyTag $ bumpTickyCounter (fsLit "TAG_TAGGED_pred")
 
 -- | Pass a boolean expr indicating if tag was present.
 tickyUntagged :: CmmExpr -> FCode ()
 tickyUntagged e     = do
-    ifTicky $ bumpTickyCounter (fsLit "TAG_UNTAGGED_pred")
-    ifTicky $ bumpTickyCounterByE (fsLit "TAG_UNTAGGED_miss") e
+    ifTickyTag $ bumpTickyCounter (fsLit "TAG_UNTAGGED_pred")
+    ifTickyTag $ bumpTickyCounterByE (fsLit "TAG_UNTAGGED_miss") e
 
 -- | Called when for `case v of ...` we can avoid entering v based on
 -- tag inference information.
 tickyTagSkip :: Unique -> Id -> FCode ()
-tickyTagSkip unique id = ifTicky $ do
+tickyTagSkip unique id = ifTickyTag $ do
   let ctr_lbl = mkTagHitLabel (idName id) unique
   registerTickyCtr ctr_lbl
   bumpTickyTagSkip ctr_lbl
@@ -692,6 +692,9 @@ runIfFlag f = whenM (f <$> getStgToCmmConfig)
 ifTicky :: FCode () -> FCode ()
 ifTicky = runIfFlag stgToCmmDoTicky
 
+ifTickyTag :: FCode () -> FCode ()
+ifTickyTag = runIfFlag stgToCmmTickyTag
+
 ifTickyAllocd :: FCode () -> FCode ()
 ifTickyAllocd = runIfFlag stgToCmmTickyAllocd