Commit 66413c79 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Add notSCCNote, and use it

The point here is that SCCs get in the way of eta
expansion and we must treat them uniformly.
parent 76349636
......@@ -95,11 +95,11 @@ in exprArity. That is a less local change, so I'm going to leave it for today!
\begin{code}
manifestArity :: CoreExpr -> Arity
-- ^ manifestArity sees how many leading value lambdas there are
manifestArity (Lam v e) | isId v = 1 + manifestArity e
| otherwise = manifestArity e
manifestArity (Note _ e) = manifestArity e
manifestArity (Cast e _) = manifestArity e
manifestArity _ = 0
manifestArity (Lam v e) | isId v = 1 + manifestArity e
| otherwise = manifestArity e
manifestArity (Note n e) | notSccNote n = manifestArity e
manifestArity (Cast e _) = manifestArity e
manifestArity _ = 0
exprArity :: CoreExpr -> Arity
-- ^ An approximate, fast, version of 'exprEtaExpandArity'
......@@ -108,7 +108,7 @@ exprArity e = go e
go (Var v) = idArity v
go (Lam x e) | isId x = go e + 1
| otherwise = go e
go (Note _ e) = go e
go (Note n e) | notSccNote n = go e
go (Cast e co) = go e `min` length (typeArity (snd (coercionKind co)))
-- Note [exprArity invariant]
go (App e (Type _)) = go e
......@@ -554,7 +554,8 @@ arityType dicts_cheap (Let b e)
-- See Note [Dictionary-like types] in TcType.lhs for why we use
-- isDictLikeTy here rather than isDictTy
arityType dicts_cheap (Note _ e) = arityType dicts_cheap e
arityType dicts_cheap (Note n e)
| notSccNote n = arityType dicts_cheap e
arityType dicts_cheap (Cast e _) = arityType dicts_cheap e
arityType _ _ = vanillaArityType
\end{code}
......
......@@ -688,8 +688,7 @@ cpe_ExprIsTrivial (Var _) = True
cpe_ExprIsTrivial (Type _) = True
cpe_ExprIsTrivial (Lit _) = True
cpe_ExprIsTrivial (App e arg) = isTypeArg arg && cpe_ExprIsTrivial e
cpe_ExprIsTrivial (Note (SCC _) _) = False
cpe_ExprIsTrivial (Note _ e) = cpe_ExprIsTrivial e
cpe_ExprIsTrivial (Note n e) = notSccNote n && cpe_ExprIsTrivial e
cpe_ExprIsTrivial (Cast e _) = cpe_ExprIsTrivial e
cpe_ExprIsTrivial (Lam b body) | isTyCoVar b = cpe_ExprIsTrivial body
cpe_ExprIsTrivial _ = False
......
......@@ -34,6 +34,7 @@ module CoreSyn (
collectArgs, coreExprCc, flattenBinds,
isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
notSccNote,
-- * Unfolding data types
Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
......@@ -1046,6 +1047,10 @@ valBndrCount = count isId
-- | The number of argument expressions that are values rather than types at their top level
valArgCount :: [Arg b] -> Int
valArgCount = count isValArg
notSccNote :: Note -> Bool
notSccNote (SCC {}) = False
notSccNote _ = True
\end{code}
......
......@@ -1396,11 +1396,9 @@ rhsIsStatic _is_dynamic_name rhs = is_static False rhs
is_static :: Bool -- True <=> in a constructor argument; must be atomic
-> CoreExpr -> Bool
is_static False (Lam b e) = isRuntimeVar b || is_static False e
is_static _ (Note (SCC _) _) = False
is_static in_arg (Note _ e) = is_static in_arg e
is_static in_arg (Cast e _) = is_static in_arg e
is_static False (Lam b e) = isRuntimeVar b || is_static False e
is_static in_arg (Note n e) = notSccNote n && is_static in_arg e
is_static in_arg (Cast e _) = is_static in_arg e
is_static _ (Lit lit)
= case lit of
......@@ -1441,11 +1439,9 @@ rhsIsStatic _is_dynamic_name rhs = is_static False rhs
-- x = D# (1.0## /## 2.0##)
-- can't float because /## can fail.
go (Note (SCC _) _) _ = False
go (Note _ f) n_val_args = go f n_val_args
go (Cast e _) n_val_args = go e n_val_args
go _ _ = False
go (Note n f) n_val_args = notSccNote n && go f n_val_args
go (Cast e _) n_val_args = go e n_val_args
go _ _ = False
saturated_data_con f n_val_args
= case isDataConWorkId_maybe f of
......
Supports Markdown
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