Merge cgTailCall and cgLneJump into one function
authorJan Stolarek <jan.stolarek@p.lodz.pl>
Tue, 20 Aug 2013 14:03:26 +0000 (15:03 +0100)
committerJan Stolarek <jan.stolarek@p.lodz.pl>
Tue, 20 Aug 2013 16:19:30 +0000 (17:19 +0100)
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 -> ...
                _ -> ...

compiler/codeGen/StgCmmBind.hs
compiler/codeGen/StgCmmExpr.hs

index 516b519..ce5491d 100644 (file)
@@ -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
index b19341b..24b12f7 100644 (file)
@@ -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