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.

1 files changed, 3 insertions, 49 deletions

diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index 27ada8033e..5636fedbb4 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
 %*									*
 %************************************************************************