X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplCore.lhs;h=98ef348be7adfbb67481cf6a0ceca198a796c0a7;hp=5c3c789c79b04d7f4ac6664019312a0ab931656d;hb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569;hpb=9bcd95bad83ee937c178970e8b729732e680fe1e

diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index 5c3c789..98ef348 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
 %*									*
 %************************************************************************