X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=e5f945c4e29826c7ac8b25e1effd6de5a303b8bd;hb=4d8eace1bd97158e4d794a4ecb084bb42aa0c2d7;hp=6c55a6232fde3e1be64185eed529201fd938c742;hpb=74da1264ba27c992e331b821c27b5d048c8d33cb;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 6c55a62..e5f945c 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -88,6 +88,7 @@ import TysWiredIn
 import IdInfo
 import {- Kind parts of -} Type
 import BasicTypes
+import Foreign.Ptr( Ptr )
 #endif
 
 import FastString
@@ -97,7 +98,6 @@ import Bag
 
 import Control.Monad    ( unless )
 import Data.Maybe	( isJust )
-import Foreign.Ptr      ( Ptr )
 
 \end{code}
 
@@ -314,6 +314,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 				mg_types     = final_type_env,
 				mg_insts     = tcg_insts tcg_env,
 				mg_fam_insts = tcg_fam_insts tcg_env,
+				mg_inst_env  = tcg_inst_env tcg_env,
 				mg_fam_inst_env = tcg_fam_inst_env tcg_env,
 				mg_rules     = [],
 				mg_binds     = core_binds,
@@ -695,10 +696,10 @@ tcTopSrcDecls boot_details
 	(tc_val_binds,   tcl_env) <- tcTopBinds val_binds ;
 	setLclTypeEnv tcl_env 	$ do {
 
-		-- Now GHC-generated derived bindings and generics
-		-- Do not generate warnings from compiler-generated code
-	(tc_deriv_binds, tcl_env) <- discardWarnings $ setOptM Opt_GlasgowExts $ 
-				     tcTopBinds deriv_binds ;
+		-- Now GHC-generated derived bindings and generics.
+		-- Do not generate warnings from compiler-generated code.
+	(tc_deriv_binds, tcl_env) <- discardWarnings $
+                                 tcTopBinds deriv_binds ;
 
 	     	-- Second pass over class and instance declarations, 
         traceTc (text "Tc6") ;
@@ -743,23 +744,16 @@ checkMain :: TcM TcGblEnv
 checkMain 
   = do { tcg_env   <- getGblEnv ;
 	 dflags    <- getDOpts ;
-	 let { main_mod = mainModIs dflags ;
-	       main_fn  = case mainFunIs dflags of {
-				Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn)) ;
-				Nothing -> main_RDR_Unqual } } ;
-	
-	 check_main dflags tcg_env main_mod main_fn
+	 check_main dflags tcg_env
     }
 
-
-check_main dflags tcg_env main_mod main_fn
+check_main dflags tcg_env
  | mod /= main_mod
  = traceTc (text "checkMain not" <+> ppr main_mod <+> ppr mod) >>
    return tcg_env
 
  | otherwise
- = addErrCtxt mainCtxt			$
-   do	{ mb_main <- lookupSrcOcc_maybe main_fn
+ = do	{ mb_main <- lookupSrcOcc_maybe main_fn
 		-- Check that 'main' is in scope
 		-- It might be imported from another module!
 	; case mb_main of {
@@ -767,17 +761,19 @@ check_main dflags tcg_env main_mod main_fn
 			   ; complain_no_main	
 			   ; return tcg_env } ;
 	     Just main_name -> do
+
 	{ traceTc (text "checkMain found" <+> ppr main_mod <+> ppr main_fn)
 	; let { rhs = nlHsApp (nlHsVar runMainIOName) (nlHsVar main_name) }
 		   	-- :Main.main :: IO () = runMainIO main 
 
-	; (main_expr, ty) <- setSrcSpan (srcLocSpan (getSrcLoc main_name)) $
+	; (main_expr, ty) <- addErrCtxt mainCtxt			$
+   			     setSrcSpan (srcLocSpan (getSrcLoc main_name)) $
 			     tcInferRho rhs
 
 		-- See Note [Root-main Id]
 	; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN 
 				   (mkVarOccFS FSLIT("main")) 
-				   (getSrcLoc main_name)
+				   (getSrcSpan main_name)
 	      ; root_main_id = Id.mkExportedLocalId root_main_name ty
 	      ; main_bind    = noLoc (VarBind root_main_id main_expr) }
 
@@ -790,17 +786,25 @@ check_main dflags tcg_env main_mod main_fn
 		 }) 
     }}}
   where
-    mod = tcg_mod tcg_env
- 
+    mod 	 = tcg_mod tcg_env
+    main_mod     = mainModIs dflags
+    main_is_flag = mainFunIs dflags
+
+    main_fn  = case main_is_flag of
+		  Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn))
+		  Nothing -> main_RDR_Unqual
+
     complain_no_main | ghcLink dflags == LinkInMemory = return ()
 		     | otherwise = failWithTc noMainMsg
 	-- In interactive mode, don't worry about the absence of 'main'
 	-- In other modes, fail altogether, so that we don't go on
 	-- and complain a second time when processing the export list.
 
-    mainCtxt  = ptext SLIT("When checking the type of the main function") <+> quotes (ppr main_fn)
-    noMainMsg = ptext SLIT("The main function") <+> quotes (ppr main_fn) 
+    mainCtxt  = ptext SLIT("When checking the type of the") <+> pp_main_fn
+    noMainMsg = ptext SLIT("The") <+> pp_main_fn
 		<+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
+    pp_main_fn | isJust main_is_flag = ptext SLIT("main function") <+> quotes (ppr main_fn)
+	       | otherwise 	     = ptext SLIT("function") <+> quotes (ppr main_fn)
 \end{code}
 
 Note [Root-main Id]
@@ -837,8 +841,8 @@ setInteractiveContext hsc_env icxt thing_inside
 	tcg_inst_env = extendInstEnvList (tcg_inst_env env) dfuns }) $
 
 
-    tcExtendIdEnv (ic_tmp_ids icxt) $
-        -- tcExtendIdEnv does lots: 
+    tcExtendGhciEnv (ic_tmp_ids icxt) $
+        -- tcExtendGhciEnv does lots: 
         --   - it extends the local type env (tcl_env) with the given Ids,
         --   - it extends the local rdr env (tcl_rdr) with the Names from 
         --     the given Ids