X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcompMan%2FCompManager.lhs;h=829664d2a74fa4ec57820253c9476b710061a977;hb=8e67f5502e2e316245806ee3735a2f41a844b611;hp=9a576b715d427fe9c99c492867e198cb01db6b02;hpb=6ac3317e3c882d2010ceb5cdd3c059633860cd42;p=ghc-hetmet.git

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index 9a576b7..829664d 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -60,8 +60,8 @@ import DriverPipeline	( CompResult(..), preprocess, compile, link )
 import HscMain		( newHscEnv )
 import DriverState	( v_Output_file, v_NoHsMain, v_MainModIs )
 import DriverPhases	( HscSource(..), isHsBoot, hscSourceString, isHaskellSrcFilename )
-import Finder		( findModule, findLinkable, addHomeModuleToFinder, flushFinderCache, 
-			  mkHomeModLocation, FindResult(..), cantFindError )
+import Finder		( findModule, findLinkable, addHomeModuleToFinder,
+			  flushFinderCache, mkHomeModLocation, FindResult(..), cantFindError )
 import HscTypes		( ModSummary(..), HomeModInfo(..), ModIface(..), msHsFilePath,
 			  HscEnv(..), GhciMode(..), 
 			  InteractiveContext(..), emptyInteractiveContext, 
@@ -87,6 +87,7 @@ import FiniteMap
 import DATA_IOREF	( readIORef )
 
 #ifdef GHCI
+import Finder 		( findPackageModule )
 import HscMain		( hscGetInfo, GetInfoResult, hscStmt, hscTcExpr, hscKcType )
 import HscTypes		( TyThing(..), icPrintUnqual, showModMsg )
 import TcRnDriver	( mkExportEnv, getModuleContents )
@@ -95,13 +96,13 @@ import RdrName		( GlobalRdrEnv, plusGlobalRdrEnv )
 import Name		( Name )
 import NameEnv
 import Id		( idType )
-import Type		( tidyType )
+import Type		( tidyType, dropForAlls )
 import VarEnv		( emptyTidyEnv )
 import Linker		( HValue, unload, extendLinkEnv )
 import GHC.Exts		( unsafeCoerce# )
 import Foreign
 import Control.Exception as Exception ( Exception, try )
-import CmdLineOpts	( DynFlag(..), dopt_unset )
+import CmdLineOpts	( DynFlag(..), dopt_unset, dopt )
 #endif
 
 import EXCEPTION	( throwDyn )
@@ -241,7 +242,9 @@ cmSetContext cmstate toplevs exports = do
       hsc_env = cm_hsc cmstate
       hpt     = hsc_HPT hsc_env
 
-  export_env  <- mkExportEnv hsc_env (map mkModule exports)
+  let export_mods = map mkModule exports
+  mapM_ (checkModuleExists (hsc_dflags hsc_env) hpt) export_mods
+  export_env  <- mkExportEnv hsc_env export_mods
   toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
 
   let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
@@ -249,11 +252,22 @@ cmSetContext cmstate toplevs exports = do
  		     		   ic_exports      = exports,
 			       	   ic_rn_gbl_env   = all_env } }
 
+checkModuleExists :: DynFlags -> HomePackageTable -> Module -> IO ()
+checkModuleExists dflags hpt mod = 
+  case lookupModuleEnv hpt mod of
+    Just mod_info -> return ()
+    _not_a_home_module -> do
+	  res <- findPackageModule dflags mod True
+	  case res of
+	    Found _ _ -> return  ()
+	    err -> let msg = cantFindError dflags mod err in
+		   throwDyn (CmdLineError (showSDoc msg))
+
 mkTopLevEnv :: HomePackageTable -> String -> IO GlobalRdrEnv
 mkTopLevEnv hpt mod
  = case lookupModuleEnv hpt (mkModule mod) of
       Nothing      -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++ mod))
-      Just details -> case hm_globals details of
+      Just details -> case mi_globals (hm_iface details) of
 			Nothing  -> throwDyn (ProgramError ("mkTopLevEnv: not interpreted " ++ mod))
 			Just env -> return env
 
@@ -264,7 +278,7 @@ cmGetContext CmState{cm_ic=ic} =
 cmModuleIsInterpreted :: CmState -> String -> IO Bool
 cmModuleIsInterpreted cmstate str 
  = case lookupModuleEnv (cmHPT cmstate) (mkModule str) of
-      Just details       -> return (isJust (hm_globals details))
+      Just details       -> return (isJust (mi_globals (hm_iface details)))
       _not_a_home_module -> return False
 
 -----------------------------------------------------------------------------
@@ -395,12 +409,17 @@ cmTypeOfExpr cmstate expr
 
 	case maybe_stuff of
 	   Nothing -> return Nothing
-	   Just ty -> return (Just res_str)
+	   Just ty -> return (Just (showSDocForUser unqual doc))
  	     where 
-		res_str = showSDocForUser unqual (text expr <+> dcolon <+> ppr tidy_ty)
+		doc     = text expr <+> dcolon <+> ppr final_ty
 		unqual  = icPrintUnqual (cm_ic cmstate)
 		tidy_ty = tidyType emptyTidyEnv ty
-
+		dflags  = hsc_dflags (cm_hsc cmstate)
+		-- if -fglasgow-exts is on we show the foralls, otherwise
+		-- we don't.
+		final_ty
+		  | dopt Opt_GlasgowExts dflags = tidy_ty
+		  | otherwise			= dropForAlls tidy_ty
 
 -----------------------------------------------------------------------------
 -- cmKindOfType: returns a string representing the kind of a type
@@ -1038,11 +1057,10 @@ upsweep_mod hsc_env (old_hpt, old_linkables) summary
            -- Compilation "succeeded", and may or may not have returned a new
            -- linkable (depending on whether compilation was actually performed
 	   -- or not).
-           CompOK new_details new_globals new_iface maybe_new_linkable
+           CompOK new_details new_iface maybe_new_linkable
               -> do let 
 			new_linkable = maybe_new_linkable `orElse` old_linkable
 			new_info = HomeModInfo { hm_iface = new_iface,
-						 hm_globals = new_globals,
 						 hm_details = new_details,
 						 hm_linkable = new_linkable }
                     return (Just new_info)