summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJan Stolarek <jan.stolarek@p.lodz.pl>2013-08-20 15:03:26 +0100
committerJan Stolarek <jan.stolarek@p.lodz.pl>2013-08-20 17:19:30 +0100
commit388e14e28c2ab70419dc3be610da9806a8e38325 (patch)
tree7b898734277f7419d71b81cd704d1fe92d3f4eae
parent6b032db4e750c80371d028a9fe384177d6cdf36a (diff)
downloadhaskell-388e14e28c2ab70419dc3be610da9806a8e38325.tar.gz
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 -> ... _ -> ...
-rw-r--r--compiler/codeGen/StgCmmBind.hs2
-rw-r--r--compiler/codeGen/StgCmmExpr.hs46
2 files changed, 17 insertions, 31 deletions
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 516b519e0b..ce5491dc10 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 b19341bc8c..24b12f7237 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