Commit 098d99aa authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Inline into tail-called constructor args

Consider
	x = case y of { True -> (p,q); ... }

The occurrence analyser was marking p,q as 'Many', because they args
of a constructor in an RhsCtxt.  But actually they aren't in a RhsCtxt,
and in this case it's better to inline.
parent 25ce05f7
......@@ -503,7 +503,7 @@ occAnal env expr@(Lam _ _)
occAnal env (Case scrut bndr ty alts)
= case occ_anal_scrut scrut alts of { (scrut_usage, scrut') ->
case mapAndUnzip (occAnalAlt env bndr) alts of { (alts_usage_s, alts') ->
case mapAndUnzip (occAnalAlt alt_env bndr) alts of { (alts_usage_s, alts') ->
let
alts_usage = foldr1 combineAltsUsageDetails alts_usage_s
alts_usage' = addCaseBndrUsage alts_usage
......@@ -523,6 +523,10 @@ occAnal env (Case scrut bndr ty alts)
Nothing -> usage
Just occ -> extendVarEnv usage bndr (markMany occ)
alt_env = setVanillaCtxt env
-- Consider x = case v of { True -> (p,q); ... }
-- Then it's fine to inline p and q
occ_anal_scrut (Var v) (alt1 : other_alts)
| not (null other_alts) || not (isDefaultAlt alt1)
= (mkOneOcc env v True, Var v)
......@@ -545,7 +549,6 @@ Applications are dealt with specially because we want
the "build hack" to work.
\begin{code}
-- Hack for build, fold, runST
occAnalApp env (Var fun, args) is_rhs
= case args_stuff of { (args_uds, args') ->
let
......@@ -566,6 +569,8 @@ occAnalApp env (Var fun, args) is_rhs
where
fun_uniq = idUnique fun
fun_uds = mkOneOcc env fun (valArgCount args > 0)
-- Hack for build, fold, runST
args_stuff | fun_uniq == buildIdKey = appSpecial env 2 [True,True] args
| fun_uniq == augmentIdKey = appSpecial env 2 [True,True] args
| fun_uniq == foldrIdKey = appSpecial env 3 [False,True] args
......@@ -685,6 +690,10 @@ rhsCtxt = OccEnv OccRhs []
isRhsEnv (OccEnv OccRhs _) = True
isRhsEnv (OccEnv OccVanilla _) = False
setVanillaCtxt :: OccEnv -> OccEnv
setVanillaCtxt (OccEnv OccRhs ctxt_ty) = OccEnv OccVanilla ctxt_ty
setVanillaCtxt other_env = other_env
setCtxt :: OccEnv -> CtxtTy -> OccEnv
setCtxt (OccEnv encl _) ctxt = OccEnv encl ctxt
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment