[commit: ghc] master: Merge cgTailCall and cgLneJump into one function (388e14e)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/388e14e28c2ab70419dc3be610da9806a8e38325/ghc

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

commit 388e14e28c2ab70419dc3be610da9806a8e38325
Author: Jan Stolarek <jan.stolarek at p.lodz.pl>
Date:   Tue Aug 20 15:03:26 2013 +0100

    Merge cgTailCall and cgLneJump into one function
    
    Previosly logic of these functions was sth like this:
    
      cgIdApp x = case x of
                    A -> cgLneJump x
                    _ -> cgTailCall x
    
      cgTailCall x = case x of
                       B -> ...
                       C -> ...
                       _ -> ...
    
    After merging there is no nesting of cases:
    
      cgIdApp x = case x of
                    A -> -- body of cgLneJump
                    B -> ...
                    C -> ...
                    _ -> ...


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

388e14e28c2ab70419dc3be610da9806a8e38325
 compiler/codeGen/StgCmmBind.hs |    2 +-
 compiler/codeGen/StgCmmExpr.hs |   46 ++++++++++++++--------------------------
 2 files changed, 17 insertions(+), 31 deletions(-)

diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 516b519..ce5491d 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -423,7 +423,7 @@ mkClosureLFInfo dflags bndr top fvs upd_flag args
 
 
 ------------------------------------------------------------------------
---              The code for closures}
+--              The code for closures
 ------------------------------------------------------------------------
 
 closureCodeBody :: Bool            -- whether this is a top-level binding
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index b19341b..24b12f7 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -629,29 +629,16 @@ cgConApp con stg_args
         ; emit =<< fcode_init
         ; emitReturn [idInfoToAmode idinfo] }
 
-
 cgIdApp :: Id -> [StgArg] -> FCode ReturnKind
 cgIdApp fun_id [] | isVoidId fun_id = emitReturn []
-cgIdApp fun_id args
-  = do  { fun_info <- getCgIdInfo fun_id
-        ; case maybeLetNoEscape fun_info of
-            Just (blk_id, lne_regs) -> cgLneJump blk_id lne_regs args
-            Nothing -> cgTailCall (cg_id fun_info) fun_info args }
-            -- NB. use (cg_id fun_info) instead of fun_id, because the former
-            -- may be externalised for -split-objs.
-            -- See StgCmm.maybeExternaliseId.
-
-cgLneJump :: BlockId -> [LocalReg] -> [StgArg] -> FCode ReturnKind
-cgLneJump blk_id lne_regs args  -- Join point; discard sequel
-  = do  { adjustHpBackwards -- always do this before a tail-call
-        ; cmm_args <- getNonVoidArgAmodes args
-        ; emitMultiAssign lne_regs cmm_args
-        ; emit (mkBranch blk_id)
-        ; return AssignedDirectly }
-
-cgTailCall :: Id -> CgIdInfo -> [StgArg] -> FCode ReturnKind
-cgTailCall fun_id fun_info args = do
-    dflags <- getDynFlags
+cgIdApp fun_id args = do
+    dflags   <- getDynFlags
+    fun_info <- getCgIdInfo fun_id
+    let fun_arg     = StgVarArg fun_id
+        fun_name    = idName            fun_id
+        fun         = idInfoToAmode     fun_info
+        lf_info     = cg_lf        fun_info
+        node_points dflags = nodeMustPointToIt dflags lf_info
     case (getCallMethod dflags fun_name (idCafInfo fun_id) lf_info (length args)) of
 
             -- A value in WHNF, so we can just return it.
@@ -672,15 +659,14 @@ cgTailCall fun_id fun_info args = do
                      then directCall NativeNodeCall   lbl arity (fun_arg:args)
                      else directCall NativeDirectCall lbl arity args }
 
-        JumpToIt {} -> panic "cgTailCall"       -- ???
-
-  where
-    fun_arg     = StgVarArg fun_id
-    fun_name    = idName        fun_id
-    fun         = idInfoToAmode fun_info
-    lf_info     = cg_lf         fun_info
-    node_points dflags = nodeMustPointToIt dflags lf_info
-
+        -- Let-no-escape call
+        JumpToIt -> let (LneLoc blk_id lne_regs) = cg_loc fun_info
+                    in do
+                       { adjustHpBackwards -- always do this before a tail-call
+                       ; cmm_args <- getNonVoidArgAmodes args
+                       ; emitMultiAssign lne_regs cmm_args
+                       ; emit (mkBranch blk_id)
+                       ; return AssignedDirectly }
 
 emitEnter :: CmmExpr -> FCode ReturnKind
 emitEnter fun = do