[project @ 2002-03-20 11:24:42 by simonpj]

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

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 5f82eaf..243844a 100644 (file)
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -5,7 +5,7 @@
 \section[GHC_Main]{Main driver for Glasgow Haskell compiler}
 
 \begin{code}
-module HscMain ( HscResult(..), hscMain, 
+module HscMain ( HscResult(..), hscMain,
 #ifdef GHCI
                 hscStmt, hscThing, hscModuleContents,
 #endif
@@ -16,7 +16,7 @@ module HscMain ( HscResult(..), hscMain,
 #ifdef GHCI
 import Interpreter
 import ByteCodeGen     ( byteCodeGen )
-import CoreTidy                ( tidyCoreExpr )
+import TidyPgm         ( tidyCoreExpr )
 import CorePrep                ( corePrepExpr )
 import Rename          ( renameStmt, renameRdrName, slurpIface )
 import RdrName          ( rdrNameOcc, setRdrNameOcc )
@@ -26,13 +26,12 @@ import OccName          ( dataName, tcClsName,
 import Type            ( Type )
 import Id              ( Id, idName, setGlobalIdDetails )
 import IdInfo          ( GlobalIdDetails(VanillaGlobal) )
-import Name            ( isLocalName )
+import Name            ( isInternalName )
 import NameEnv         ( lookupNameEnv )
 import Module          ( lookupModuleEnv )
 import RdrName         ( rdrEnvElts )
 import PrelNames       ( iNTERACTIVE )
 import StringBuffer    ( stringToStringBuffer )
-import FastString       ( mkFastString )
 import Maybes          ( catMaybes )
 
 import List            ( nub )
@@ -52,7 +51,7 @@ import Rename         ( checkOldIface, renameModule, closeIfaceDecls )
 import Rules           ( emptyRuleBase )
 import PrelInfo                ( wiredInThingEnv, wiredInThings )
 import PrelRules       ( builtinRules )
-import PrelNames       ( knownKeyNames )
+import PrelNames       ( knownKeyNames, gHC_PRIM_Name )
 import MkIface         ( mkFinalIface )
 import TcModule
 import InstEnv         ( emptyInstEnv )
@@ -60,13 +59,13 @@ import Desugar
 import Flattening       ( flatten, flattenExpr )
 import SimplCore
 import CoreUtils       ( coreBindsSize )
-import CoreTidy                ( tidyCorePgm )
+import TidyPgm         ( tidyCorePgm )
 import CorePrep                ( corePrepPgm )
 import StgSyn
 import CoreToStg       ( coreToStg )
 import SimplStg                ( stg2stg )
 import CodeGen         ( codeGen )
-import CodeOutput      ( codeOutput )
+import CodeOutput      ( codeOutput, outputForeignStubs )
 
 import Module          ( ModuleName, moduleName, mkHomeModule )
 import CmdLineOpts
@@ -327,7 +326,11 @@ hscRecomp ghci_mode dflags have_object
            local_tycons     = typeEnvTyCons  env_tc
            local_classes    = typeEnvClasses env_tc
 
-           imported_module_names = map ideclName (hsModuleImports rdr_module)
+           imported_module_names = 
+               filter (/= gHC_PRIM_Name) $
+               map ideclName (hsModuleImports rdr_module)
+               -- eek! doesn't this keep rdr_module live until code generation?
+               -- SDM 3/2002
 
            mod_name_to_Module nm
                 = do m <- findModule nm ; return (fst (fromJust m))
@@ -368,7 +371,12 @@ hscRecomp ghci_mode dflags have_object
                          mkFinalIface ghci_mode dflags location 
                                    maybe_checked_iface new_iface tidy_details
 
-                   return ( False, False, Just (bcos,itbl_env), final_iface )
+                   ------------------ Create f-x-dynamic C-side stuff ---
+                    (istub_h_exists, istub_c_exists) 
+                       <- outputForeignStubs dflags c_code h_code
+
+                   return ( istub_h_exists, istub_c_exists, 
+                             Just (bcos,itbl_env), final_iface )
 #else
                then error "GHC not compiled with interpreter"
 #endif
@@ -417,7 +425,7 @@ myParseModule dflags src_filename
       showPass dflags "Parser"
       _scc_  "Parser" do
 
-      buf <- hGetStringBuffer True{-expand tabs-} src_filename
+      buf <- hGetStringBuffer src_filename
 
       let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
                           parrEF        = dopt Opt_PArr        dflags}
@@ -665,7 +673,7 @@ hscThing dflags hst hit pcs0 ic str
             Nothing -> return (pcs, []);
             Just pcs ->
                let do_lookup n
-                       | isLocalName n = lookupNameEnv (ic_type_env ic) n
+                       | isInternalName n = lookupNameEnv (ic_type_env ic) n
                        | otherwise     = lookupType hst (pcs_PTE pcs) n
                
                    maybe_ty_things = map do_lookup names