X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FHscMain.lhs;h=d2731054bfc4e3fefee55e724594c88093320c0a;hb=a3e01707ebc2e7180840b5ab3534f818b43c2873;hp=04a149e1f6e8d00cea74a369cecb5e91bf55f01a;hpb=3b758ccb12e736cf1bf9ce7d4ab6542b84ad0305;p=ghc-hetmet.git

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 04a149e..d273105 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -6,7 +6,8 @@
 
 \begin{code}
 module HscMain ( 
-	HscResult(..), hscMain, newHscEnv, hscCmmFile, hscBufferFrontEnd
+	HscResult(..),
+	hscMain, newHscEnv, hscCmmFile, hscBufferFrontEnd
 #ifdef GHCI
 	, hscStmt, hscTcExpr, hscKcType
 	, hscGetInfo, GetInfoResult
@@ -36,16 +37,18 @@ import Var		( Id )
 import CoreLint		( lintUnfolding )
 import DsMeta		( templateHaskellNames )
 import BasicTypes	( Fixity )
+import SrcLoc		( SrcLoc, noSrcLoc )
 #endif
 
 import RdrName		( RdrName )
 import HsSyn		( HsModule )
-import SrcLoc		( SrcLoc, noSrcLoc, Located(..) )
+import SrcLoc		( Located(..) )
 import StringBuffer	( hGetStringBuffer )
 import Parser
 import Lexer		( P(..), ParseResult(..), mkPState )
 import SrcLoc		( mkSrcLoc )
 import TcRnDriver	( tcRnModule, tcRnExtCore )
+import TcRnTypes	( TcGblEnv )
 import TcIface		( typecheckIface )
 import IfaceEnv		( initNameCache )
 import LoadIface	( ifaceStats, initExternalPackageState )
@@ -129,7 +132,9 @@ data HscResult
    = HscFail
 
    -- In IDE mode: we just do the static/dynamic checks
-   | HscChecked (Located (HsModule RdrName))
+   | HscChecked
+	(Located (HsModule RdrName))	-- parse tree
+	(Maybe TcGblEnv)		-- typechecker output, if succeeded
 
    -- Concluded that it wasn't necessary
    | HscNoRecomp ModDetails  	         -- new details (HomeSymbolTable additions)
@@ -369,14 +374,19 @@ hscBufferFrontEnd hsc_env buffer msg_act = do
         showPass (hsc_dflags hsc_env) "Parser"
 	case unP parseModule (mkPState buffer loc (hsc_dflags hsc_env)) of
 		PFailed span err -> do
-			msg_act (emptyBag, unitBag (mkPlainErrMsg span err))
-			return HscFail
-		POk _ rdr_module -> do 
-			r <- hscFrontEnd hsc_env msg_act rdr_module
-			case r of
-			   Left r -> return r
-			   Right _ -> return (HscChecked rdr_module)
-
+		   msg_act (emptyBag, unitBag (mkPlainErrMsg span err))
+		   return HscFail
+		POk _ rdr_module -> do
+		   hscBufferTypecheck hsc_env rdr_module msg_act
+
+hscBufferTypecheck hsc_env rdr_module msg_act = do
+	(tc_msgs, maybe_tc_result) <- _scc_ "Typecheck-Rename" 
+					tcRnModule hsc_env rdr_module
+	msg_act tc_msgs
+	case maybe_tc_result of
+	    Nothing  -> return (HscChecked rdr_module Nothing)
+	    Just r   -> return (HscChecked rdr_module (Just r))
+				-- space leak on rdr_module!
 
 
 hscFrontEnd hsc_env msg_act rdr_module  = do {