[project @ 2001-03-01 14:26:00 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / HscMain.lhs

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 141af7a..29de2ac 100644 (file)
--- 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