[commit: ghc] wip/T14373: WIP: cater for emitting pre-join label code in 'emitSwitch' (ffd0d09)

[git at git.haskell.org]

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

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

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

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

    WIP: cater for emitting pre-join label code in 'emitSwitch'


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

ffd0d09998839dbb53663b7f7af602230228c1e8
 compiler/codeGen/StgCmmExpr.hs  | 8 ++++----
 compiler/codeGen/StgCmmUtils.hs | 9 +++++----
 2 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index a793048..05492fc 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) (return ())
        ; 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) (return ())
 
            else -- No, get exact tag from info table when mAX_PTR_TAG
               do
@@ -636,14 +636,14 @@ cgAlts gc_plan bndr (AlgAlt tycon) alts
                     prelabel _ = return (Nothing, Nothing)
 
                 (mb_deflt, mb_branch) <- prelabel mb_deflt
-                emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt
+                emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt (return ())
                 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)
+                emitSwitch tag_expr info0 mb_branch (maxpt - 1) (fam_sz - 1) (return ())
                 emitLabel join_lbl
 
         ; return AssignedDirectly }
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 07432c4..2e12b16 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -453,14 +453,15 @@ 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)
+emitSwitch _ []         (Just code) _ _ pj = emit (fst code) >> pj
+emitSwitch _ [(_,code)] Nothing     _ _ pj = emit (fst code) >> 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 +473,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