X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscMain.lhs;h=29de2ac1674cb1d2405c1850e164d636a6072206;hb=18b24e64d6a9e3011a2437cec87ef09ad3e6f900;hp=141af7abd89005eb34a11eae65c2c28bd74b93ea;hpb=252fd0cd54d3ea3f09a78bd4826a639f98d2b452;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 141af7a..29de2ac 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -16,6 +16,9 @@ module HscMain ( HscResult(..), hscMain,
 import RdrHsSyn		( RdrNameStmt )
 import Rename		( renameStmt )
 import ByteCodeGen	( byteCodeGen )
+import Id		( Id, idName, idFlavour, modifyIdInfo )
+import IdInfo		( setFlavourInfo, makeConstantFlavour )
+import HscTypes		( InteractiveContext(..), TyThing(..) )
 #endif
 
 import HsSyn
@@ -28,7 +31,7 @@ import SrcLoc		( mkSrcLoc )
 import Rename		( checkOldIface, renameModule, closeIfaceDecls )
 import Rules		( emptyRuleBase )
 import PrelInfo		( wiredInThingEnv, wiredInThings )
-import PrelNames	( vanillaSyntaxMap, knownKeyNames )
+import PrelNames	( vanillaSyntaxMap, knownKeyNames, iNTERACTIVE )
 import MkIface		( completeIface, mkModDetailsFromIface, mkModDetails,
 			  writeIface, pprIface )
 import TcModule
@@ -38,13 +41,12 @@ import SimplCore
 import CoreUtils	( coreBindsSize )
 import CoreTidy		( tidyCorePgm )
 import CoreSat
+import CoreTidy		( tidyCoreExpr )
 import CoreToStg	( coreToStg )
 import SimplStg		( stg2stg )
 import CodeGen		( codeGen )
 import CodeOutput	( codeOutput )
 
-import Id		( Id, idName, idFlavour, modifyIdInfo )
-import IdInfo		( setFlavourInfo, makeConstantFlavour )
 import Module		( ModuleName, moduleName, mkHomeModule, 
 			  moduleUserString )
 import CmdLineOpts
@@ -59,15 +61,14 @@ import CmStaticInfo	( GhciMode(..) )
 import HscStats		( ppSourceStats )
 import HscTypes		( ModDetails, ModIface(..), PersistentCompilerState(..),
 			  PersistentRenamerState(..), ModuleLocation(..),
-			  HomeSymbolTable, InteractiveContext(..), TyThing(..),
+			  HomeSymbolTable, 
 			  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 )
 
@@ -451,9 +452,9 @@ A naked expression returns a singleton Name [it].
 hscStmt dflags hst hit pcs0 icontext stmt
    = let 
 	InteractiveContext { 
-	     ic_rn_env = rn_env, 
+	     ic_rn_env   = rn_env, 
 	     ic_type_env = type_env,
-	     ic_module   = this_mod } = icontext
+	     ic_module   = scope_mod } = icontext
      in
      do { maybe_stmt <- hscParseStmt dflags stmt
 	; case maybe_stmt of
@@ -462,26 +463,32 @@ hscStmt dflags hst hit pcs0 icontext stmt
 
 		-- Rename it
 	  (pcs1, print_unqual, maybe_renamed_stmt)
-		 <- renameStmt dflags hit hst pcs0 this_mod rn_env parsed_stmt
+		 <- renameStmt dflags hit hst pcs0 scope_mod 
+				iNTERACTIVE rn_env parsed_stmt
+
 	; case maybe_renamed_stmt of
 		Nothing -> return (pcs0, Nothing)
 		Just (bound_names, rn_stmt) -> do {
 
 		-- Typecheck it
-	  maybe_tc_return <- typecheckStmt dflags pcs1 hst type_env
-					   print_unqual this_mod bound_names rn_stmt
+	  maybe_tc_return 
+		<- typecheckStmt dflags pcs1 hst type_env
+				   print_unqual iNTERACTIVE bound_names rn_stmt
 	; case maybe_tc_return of {
 		Nothing -> return (pcs0, Nothing) ;
 		Just (pcs2, tc_expr, bound_ids) -> do {
 
 		-- Desugar it
-	  ds_expr <- deSugarExpr dflags pcs2 hst this_mod print_unqual tc_expr
+	  ds_expr <- deSugarExpr dflags pcs2 hst iNTERACTIVE print_unqual tc_expr
 	
 		-- 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