X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcompMan%2FCompManager.lhs;h=c4c1913a6af5b1bc9d95c44c06f8530674867b7d;hb=c0c05bb3fbfdd1a82bccdcbc34c77a4927c99316;hp=149e225efb8fb1e2c3818b08968ae38344352945;hpb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;p=ghc-hetmet.git

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 149e225..c4c1913 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -44,13 +44,10 @@ module CompManager (
 		   --	-> IO (CmState, Maybe HValue)
 
     cmGetModInfo,		-- :: CmState -> (ModuleGraph, HomePackageTable)
-    findModuleLinkable_maybe,	-- Exported to InteractiveUI
 
     cmSetDFlags,
     cmGetBindings, 	-- :: CmState -> [TyThing]
     cmGetPrintUnqual,	-- :: CmState -> PrintUnqualified
-
-    sandboxIO		-- Should be somewhere else
 #endif
   )
 where
@@ -59,7 +56,7 @@ where
 
 import DriverPipeline	( CompResult(..), preprocess, compile, link )
 import HscMain		( newHscEnv )
-import DriverState	( v_Output_file, v_NoHsMain )
+import DriverState	( v_Output_file, v_NoHsMain, v_MainModIs )
 import DriverPhases
 import Finder
 import HscTypes
@@ -87,6 +84,7 @@ import DATA_IOREF	( readIORef )
 import HscMain		( hscThing, hscStmt, hscTcExpr )
 import TcRnDriver	( mkExportEnv, getModuleContents )
 import IfaceSyn		( IfaceDecl )
+import RdrName		( GlobalRdrEnv, plusGlobalRdrEnv )
 import Name		( Name )
 import NameEnv
 import Id		( idType )
@@ -179,15 +177,25 @@ cmSetContext
 	-> [String]		-- and the just the exports from these
 	-> IO CmState
 cmSetContext cmstate toplevs exports = do 
-  let old_ic = cm_ic cmstate
+  let old_ic  = cm_ic cmstate
+      hsc_env = cm_hsc cmstate
+      hpt     = hsc_HPT hsc_env
 
-  export_env <- mkExportEnv (cm_hsc cmstate) 
-			    (map mkModuleName exports)
+  export_env  <- mkExportEnv hsc_env (map mkModuleName exports)
+  toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
 
-  putStrLn (showSDoc (text "export env" $$ ppr export_env))
+  let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
   return cmstate{ cm_ic = old_ic { ic_toplev_scope = toplevs,
-		     		   ic_exports = exports,
-			       	   ic_rn_gbl_env = export_env } }
+		     		   ic_exports      = exports,
+			       	   ic_rn_gbl_env   = all_env } }
+
+mkTopLevEnv :: HomePackageTable -> String -> IO GlobalRdrEnv
+mkTopLevEnv hpt mod
+ = case lookupModuleEnvByName hpt (mkModuleName mod) of
+      Nothing      -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++ mod))
+      Just details -> case hm_globals details of
+			Nothing  -> throwDyn (ProgramError ("mkTopLevEnv: not interpreted " ++ mod))
+			Just env -> return env
 
 cmGetContext :: CmState -> IO ([String],[String])
 cmGetContext CmState{cm_ic=ic} = 
@@ -219,8 +227,12 @@ cmInfoThing cmstate id
 
 cmBrowseModule :: CmState -> String -> Bool -> IO [IfaceDecl]
 cmBrowseModule cmstate str exports_only
-  = getModuleContents (cm_hsc cmstate) (cm_ic cmstate) 
-		      (mkModuleName str) exports_only
+  = do { mb_decls <- getModuleContents (cm_hsc cmstate) (cm_ic cmstate) 
+		     		       (mkModuleName str) exports_only
+       ; case mb_decls of
+	   Nothing -> return []		-- An error of some kind
+	   Just ds -> return ds
+   }
 
 
 -----------------------------------------------------------------------------
@@ -431,8 +443,11 @@ cmLoadModules cmstate1 mg2unsorted
         let verb = verbosity dflags
 
 	-- Find out if we have a Main module
-        let a_root_is_Main 
-               = any ((=="Main").moduleNameUserString.modSummaryName) 
+	mb_main_mod <- readIORef v_MainModIs
+        let 
+	    main_mod = mb_main_mod `orElse` "Main"
+	    a_root_is_Main 
+               = any ((==main_mod).moduleNameUserString.modSummaryName) 
                      mg2unsorted
 
         let mg2unsorted_names = map modSummaryName mg2unsorted
@@ -561,7 +576,7 @@ cmLoadModules cmstate1 mg2unsorted
 	      let do_linking = a_root_is_Main || no_hs_main
 	      when (ghci_mode == Batch && isJust ofile && not do_linking
 		     && verb > 0) $
-	         hPutStrLn stderr "Warning: output was redirected with -o, but no output will be generated\nbecause there is no Main module."
+	         hPutStrLn stderr ("Warning: output was redirected with -o, but no output will be generated\nbecause there is no " ++ main_mod ++ " module.")
 
 	      -- link everything together
               linkresult <- link ghci_mode dflags do_linking (hsc_HPT hsc_env3)
@@ -1026,7 +1041,7 @@ downsweep roots old_summaries
      where
 	getRootSummary :: FilePath -> IO ModSummary
 	getRootSummary file
-	   | haskellish_src_file file
+	   | isHaskellSrcFilename file
 	   = do exists <- doesFileExist file
 		if exists then summariseFile file else do
 		throwDyn (CmdLineError ("can't find file `" ++ file ++ "'"))