[commit: ghc] master: Preserve evaluated-ness in CoreTidy (35be701)
git at git.haskell.org
git at git.haskell.org
Thu May 8 12:06:38 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/35be701121056b83e9f1ef911156aec829180a6b/ghc
>---------------------------------------------------------------
commit 35be701121056b83e9f1ef911156aec829180a6b
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Thu May 8 10:38:52 2014 +0100
Preserve evaluated-ness in CoreTidy
The main effect of this patch is to preserve the evaluated-ness of
case binders and suchlike, to avoid spurious Lint complaints after
tidying. See Note [Preserve evaluatedness] in CoreTidy.
Plus a bit of associated refactoring of tidyIdBndr, tidyLetBndr.
>---------------------------------------------------------------
35be701121056b83e9f1ef911156aec829180a6b
compiler/coreSyn/CoreTidy.lhs | 107 ++++++++++++++++++++++++++----------------
1 file changed, 66 insertions(+), 41 deletions(-)
diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs
index 8c0ae4a..cb2af7c 100644
--- a/compiler/coreSyn/CoreTidy.lhs
+++ b/compiler/coreSyn/CoreTidy.lhs
@@ -33,7 +33,6 @@ import Name hiding (tidyNameOcc)
import SrcLoc
import Maybes
import Data.List
-import Outputable
\end{code}
@@ -141,46 +140,6 @@ tidyBndr env var
tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
tidyBndrs env vars = mapAccumL tidyBndr env vars
-tidyLetBndr :: TidyEnv -- Knot-tied version for unfoldings
- -> TidyEnv -- The one to extend
- -> (Id, CoreExpr) -> (TidyEnv, Var)
--- Used for local (non-top-level) let(rec)s
-tidyLetBndr rec_tidy_env env (id,rhs)
- = ((tidy_occ_env,new_var_env), final_id)
- where
- ((tidy_occ_env,var_env), new_id) = tidyIdBndr env id
- new_var_env = extendVarEnv var_env id final_id
- -- Override the env we get back from tidyId with the
- -- new IdInfo so it gets propagated to the usage sites.
-
- -- We need to keep around any interesting strictness and
- -- demand info because later on we may need to use it when
- -- converting to A-normal form.
- -- eg.
- -- f (g x), where f is strict in its argument, will be converted
- -- into case (g x) of z -> f z by CorePrep, but only if f still
- -- has its strictness info.
- --
- -- Similarly for the demand info - on a let binder, this tells
- -- CorePrep to turn the let into a case.
- --
- -- Similarly arity info for eta expansion in CorePrep
- --
- -- Set inline-prag info so that we preseve it across
- -- separate compilation boundaries
- final_id = new_id `setIdInfo` new_info
- idinfo = idInfo id
- new_info = idInfo new_id
- `setArityInfo` exprArity rhs
- `setStrictnessInfo` strictnessInfo idinfo
- `setDemandInfo` demandInfo idinfo
- `setInlinePragInfo` inlinePragInfo idinfo
- `setUnfoldingInfo` new_unf
-
- new_unf | isStableUnfolding unf = tidyUnfolding rec_tidy_env unf (panic "tidy_unf")
- | otherwise = noUnfolding
- unf = unfoldingInfo idinfo
-
-- Non-top-level variables
tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
tidyIdBndr env@(tidy_env, var_env) id
@@ -199,11 +158,60 @@ tidyIdBndr env@(tidy_env, var_env) id
-- Note [Tidy IdInfo]
new_info = vanillaIdInfo `setOccInfo` occInfo old_info
+ `setUnfoldingInfo` new_unf
old_info = idInfo id
+ old_unf = unfoldingInfo old_info
+ new_unf | isEvaldUnfolding old_unf = evaldUnfolding
+ | otherwise = noUnfolding
+ -- See Note [Preserve evaluatedness]
in
((tidy_env', var_env'), id')
}
+tidyLetBndr :: TidyEnv -- Knot-tied version for unfoldings
+ -> TidyEnv -- The one to extend
+ -> (Id, CoreExpr) -> (TidyEnv, Var)
+-- Used for local (non-top-level) let(rec)s
+-- Just like tidyIdBndr above, but with more IdInfo
+tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs)
+ = case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
+ let
+ ty' = tidyType env (idType id)
+ name' = mkInternalName (idUnique id) occ' noSrcSpan
+ id' = mkLocalIdWithInfo name' ty' new_info
+ var_env' = extendVarEnv var_env id id'
+
+ -- Note [Tidy IdInfo]
+ -- We need to keep around any interesting strictness and
+ -- demand info because later on we may need to use it when
+ -- converting to A-normal form.
+ -- eg.
+ -- f (g x), where f is strict in its argument, will be converted
+ -- into case (g x) of z -> f z by CorePrep, but only if f still
+ -- has its strictness info.
+ --
+ -- Similarly for the demand info - on a let binder, this tells
+ -- CorePrep to turn the let into a case.
+ --
+ -- Similarly arity info for eta expansion in CorePrep
+ --
+ -- Set inline-prag info so that we preseve it across
+ -- separate compilation boundaries
+ old_info = idInfo id
+ new_info = vanillaIdInfo
+ `setOccInfo` occInfo old_info
+ `setArityInfo` exprArity rhs
+ `setStrictnessInfo` strictnessInfo old_info
+ `setDemandInfo` demandInfo old_info
+ `setInlinePragInfo` inlinePragInfo old_info
+ `setUnfoldingInfo` new_unf
+
+ new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf
+ | otherwise = noUnfolding
+ old_unf = unfoldingInfo old_info
+ in
+ ((tidy_env', var_env'), id') }
+
------------ Unfolding --------------
tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
tidyUnfolding tidy_env df@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) _
@@ -237,6 +245,23 @@ two reasons:
Note that tidyLetBndr puts more IdInfo back.
+Note [Preserve evaluatedness]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ data T = MkT !Bool
+ ....(case v of MkT y ->
+ let z# = case y of
+ True -> 1#
+ False -> 2#
+ in ...)
+
+The z# binding is ok becuase the RHS is ok-for-speculation,
+but Lint will complain unless it can *see* that. So we
+preserve the evaluated-ness on 'y' in tidyBndr.
+
+(Another alterantive would be to tidy unboxed lets into cases,
+but that seems more indirect and surprising.)
+
\begin{code}
(=:) :: a -> (a -> b) -> b
More information about the ghc-commits
mailing list