WIP: Add likelyhood to alternatives from stg onwardswip/D4327

Summary:
Adds a Freq value to Stg/Cmm cases/switches/conditionals.

Currently only generates these values by checking alternatives for
bottom expressions.

They are passed along to the backend where they affect conditional generation
slightly.

As it stands runtime improvements seem to be less than expected. This might only be worth merging once we have more branch weights available.

Reviewers: hvr, goldfire, bgamari, simonmar, simonpj, erikd

Reviewed By: simonpj

Subscribers: simonpj, rwbarton, thomie, carter

GHC Trac Issues: #14672

Differential Revision: https://phabricator.haskell.org/D4327

1 files changed, 25 insertions, 24 deletions

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 3fcc935121..ab0e6d0c2a 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -31,6 +31,7 @@ import StgCmmClosure
 
 import StgSyn
 
+import BasicTypes (BranchWeight)
 import MkGraph
 import BlockId
 import Cmm
@@ -379,7 +380,7 @@ calls to nonVoidIds in various places.  So we must not look up
 
 cgCase (StgApp v []) _ (PrimAlt _) alts
   | isVoidRep (idPrimRep v)  -- See Note [Scrutinising VoidRep]
-  , [(DEFAULT, _, rhs)] <- alts
+  , [(DEFAULT, _, rhs, _)] <- alts
   = cgExpr rhs
 
 {- Note [Dodgy unsafeCoerce 1]
@@ -561,7 +562,7 @@ chooseReturnBndrs :: Id -> AltType -> [StgAlt] -> [NonVoid Id]
 chooseReturnBndrs bndr (PrimAlt _) _alts
   = assertNonVoidIds [bndr]
 
-chooseReturnBndrs _bndr (MultiValAlt n) [(_, ids, _)]
+chooseReturnBndrs _bndr (MultiValAlt n) [(_, ids, _, _)]
   = ASSERT2(ids `lengthIs` n, ppr n $$ ppr ids $$ ppr _bndr)
     assertNonVoidIds ids     -- 'bndr' is not assigned!
 
@@ -578,10 +579,10 @@ chooseReturnBndrs _ _ _ = panic "chooseReturnBndrs"
 cgAlts :: (GcPlan,ReturnKind) -> NonVoid Id -> AltType -> [StgAlt]
        -> FCode ReturnKind
 -- At this point the result of the case are in the binders
-cgAlts gc_plan _bndr PolyAlt [(_, _, rhs)]
+cgAlts gc_plan _bndr PolyAlt [(_, _, rhs, _)]
   = maybeAltHeapCheck gc_plan (cgExpr rhs)
 
-cgAlts gc_plan _bndr (MultiValAlt _) [(_, _, rhs)]
+cgAlts gc_plan _bndr (MultiValAlt _) [(_, _, rhs, _)]
   = maybeAltHeapCheck gc_plan (cgExpr rhs)
         -- Here bndrs are *already* in scope, so don't rebind them
 
@@ -591,13 +592,13 @@ cgAlts gc_plan bndr (PrimAlt _) alts
         ; tagged_cmms <- cgAltRhss gc_plan bndr alts
 
         ; let bndr_reg = CmmLocal (idToReg dflags bndr)
-              (DEFAULT,deflt) = head tagged_cmms
+              (DEFAULT,deflt,f) = head tagged_cmms
                 -- PrimAlts always have a DEFAULT case
                 -- and it always comes first
 
-              tagged_cmms' = [(lit,code)
-                             | (LitAlt lit, code) <- tagged_cmms]
-        ; emitCmmLitSwitch (CmmReg bndr_reg) tagged_cmms' deflt
+              tagged_cmms' = [(lit,code,f)
+                             | (LitAlt lit, code,f) <- tagged_cmms]
+        ; emitCmmLitSwitch (CmmReg bndr_reg) tagged_cmms' (deflt,f)
         ; return AssignedDirectly }
 
 cgAlts gc_plan bndr (AlgAlt tycon) alts
@@ -613,7 +614,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts
           then do
                 let   -- Yes, bndr_reg has constr. tag in ls bits
                    tag_expr = cmmConstrTag1 dflags (CmmReg bndr_reg)
-                   branches' = [(tag+1,branch) | (tag,branch) <- branches]
+                   branches' = [(tag+1,branch,f) | (tag,branch,f) <- branches]
                 emitSwitch tag_expr branches' mb_deflt 1 fam_sz
 
            else -- No, get tag from info table
@@ -651,18 +652,18 @@ cgAlts _ _ _ _ = panic "cgAlts"
 
 -------------------
 cgAlgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [StgAlt]
-             -> FCode ( Maybe CmmAGraphScoped
-                      , [(ConTagZ, CmmAGraphScoped)] )
+             -> FCode ( Maybe (CmmAGraphScoped, BranchWeight)
+                      , [(ConTagZ, CmmAGraphScoped, BranchWeight)] )
 cgAlgAltRhss gc_plan bndr alts
   = do { tagged_cmms <- cgAltRhss gc_plan bndr alts
 
        ; let { mb_deflt = case tagged_cmms of
-                           ((DEFAULT,rhs) : _) -> Just rhs
+                           ((DEFAULT,rhs,f) : _) -> Just (rhs,f)
                            _other              -> Nothing
                             -- DEFAULT is always first, if present
 
-              ; branches = [ (dataConTagZ con, cmm)
-                           | (DataAlt con, cmm) <- tagged_cmms ]
+              ; branches = [ (dataConTagZ con, cmm, f)
+                           | (DataAlt con, cmm, f) <- tagged_cmms ]
               }
 
        ; return (mb_deflt, branches)
@@ -671,20 +672,20 @@ cgAlgAltRhss gc_plan bndr alts
 
 -------------------
 cgAltRhss :: (GcPlan,ReturnKind) -> NonVoid Id -> [StgAlt]
-          -> FCode [(AltCon, CmmAGraphScoped)]
+          -> FCode [(AltCon, CmmAGraphScoped,BranchWeight)]
 cgAltRhss gc_plan bndr alts = do
   dflags <- getDynFlags
   let
     base_reg = idToReg dflags bndr
-    cg_alt :: StgAlt -> FCode (AltCon, CmmAGraphScoped)
-    cg_alt (con, bndrs, rhs)
-      = getCodeScoped             $
-        maybeAltHeapCheck gc_plan $
-        do { _ <- bindConArgs con base_reg (assertNonVoidIds bndrs)
-                    -- alt binders are always non-void,
-                    -- see Note [Post-unarisation invariants] in UnariseStg
-           ; _ <- cgExpr rhs
-           ; return con }
+    cg_alt :: StgAlt -> FCode (AltCon, CmmAGraphScoped, BranchWeight)
+    cg_alt (con, bndrs, rhs, freq) = do
+      (i,c) <- getCodeScoped $ maybeAltHeapCheck gc_plan $
+          do { _ <- bindConArgs con base_reg (assertNonVoidIds bndrs)
+                      -- alt binders are always non-void,
+                      -- see Note [Post-unarisation invariants] in UnariseStg
+            ; _ <- cgExpr rhs
+            ; return con }
+      return (i,c,freq)
   forkAlts (map cg_alt alts)
 
 maybeAltHeapCheck :: (GcPlan,ReturnKind) -> FCode a -> FCode a