From: simonmar <unknown>
Date: Tue, 27 Feb 2001 17:14:44 +0000 (+0000)
Subject: [project @ 2001-02-27 17:14:44 by simonmar]
X-Git-Tag: Approximately_9120_patches~2527
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=1aa6eb7895af9f432eb8599854d25e58e3f9f814;p=ghc-hetmet.git

[project @ 2001-02-27 17:14:44 by simonmar]
Need to tidy the expression before compiling it, purely in order to
clone the ids in case of clashes.
---

diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index 2eb70e1..cf7c2d5 100644
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -5,7 +5,7 @@
 
 \begin{code}
 module CoreTidy (
-	tidyCorePgm, tidyExpr, 
+	tidyCorePgm, tidyExpr, tidyCoreExpr,
 	tidyBndr, tidyBndrs
     ) where
 
@@ -157,6 +157,14 @@ tidyCorePgm dflags mod pcs binds_in orphans_in
     init_tidy_env us = (us, orig_env, initTidyOccEnv avoids, emptyVarEnv)
     avoids	     = [getOccName bndr | bndr <- bindersOfBinds binds_in,
 				       isGlobalName (idName bndr)]
+
+
+tidyCoreExpr :: CoreExpr -> IO CoreExpr
+tidyCoreExpr expr
+  = do { us <- mkSplitUniqSupply 't' -- for "tidy"
+       ; let (expr',_) = initUs us (tidyExpr emptyTidyEnv expr) 
+       ; return expr'
+       }
 \end{code}
 
 
diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 141af7a..b029b41 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -38,6 +38,7 @@ import SimplCore
 import CoreUtils	( coreBindsSize )
 import CoreTidy		( tidyCorePgm )
 import CoreSat
+import CoreTidy		( tidyCoreExpr )
 import CoreToStg	( coreToStg )
 import SimplStg		( stg2stg )
 import CodeGen		( codeGen )
@@ -59,15 +60,14 @@ import CmStaticInfo	( GhciMode(..) )
 import HscStats		( ppSourceStats )
 import HscTypes		( ModDetails, ModIface(..), PersistentCompilerState(..),
 			  PersistentRenamerState(..), ModuleLocation(..),
-			  HomeSymbolTable, InteractiveContext(..), TyThing(..),
+			  HomeSymbolTable, InteractiveContext(..),
 			  NameSupply(..), PackageRuleBase, HomeIfaceTable, 
-			  typeEnvClasses, typeEnvTyCons, emptyIfaceTable,
-			  extendLocalRdrEnv
+			  typeEnvClasses, typeEnvTyCons, emptyIfaceTable
 			)
 import FiniteMap	( FiniteMap, plusFM, emptyFM, addToFM )
 import OccName		( OccName )
 import Name		( Name, nameModule, nameOccName, getName, isGlobalName,
-			  emptyNameEnv, extendNameEnvList
+			  emptyNameEnv
 			)
 import Module		( Module, lookupModuleEnvByName )
 
@@ -480,8 +480,11 @@ hscStmt dflags hst hit pcs0 icontext stmt
 		-- Simplify it
 	; simpl_expr <- simplifyExpr dflags pcs2 hst ds_expr
 
+		-- Tidy it (temporary, until coreSat does cloning)
+	; tidy_expr <- tidyCoreExpr simpl_expr
+
 		-- Saturate it
-	; sat_expr <- coreSatExpr dflags simpl_expr
+	; sat_expr <- coreSatExpr dflags tidy_expr
 
 		-- Convert to BCOs
 	; bcos <- coreExprToBCOs dflags sat_expr