From 35be701121056b83e9f1ef911156aec829180a6b Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Thu, 8 May 2014 10:38:52 +0100 Subject: 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. --- compiler/coreSyn/CoreTidy.lhs | 115 +++++++++++++++++++++++++----------------- 1 file changed, 70 insertions(+), 45 deletions(-) (limited to 'compiler/coreSyn') diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs index 8c0ae4a65a..cb2af7c77d 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,18 +140,48 @@ tidyBndr env var tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var]) tidyBndrs env vars = mapAccumL tidyBndr env vars +-- Non-top-level variables +tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id) +tidyIdBndr env@(tidy_env, var_env) id + = -- Do this pattern match strictly, otherwise we end up holding on to + -- stuff in the OccName. + case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') -> + let + -- Give the Id a fresh print-name, *and* rename its type + -- The SrcLoc isn't important now, + -- though we could extract it from the Id + -- + 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] + 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 -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. +-- 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. @@ -161,48 +190,27 @@ tidyLetBndr rec_tidy_env env (id,rhs) -- 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 + -- 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 + -- + -- 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 - = -- Do this pattern match strictly, otherwise we end up holding on to - -- stuff in the OccName. - case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') -> - let - -- Give the Id a fresh print-name, *and* rename its type - -- The SrcLoc isn't important now, - -- though we could extract it from the Id - -- - 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] - new_info = vanillaIdInfo `setOccInfo` occInfo old_info 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') - } + ((tidy_env', var_env'), id') } ------------ Unfolding -------------- tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding @@ -234,9 +242,26 @@ two reasons: the benefit of that occurrence analysis when we use the rule or or inline the function. In particular, it's vital not to lose loop-breaker info, else we get an infinite inlining loop - + 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 -- cgit v1.2.1