[commit: ghc] wip/T7994-calledArity: Do not say âTailCallâ in function names (49d28cc)
git at git.haskell.org
git at git.haskell.org
Wed Jan 29 15:18:00 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T7994-calledArity
Link : http://ghc.haskell.org/trac/ghc/changeset/49d28cc85698dff03bb964a59f52052c5e99a0f1/ghc
>---------------------------------------------------------------
commit 49d28cc85698dff03bb964a59f52052c5e99a0f1
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Wed Jan 29 15:10:35 2014 +0000
Do not say “TailCall” in function names
>---------------------------------------------------------------
49d28cc85698dff03bb964a59f52052c5e99a0f1
compiler/simplCore/CallArity.hs | 24 +++++++++++-------------
1 file changed, 11 insertions(+), 13 deletions(-)
diff --git a/compiler/simplCore/CallArity.hs b/compiler/simplCore/CallArity.hs
index afd630b..42969a4 100644
--- a/compiler/simplCore/CallArity.hs
+++ b/compiler/simplCore/CallArity.hs
@@ -127,7 +127,7 @@ callArityAnal arity int (Let (NonRec v rhs) e)
where
(ae_rhs, rhs') = callArityAnal 0 int rhs
(ae_body, e') = callArityAnal arity int e
- ae_final = forgetTailCalls ae_rhs `lubEnv` ae_body
+ ae_final = forgetGoodCalls ae_rhs `lubEnv` ae_body
-- Non-recursive let. Find out how the body calls the rhs, analise that,
-- and combine the results, convervatively using both
@@ -147,7 +147,7 @@ callArityAnal arity int (Let (NonRec v rhs) e)
-- tail-call information from there
| otherwise
= let (ae_rhs, rhs') = callArityAnal 0 int rhs
- final_ae = forgetTailCalls ae_rhs `lubEnv` ae_body'
+ final_ae = forgetGoodCalls ae_rhs `lubEnv` ae_body'
v' = v `setIdCallArity` 0
in -- pprTrace "callArityAnal:LetNonRecNonTailCall"
-- (vcat [ppr v, ppr arity, ppr final_ae ])
@@ -165,7 +165,7 @@ callArityAnal arity int (Let (Rec [(v,rhs)]) e)
where
(ae_rhs, rhs') = callArityAnal 0 int rhs
(ae_body, e') = callArityAnal arity int e
- ae_final = forgetTailCalls ae_rhs `lubEnv` ae_body
+ ae_final = forgetGoodCalls ae_rhs `lubEnv` ae_body
-- Recursive let. Again, find out how the body calls the rhs, analise that,
-- but then check if it is compatible with how rhs calls itself. If not,
@@ -184,7 +184,7 @@ callArityAnal arity int (Let (Rec [(v,rhs)]) e)
-- tail-call information from there. No need to iterate there.
| otherwise
= let (ae_rhs, rhs') = callArityAnal 0 int_body rhs
- final_ae = forgetTailCalls ae_rhs `lubEnv` ae_body'
+ final_ae = forgetGoodCalls ae_rhs `lubEnv` ae_body'
v' = v `setIdCallArity` 0
in -- pprTrace "callArityAnal:LetRecNonTailCall"
-- (vcat [ppr v, ppr arity, ppr final_ae ])
@@ -201,7 +201,7 @@ callArityAnal arity int (Let (Rec binds) e)
where
(aes, binds') = unzip $ map go binds
go (i,e) = let (ae,e') = callArityAnal 0 int e
- in (forgetTailCalls ae, (i,e'))
+ in (forgetGoodCalls ae, (i,e'))
(ae, e') = callArityAnal arity int e
final_ae = foldl lubEnv ae aes
@@ -249,19 +249,17 @@ callArityFix arity int v e
new_arity = lookupWithDefaultVarEnv ae Nothing v
-anyTailCalls :: VarEnv (Maybe Arity) -> Bool
-anyTailCalls = foldVarEnv ((||) . isJust) False
+anyGoodCalls :: VarEnv (Maybe Arity) -> Bool
+anyGoodCalls = foldVarEnv ((||) . isJust) False
-forgetTailCalls :: VarEnv (Maybe Arity) -> VarEnv (Maybe Arity)
-forgetTailCalls = mapVarEnv (const Nothing)
+forgetGoodCalls :: VarEnv (Maybe Arity) -> VarEnv (Maybe Arity)
+forgetGoodCalls = mapVarEnv (const Nothing)
useBetterOf :: CallArityEnv -> CallArityEnv -> CallArityEnv
-useBetterOf ae1 ae2 | anyTailCalls ae1 = ae1 `lubEnv` forgetTailCalls ae2
-useBetterOf ae1 ae2 | otherwise = forgetTailCalls ae1 `lubEnv` ae2
+useBetterOf ae1 ae2 | anyGoodCalls ae1 = ae1 `lubEnv` forgetGoodCalls ae2
+useBetterOf ae1 ae2 | otherwise = forgetGoodCalls ae1 `lubEnv` ae2
-- Used when combining results from alternative cases; take the minimum
lubEnv :: CallArityEnv -> CallArityEnv -> CallArityEnv
lubEnv = plusVarEnv_C min
-
-
More information about the ghc-commits
mailing list