[commit: ghc] wip/T14373: Extra argument for emitting pre-join label code (af8914d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T14373
Link       : http://ghc.haskell.org/trac/ghc/changeset/af8914ddbd1eae626bd950a59a9e7032fc4e6c64/ghc

>---------------------------------------------------------------

commit af8914ddbd1eae626bd950a59a9e7032fc4e6c64
Author: Gabor Greif <ggreif at gmail.com>
Date:   Fri Dec 15 11:54:49 2017 +0100

    Extra argument for emitting pre-join label code
    
    in 'emitSwitch'. The former functionality can be
    recovered by passing `(pure ())`.
    
    Now we can eliminate the forming a the weird branch island
    around the switch on info-pointer tag (`cgAlts` in StgCmmExpr.hs).


>---------------------------------------------------------------

af8914ddbd1eae626bd950a59a9e7032fc4e6c64
 compiler/codeGen/StgCmmExpr.hs  | 18 ++++++++----------
 compiler/codeGen/StgCmmUtils.hs | 12 +++++++-----
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index a793048..5bb2528 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -307,7 +307,7 @@ cgCase (StgOpApp (StgPrimOp op) args _) bndr (AlgAlt tycon) alts
        ; (mb_deflt, branches) <- cgAlgAltRhss (NoGcInAlts,AssignedDirectly)
                                               (NonVoid bndr) alts
                                  -- See Note [GC for conditionals]
-       ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1)
+       ; emitSwitch tag_expr branches mb_deflt 0 (tyConFamilySize tycon - 1) (pure ())
        ; return AssignedDirectly
        }
   where
@@ -620,7 +620,7 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts
         ; if small || null info
            then -- Yes, bndr_reg has constr. tag in ls bits
                emitSwitch tag_expr branches' mb_deflt 1
-                 $ if small then fam_sz else maxpt
+                 (if small then fam_sz else maxpt) (pure ())
 
            else -- No, get exact tag from info table when mAX_PTR_TAG
               do
@@ -637,14 +637,12 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts
 
                 (mb_deflt, mb_branch) <- prelabel mb_deflt
                 emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt
-                join_lbl <- newBlockId
-                emit (mkBranch join_lbl)
-                emitLabel infos_lbl
-                let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg)
-                    tag_expr = getConstrTag dflags untagged_ptr
-                    info0 = first pred <$> info
-                emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1)
-                emitLabel join_lbl
+                  (do emitLabel infos_lbl
+                      let untagged_ptr = cmmUntag dflags (CmmReg bndr_reg)
+                          tag_expr = getConstrTag dflags untagged_ptr
+                          info0 = first pred <$> info
+                      emitSwitch tag_expr info0 mb_branch
+                        (maxpt - 1) (fam_sz - 1) (pure ()))
 
         ; return AssignedDirectly }
 
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 07432c4..0b77bc9 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -453,14 +453,16 @@ emitSwitch :: CmmExpr                      -- Tag to switch on
            -> ConTagZ -> ConTagZ           -- Min and Max possible values;
                                            -- behaviour outside this range is
                                            -- undefined
+           -> FCode ()                     -- code to insert before join label
            -> FCode ()
 
--- First, two rather common cases in which there is no work to do
-emitSwitch _ []         (Just code) _ _ = emit (fst code)
-emitSwitch _ [(_,code)] Nothing     _ _ = emit (fst code)
+-- First, three rather common cases in which there is no work to do
+emitSwitch _ []         (Just code) _ _ pj = emit (fst code) >> pj
+emitSwitch _ [(_,code)] Nothing     _ _ pj = emit (fst code) >> pj
+emitSwitch _ []         Nothing     _ _ pj = pj
 
 -- Right, off we go
-emitSwitch tag_expr branches mb_deflt lo_tag hi_tag = do
+emitSwitch tag_expr branches mb_deflt lo_tag hi_tag pj = do
     join_lbl      <- newBlockId
     mb_deflt_lbl  <- label_default join_lbl mb_deflt
     branches_lbls <- label_branches join_lbl branches
@@ -472,7 +474,7 @@ emitSwitch tag_expr branches mb_deflt lo_tag hi_tag = do
 
     emit $ mk_discrete_switch False tag_expr' branches_lbls' mb_deflt_lbl range
 
-    emitLabel join_lbl
+    pj >> emitLabel join_lbl
 
 mk_discrete_switch :: Bool -- ^ Use signed comparisons
           -> CmmExpr