[project @ 2002-07-16 15:07:15 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / HscMain.lhs
index fd99a5e..3ae4866 100644 (file)
@@ -46,7 +46,6 @@ import StringBuffer   ( hGetStringBuffer, freeStringBuffer )
 import Parser
 import Lex             ( ParseResult(..), ExtFlags(..), mkPState )
 import SrcLoc          ( mkSrcLoc )
-import Finder          ( findModule )
 import Rename          ( checkOldIface, renameModule, renameExtCore, 
                          closeIfaceDecls, RnResult(..) )
 import Rules           ( emptyRuleBase )
@@ -73,7 +72,6 @@ import CmdLineOpts
 import DriverState     ( v_HCHeader )
 import DriverPhases     ( isExtCore_file )
 import ErrUtils                ( dumpIfSet_dyn, showPass, printError )
-import Util            ( unJust )
 import UniqSupply      ( mkSplitUniqSupply )
 
 import Bag             ( consBag, emptyBag )
@@ -85,7 +83,10 @@ import OccName               ( OccName )
 import Name            ( Name, nameModule, nameOccName, getName )
 import NameEnv         ( emptyNameEnv, mkNameEnv )
 import Module          ( Module )
+import BasicTypes      ( Version )
 import FastString
+import Maybes          ( expectJust )
+import Util            ( seqList )
 
 import IOExts          ( newIORef, readIORef, writeIORef, 
                          unsafePerformIO )
@@ -97,7 +98,6 @@ import IO
 import MkExternalCore  ( emitExternalCore )
 import ParserCore
 import ParserCoreUtils
-
 \end{code}
 
 
@@ -224,6 +224,22 @@ hscRecomp ghci_mode dflags have_object
            Right (this_mod, rdr_module, 
                   dont_discard, new_iface, 
                   pcs_tc, ds_details, foreign_stuff) -> do {
+
+         let {
+           imported_module_names :: [ModuleName];
+           imported_module_names = 
+               filter (/= gHC_PRIM_Name) $
+               map ideclName (hsModuleImports rdr_module);
+
+           imported_modules :: [(Module,Version)];
+            imported_modules =
+               map (getModuleAndVersion hit (pcs_PIT pcs_tc))
+                       imported_module_names;
+         }
+
+       -- force this out now, so we don't keep a hold of rdr_module or pcs_tc
+       ; seqList imported_modules (return ())
+
            -------------------
            -- FLATTENING
            -------------------
@@ -246,11 +262,20 @@ hscRecomp ghci_mode dflags have_object
                                             pcs_rules = rules }
                  else return pcs_tc
 
+-- Should we remove bits of flat_details at this point?
+--        ; flat_details <- case flat_details of
+--                            ModDetails { md_binds = binds } ->
+--                                return ModDetails { md_binds = binds,
+--                                                    md_rules = [],
+--                                                    md_types = emptyTypeEnv,
+--                                                    md_insts = [] }
+
        -- alive at this point:  
        --      pcs_middle
        --      foreign_stuff
-       --      ds_details
-       --      new_iface               
+       --      flat_details
+       --      imported_modules (seq'd)
+       --      new_iface
 
            -------------------
            -- SIMPLIFY
@@ -305,15 +330,6 @@ hscRecomp ghci_mode dflags have_object
            local_tycons     = typeEnvTyCons  env_tc
            local_classes    = typeEnvClasses env_tc
 
-           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))
-
            (h_code, c_code, headers, fe_binders) = foreign_stuff
 
            -- turn the list of headers requested in foreign import
@@ -332,8 +348,6 @@ hscRecomp ghci_mode dflags have_object
         ; fhdrs <- readIORef v_HCHeader
         ; writeIORef v_HCHeader (fhdrs ++ foreign_headers)
 
-        ; imported_modules <- mapM mod_name_to_Module imported_module_names
-
        ; (stub_h_exists, stub_c_exists, maybe_bcos, final_iface )
           <- if toInterp
 #ifdef GHCI
@@ -373,13 +387,18 @@ hscRecomp ghci_mode dflags have_object
                    final_iface <- _scc_ "MkFinalIface" 
                          mkFinalIface ghci_mode dflags location 
                                    maybe_checked_iface new_iface tidy_details
+
+                   -- get this module's version
+                   version <- return $! vers_module (mi_version final_iface)
+
                    if toNothing 
                       then do
                          return (False, False, Nothing, final_iface)
                      else do
                          ------------------  Code generation ------------------
                          abstractC <- _scc_ "CodeGen"
-                                      codeGen dflags this_mod imported_modules
+                                      codeGen dflags this_mod version
+                                              imported_modules
                                               cost_centre_info fe_binders
                                               local_tycons stg_binds
                          
@@ -403,7 +422,7 @@ hscCoreFrontEnd ghci_mode dflags location hst hit pcs_ch = do {
            -------------------
            -- PARSE
            -------------------
-       ; inp <- readFile (unJust "hscCoreFrontEnd:hspp" (ml_hspp_file location))
+       ; inp <- readFile (expectJust "hscCoreFrontEnd:hspp" (ml_hspp_file location))
        ; case parseCore inp 1 of
            FailP s        -> hPutStrLn stderr s >> return (Left (HscFail pcs_ch));
            OkP rdr_module -> do {
@@ -442,7 +461,7 @@ hscFrontEnd ghci_mode dflags location hst hit pcs_ch = do {
            -- PARSE
            -------------------
        ; maybe_parsed <- myParseModule dflags 
-                             (unJust "hscRecomp:hspp" (ml_hspp_file location))
+                             (expectJust "hscRecomp:hspp" (ml_hspp_file location))
        ; case maybe_parsed of {
             Nothing -> return (Left (HscFail pcs_ch));
             Just rdr_module -> do {
@@ -486,6 +505,8 @@ myParseModule dflags src_filename
       buf <- hGetStringBuffer src_filename
 
       let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
+                          ffiEF         = dopt Opt_FFI         dflags,
+                          withEF        = dopt Opt_With        dflags,
                           parrEF        = dopt Opt_PArr        dflags}
          loc  = mkSrcLoc (mkFastString src_filename) 1
 
@@ -659,8 +680,10 @@ hscParseStmt dflags str
       buf <- stringToStringBuffer str
 
       let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
+                          ffiEF         = dopt Opt_FFI         dflags,
+                          withEF        = dopt Opt_With        dflags,
                           parrEF        = dopt Opt_PArr        dflags}
-         loc  = mkSrcLoc SLIT("<interactive>") 1
+         loc  = mkSrcLoc FSLIT("<interactive>") 1
 
       case parseStmt buf (mkPState loc exts) of {
 
@@ -743,8 +766,10 @@ myParseIdentifier dflags str
   = do buf <- stringToStringBuffer str
  
        let exts = ExtFlags {glasgowExtsEF = dopt Opt_GlasgowExts dflags,
+                           ffiEF         = dopt Opt_FFI         dflags,
+                           withEF        = dopt Opt_With        dflags,
                            parrEF        = dopt Opt_PArr        dflags}
-          loc  = mkSrcLoc SLIT("<interactive>") 1
+          loc  = mkSrcLoc FSLIT("<interactive>") 1
 
        case parseIdentifier buf (mkPState loc exts) of
 
@@ -776,7 +801,8 @@ hscModuleContents
 
 hscModuleContents dflags hst hit pcs0 mod exports_only = do {
 
-  -- slurp the interface if necessary
+  -- Slurp the interface if necessary (a home module will certainly
+  -- alraedy be loaded, but a package module might not be)
   (pcs1, print_unqual, maybe_rn_stuff) 
        <- slurpIface dflags hit hst pcs0 mod;
 
@@ -794,7 +820,8 @@ hscModuleContents dflags hst hit pcs0 mod exports_only = do {
 
   let { all_names 
           | exports_only = names
-          | otherwise =
+          | otherwise =        -- Invariant; we only have (not exports_only) 
+                               -- for a home module so it must already be in the HIT
             let { iface = fromJust (lookupModuleEnv hit mod);
                   env   = fromJust (mi_globals iface);
                   range = rdrEnvElts env;