X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FcompMan%2FCompManager.lhs;h=ce6302afb07b780fbd30d90d37badfbd59aec558;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=cfea2b88a02a061bc2809b5dde70a708bb2d1566;hpb=6d015ec9d9bd48285eee36039a9bf3ceb42c7f06;p=ghc-hetmet.git

diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs
index cfea2b8..ce6302a 100644
--- a/ghc/compiler/compMan/CompManager.lhs
+++ b/ghc/compiler/compMan/CompManager.lhs
@@ -4,7 +4,6 @@
 % The Compilation Manager
 %
 \begin{code}
-{-# OPTIONS -fvia-C #-}
 module CompManager ( 
     ModuleGraph, ModSummary(..),
 
@@ -25,9 +24,7 @@ module CompManager (
     cmSetContext,  -- :: CmState -> DynFlags -> [String] -> [String] -> IO CmState
     cmGetContext,  -- :: CmState -> IO ([String],[String])
 
-    cmInfoThing,   -- :: CmState -> DynFlags -> String
-		   --	-> IO (CmState, [(TyThing,Fixity)])
-
+    cmInfoThing,    -- :: CmState -> String -> IO (CmState, [(TyThing,Fixity)])
     cmBrowseModule, -- :: CmState -> IO [TyThing]
 
     CmRunResult(..),
@@ -37,6 +34,9 @@ module CompManager (
     cmTypeOfExpr,  -- :: CmState -> DynFlags -> String
 		   -- 	-> IO (CmState, Maybe String)
 
+    cmKindOfType,  -- :: CmState -> DynFlags -> String
+		   -- 	-> IO (CmState, Maybe String)
+
     cmTypeOfName,  -- :: CmState -> Name -> IO (Maybe String)
 
     HValue,
@@ -81,7 +81,7 @@ import Maybes		( expectJust, orElse, mapCatMaybes )
 import DATA_IOREF	( readIORef )
 
 #ifdef GHCI
-import HscMain		( hscThing, hscStmt, hscTcExpr )
+import HscMain		( hscThing, hscStmt, hscTcExpr, hscKcType )
 import TcRnDriver	( mkExportEnv, getModuleContents )
 import IfaceSyn		( IfaceDecl )
 import RdrName		( GlobalRdrEnv, plusGlobalRdrEnv )
@@ -94,6 +94,7 @@ import BasicTypes	( Fixity )
 import Linker		( HValue, unload, extendLinkEnv )
 import GHC.Exts		( unsafeCoerce# )
 import Foreign
+import SrcLoc		( SrcLoc )
 import Control.Exception as Exception ( Exception, try )
 #endif
 
@@ -218,7 +219,7 @@ cmSetDFlags cm_state dflags
 -- A string may refer to more than one TyThing (eg. a constructor,
 -- and type constructor), so we return a list of all the possible TyThings.
 
-cmInfoThing :: CmState -> String -> IO [(IfaceDecl,Fixity)]
+cmInfoThing :: CmState -> String -> IO [(IfaceDecl,Fixity,SrcLoc)]
 cmInfoThing cmstate id
    = hscThing (cm_hsc cmstate) (cm_ic cmstate) id
 
@@ -316,14 +317,27 @@ cmTypeOfExpr cmstate expr
 
 	case maybe_stuff of
 	   Nothing -> return Nothing
-	   Just ty -> return (Just str)
+	   Just ty -> return (Just res_str)
  	     where 
-		str     = showSDocForUser unqual (text expr <+> dcolon <+> ppr tidy_ty)
+		res_str = showSDocForUser unqual (text expr <+> dcolon <+> ppr tidy_ty)
 		unqual  = icPrintUnqual (cm_ic cmstate)
 		tidy_ty = tidyType emptyTidyEnv ty
 
 
 -----------------------------------------------------------------------------
+-- cmKindOfType: returns a string representing the kind of a type
+
+cmKindOfType :: CmState -> String -> IO (Maybe String)
+cmKindOfType cmstate str
+   = do maybe_stuff <- hscKcType (cm_hsc cmstate) (cm_ic cmstate) str
+	case maybe_stuff of
+	   Nothing -> return Nothing
+	   Just kind -> return (Just res_str)
+ 	     where 
+		res_str = showSDocForUser unqual (text str <+> dcolon <+> ppr kind)
+		unqual  = icPrintUnqual (cm_ic cmstate)
+
+-----------------------------------------------------------------------------
 -- cmTypeOfName: returns a string representing the type of a name.
 
 cmTypeOfName :: CmState -> Name -> IO (Maybe String)
@@ -576,7 +590,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)
@@ -933,7 +947,8 @@ upsweep_mod hsc_env oldUI summary1 reachable_inc_me
 	       | otherwise = False
 
         compresult <- compile hsc_env_strictDC this_mod location 
-			      source_unchanged have_object mb_old_iface
+			(ms_hs_date summary1) 
+			source_unchanged have_object mb_old_iface
 
         case compresult of