From: simonpj <unknown>
Date: Fri, 24 Jan 2003 11:26:39 +0000 (+0000)
Subject: [project @ 2003-01-24 11:26:39 by simonpj]
X-Git-Tag: Approx_11550_changesets_converted~1239
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=9ceeb6e503af43894033a15756a064bdcf7cbba1;p=ghc-hetmet.git

[project @ 2003-01-24 11:26:39 by simonpj]
Perform 'tidying' on the implicit bindings before emitting
	External Core.  We were getting silly bindings like
		\ tpl -> case tpl of tpl -> (tpl,tpl) -> tpl

	Maybe we should add these implicit bindings in CoreTidy,
	rather than in both MkExternalCore and CorePrep?
---

diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index 037418f..18ecbab 100644
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -60,9 +60,6 @@ tidyBind env (Rec prs)
 
 
 ------------  Expressions  --------------
-tidyCoreExpr :: CoreExpr -> IO CoreExpr
-tidyCoreExpr expr = return (tidyExpr emptyTidyEnv expr)
-
 tidyExpr env (Var v)   	=  Var (tidyVarOcc env v)
 tidyExpr env (Type ty) 	=  Type (tidyType env ty)
 tidyExpr env (Lit lit) 	=  Lit lit
diff --git a/ghc/compiler/coreSyn/MkExternalCore.lhs b/ghc/compiler/coreSyn/MkExternalCore.lhs
index 20963b0..7af269f 100644
--- a/ghc/compiler/coreSyn/MkExternalCore.lhs
+++ b/ghc/compiler/coreSyn/MkExternalCore.lhs
@@ -23,6 +23,8 @@ import CoreSyn
 import Var
 import IdInfo
 import Id( idUnfolding )
+import CoreTidy( tidyExpr )
+import VarEnv( emptyTidyEnv )
 import Literal
 import Name
 import CostCentre
@@ -68,7 +70,13 @@ implicit_ids (AClass cl) = classSelIds cl
 implicit_ids other       = []
 
 get_defn :: Id -> CoreBind
-get_defn id = NonRec id (unfoldingTemplate (idUnfolding id))
+get_defn id = NonRec id rhs
+	    where
+	      rhs  = tidyExpr emptyTidyEnv body 
+	      body = unfoldingTemplate (idUnfolding id)
+	-- Don't forget to tidy the body !  Otherwise you get silly things like
+	--	\ tpl -> case tpl of tpl -> (tpl,tpl) -> tpl
+	-- Maybe we should inject these bindings during CoreTidy?
 
 collect_tdefs :: TyCon -> [C.Tdef] -> [C.Tdef]
 collect_tdefs tcon tdefs