From 19fcb519897270c9fcd2c0f707636e9682ff1b08 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Mon, 8 Dec 2008 17:35:25 +0000 Subject: [PATCH] Inject implicit bindings after CoreTidy, not before Simplify Originally I inject the "implicit bindings" (record selectors, class method selectors, data con wrappers...) after CoreTidy. However, in a misguided attempt to fix Trac #2070, I moved the injection point to before the Simplifier, so that record selectors would be optimised by the simplifier. This was misguided because record selectors (indeed all implicit bindings) are GlobalIds, whose IdInfo is meant to be frozen. But the Simplifier, and other Core-to-Core optimisations, merrily change the IdInfo. That ultimately made Trac #2844 happen, where a record selector got arity 2, but the GlobalId (which importing scopes re-construct from the class decl rather than reading from the interface file) has arity 1. So this patch moves the injection back to CoreTidy. Happily #2070 should still be OK because we now use CoreSubst.simpleOptExpr on the unfoldings for implict things, which gets rid of the most gratuitous infelicities. Still, there's a strong case for stoppping record selectors from being GlobalIds, and treating them much more like dict-funs. I'm thinking about that. Meanwhile, #2844 is ok now. --- compiler/main/TidyPgm.lhs | 62 ++++++++++++++++++++++++++++++++++++-- compiler/simplCore/SimplCore.lhs | 52 ++------------------------------ 2 files changed, 63 insertions(+), 51 deletions(-) diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index 2f5d31a..24c2464 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -22,6 +22,7 @@ import VarEnv import VarSet import Var import Id +import Class import IdInfo import InstEnv import NewDemand @@ -304,10 +305,14 @@ tidyProgram hsc_env (ModGuts { mg_module = mod, mg_exports = exports, -- and indeed it does, but if omit_prags is on, ext_rules is -- empty + -- See Note [Injecting implicit bindings] + ; implicit_binds = getImplicitBinds type_env + ; all_tidy_binds = implicit_binds ++ tidy_binds + ; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env) } - ; endPass dflags "Tidy Core" Opt_D_dump_simpl tidy_binds + ; endPass dflags "Tidy Core" Opt_D_dump_simpl all_tidy_binds ; dumpIfSet_core dflags Opt_D_dump_simpl "Tidy Core Rules" (pprRules tidy_rules) @@ -316,7 +321,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod, mg_exports = exports, ; return (CgGuts { cg_module = mod, cg_tycons = alg_tycons, - cg_binds = tidy_binds, + cg_binds = all_tidy_binds, cg_dir_imps = dir_imp_mods, cg_foreign = foreign_stubs, cg_dep_pkgs = dep_pkgs deps, @@ -440,6 +445,59 @@ tidyInstances tidy_dfun ispecs %************************************************************************ +%* * + Implicit bindings +%* * +%************************************************************************ + +Note [Injecting implicit bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We inject the implict bindings right at the end, in CoreTidy. +Some of these bindings, notably record selectors, are not +constructed in an optimised form. E.g. record selector for + data T = MkT { x :: {-# UNPACK #-} !Int } +Then the unfolding looks like + x = \t. case t of MkT x1 -> let x = I# x1 in x +This generates bad code unless it's first simplified a bit. That is +why CoreUnfold.mkImplicitUnfolding uses simleExprOpt to do a bit of +optimisation first. (Only matters when the selector is used curried; +eg map x ys.) See Trac #2070. + +At one time I tried injecting the implicit bindings *early*, at the +beginning of SimplCore. But that gave rise to real difficulty, +becuase GlobalIds are supposed to have *fixed* IdInfo, but the +simplifier and other core-to-core passes mess with IdInfo all the +time. The straw that broke the camels back was when a class selector +got the wrong arity -- ie the simplifier gave it arity 2, whereas +importing modules were expecting it to have arity 1 (Trac #2844). +It's much safer just to inject them right at the end, after tidying. + + +\begin{code} +getImplicitBinds :: TypeEnv -> [CoreBind] +getImplicitBinds type_env + = map get_defn (concatMap implicit_con_ids (typeEnvTyCons type_env) + ++ concatMap other_implicit_ids (typeEnvElts type_env)) + -- Put the constructor wrappers first, because + -- other implicit bindings (notably the fromT functions arising + -- from generics) use the constructor wrappers. At least that's + -- what External Core likes + where + implicit_con_ids tc = mapCatMaybes dataConWrapId_maybe (tyConDataCons tc) + + other_implicit_ids (ATyCon tc) = filter (not . isNaughtyRecordSelector) (tyConSelIds tc) + -- The "naughty" ones are not real functions at all + -- They are there just so we can get decent error messages + -- See Note [Naughty record selectors] in MkId.lhs + other_implicit_ids (AClass cl) = classSelIds cl + other_implicit_ids _other = [] + + get_defn :: Id -> CoreBind + get_defn id = NonRec id (unfoldingTemplate (idUnfolding id)) +\end{code} + + +%************************************************************************ %* * \subsection{Step 1: finding externals} %* * diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 27ada80..5636fed 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -100,22 +100,18 @@ core2core hsc_env guts = do -- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which -- would mean our cached value would go out of date. let mod = mg_module guts - (guts, stats) <- runCoreM hsc_env ann_env imp_rule_base cp_us mod $ do + (guts2, stats) <- runCoreM hsc_env ann_env imp_rule_base cp_us mod $ do -- FIND BUILT-IN PASSES let builtin_core_todos = getCoreToDo dflags - -- Note [Injecting implicit bindings] - let implicit_binds = getImplicitBinds (mg_types guts1) - guts2 = guts1 { mg_binds = implicit_binds ++ mg_binds guts1 } - -- DO THE BUSINESS - doCorePasses builtin_core_todos guts2 + doCorePasses builtin_core_todos guts1 Err.dumpIfSet_dyn dflags Opt_D_dump_simpl_stats "Grand total simplifier statistics" (pprSimplCount stats) - return guts + return guts2 type CorePass = CoreToDo @@ -307,48 +303,6 @@ observe do_pass = doPassM $ \binds -> do %************************************************************************ %* * - Implicit bindings -%* * -%************************************************************************ - -Note [Injecting implicit bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We used to inject the implict bindings right at the end, in CoreTidy. -But some of these bindings, notably record selectors, are not -constructed in an optimised form. E.g. record selector for - data T = MkT { x :: {-# UNPACK #-} !Int } -Then the unfolding looks like - x = \t. case t of MkT x1 -> let x = I# x1 in x -This generates bad code unless it's first simplified a bit. -(Only matters when the selector is used curried; eg map x ys.) -See Trac #2070. - -\begin{code} -getImplicitBinds :: TypeEnv -> [CoreBind] -getImplicitBinds type_env - = map get_defn (concatMap implicit_con_ids (typeEnvTyCons type_env) - ++ concatMap other_implicit_ids (typeEnvElts type_env)) - -- Put the constructor wrappers first, because - -- other implicit bindings (notably the fromT functions arising - -- from generics) use the constructor wrappers. At least that's - -- what External Core likes - where - implicit_con_ids tc = mapCatMaybes dataConWrapId_maybe (tyConDataCons tc) - - other_implicit_ids (ATyCon tc) = filter (not . isNaughtyRecordSelector) (tyConSelIds tc) - -- The "naughty" ones are not real functions at all - -- They are there just so we can get decent error messages - -- See Note [Naughty record selectors] in MkId.lhs - other_implicit_ids (AClass cl) = classSelIds cl - other_implicit_ids _other = [] - - get_defn :: Id -> CoreBind - get_defn id = NonRec id (unfoldingTemplate (idUnfolding id)) -\end{code} - - -%************************************************************************ -%* * Dealing with rules %* * %************************************************************************ -- 1.7.10.4