[commit: ghc] wip/T14373: WIP: use new pre-join ability of emitSwitch (d755a58)

[git at git.haskell.org]

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

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

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

commit d755a5876866d68741ca6b7841348abf007801f7
Author: Gabor Greif <ggreif at gmail.com>
Date:   Fri Dec 15 12:06:59 2017 +0100

    WIP: use new pre-join ability of emitSwitch


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

d755a5876866d68741ca6b7841348abf007801f7
 compiler/codeGen/StgCmmExpr.hs | 23 ++++++++++++-----------
 1 file changed, 12 insertions(+), 11 deletions(-)

diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index 05492fc..b53dfe5 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) (return ())
+       ; 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) (return ())
+                 (if small then fam_sz else maxpt) (pure ())
 
            else -- No, get exact tag from info table when mAX_PTR_TAG
               do
@@ -636,15 +636,16 @@ 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 (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) (return ())
-                emitLabel join_lbl
+                emitSwitch tag_expr (catchall : ptr) mb_deflt 1 maxpt
+                --join_lbl <- newBlockId
+                --emit (mkBranch 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 ()))
+                --emitLabel join_lbl
 
         ; return AssignedDirectly }