X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=c744c1513ab981896a564fc032b1c720ad4d5661;hb=b9a98f56bf88c69a13b477ab8422fbd71df20019;hp=7c79e6252382603777a03931f7c14d945e1a9a67;hpb=eeb635d0ed2346568e312ac06ce7f2f1ecb434be;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 7c79e62..c744c15 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -125,7 +125,7 @@ tcRnModule :: HscEnv
 
 tcRnModule hsc_env hsc_src save_rn_syntax
 	 (L loc (HsModule maybe_mod export_ies 
-			  import_decls local_decls mod_deprec _ 
+			  import_decls local_decls mod_deprec
 			  module_info maybe_doc))
  = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
 
@@ -170,8 +170,9 @@ tcRnModule hsc_env hsc_src save_rn_syntax
 	tcg_env <- finishDeprecations (hsc_dflags hsc_env) mod_deprec tcg_env ;
 
 		-- Process the export list
+       traceRn (text "rn4a: before exports");
 	tcg_env <- rnExports (isJust maybe_mod) export_ies tcg_env ;
-	traceRn (text "rn4") ;
+	traceRn (text "rn4b: after exportss") ;
 
 	-- Compare the hi-boot iface (if any) with the real thing
 	-- Must be done after processing the exports
@@ -282,21 +283,26 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 
    let { ldecls  = map noLoc decls } ;
 
-	-- Deal with the type declarations; first bring their stuff
-	-- into scope, then rname them, then type check them
-   tcg_env  <- importsFromLocalDecls (mkFakeGroup ldecls) ;
+       -- bring the type and class decls into scope
+       -- ToDo: check that this doesn't need to extract the val binds.
+       --       It seems that only the type and class decls need to be in scope below because
+       --          (a) tcTyAndClassDecls doesn't need the val binds, and 
+       --          (b) tcExtCoreBindings doesn't need anything
+       --              (in fact, it might not even need to be in the scope of
+       --               this tcg_env at all)
+   tcg_env  <- importsFromLocalDecls False (mkFakeGroup ldecls) 
+               emptyUFM {- no fixity decls -} ;
 
    setGblEnv tcg_env $ do {
 
-   rn_decls <- rnTyClDecls ldecls ;
-   failIfErrsM ;
+   rn_decls <- checkNoErrs $ rnTyClDecls ldecls ;
 
 	-- Dump trace of renaming part
    rnDump (ppr rn_decls) ;
 
 	-- Typecheck them all together so that
 	-- any mutually recursive types are done right
-   tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails rn_decls) ;
+   tcg_env <- tcTyAndClassDecls emptyModDetails rn_decls ;
 	-- Make the new type env available to stuff slurped from interface files
 
    setGblEnv tcg_env $ do {
@@ -385,6 +391,10 @@ tcRnSrcDecls boot_iface decls
 		         tcg_rules = rules, tcg_fords = fords } = tcg_env
 	    ; all_binds = binds `unionBags` inst_binds } ;
 
+	failIfErrsM ;	-- Don't zonk if there have been errors
+			-- It's a waste of time; and we may get debug warnings
+			-- about strangely-typed TyCons!
+
 	(bind_ids, binds', fords', rules') <- zonkTopDecls all_binds rules fords ;
 
 	let { final_type_env = extendTypeEnvWithIds type_env bind_ids
@@ -404,8 +414,8 @@ tc_rn_src_decls boot_details ds
 		-- If ds is [] we get ([], Nothing)
 
 	-- Deal with decls up to, but not including, the first splice
-	(tcg_env, rn_decls) <- checkNoErrs $ rnTopSrcDecls first_group ;
-		-- checkNoErrs: stop if renaming fails
+	(tcg_env, rn_decls) <- rnTopSrcDecls first_group ;
+		-- rnTopSrcDecls fails if there are any errors
 
 	(tcg_env, tcl_env) <- setGblEnv tcg_env $ 
 			      tcTopSrcDecls boot_details rn_decls ;
@@ -463,7 +473,7 @@ tcRnHsBootDecls decls
 		-- Typecheck type/class decls
 	; traceTc (text "Tc2")
 	; let tycl_decls = hs_tyclds rn_group
-	; tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails tycl_decls)
+	; tcg_env <- tcTyAndClassDecls emptyModDetails tycl_decls
 	; setGblEnv tcg_env	$ do {
 
 		-- Typecheck instance decls
@@ -631,18 +641,12 @@ monad; it augments it and returns the new TcGblEnv.
 \begin{code}
 ------------------------------------------------
 rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
+-- Fails if there are any errors
 rnTopSrcDecls group
- = do { 	-- Bring top level binders into scope
-	tcg_env <- importsFromLocalDecls group ;
-	setGblEnv tcg_env $ do {
-
-	failIfErrsM ;	-- No point in continuing if (say) we have duplicate declarations
+ = do { -- Rename the source decls (with no shadowing; error on duplicates)
+	(tcg_env, rn_decls) <- checkNoErrs $ rnSrcDecls False group ;
 
-		-- Rename the source decls
-	(tcg_env, rn_decls) <- rnSrcDecls group ;
-	failIfErrsM ;
-
-		-- save the renamed syntax, if we want it
+        -- save the renamed syntax, if we want it
 	let { tcg_env'
 	        | Just grp <- tcg_rn_decls tcg_env
 	          = tcg_env{ tcg_rn_decls = Just (appendGroups grp rn_decls) }
@@ -653,7 +657,7 @@ rnTopSrcDecls group
 	rnDump (ppr rn_decls) ;
 
 	return (tcg_env', rn_decls)
-   }}
+   }
 
 ------------------------------------------------
 tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
@@ -669,9 +673,8 @@ tcTopSrcDecls boot_details
 		-- The latter come in via tycl_decls
         traceTc (text "Tc2") ;
 
-	tcg_env <- checkNoErrs (tcTyAndClassDecls boot_details tycl_decls) ;
-	-- tcTyAndClassDecls recovers internally, but if anything gave rise to
-	-- an error we'd better stop now, to avoid a cascade
+	tcg_env <- tcTyAndClassDecls boot_details tycl_decls ;
+		-- If there are any errors, tcTyAndClassDecls fails here
 	
 	-- Make these type and class decls available to stuff slurped from interface files
 	writeMutVar (tcg_type_env_var tcg_env) (tcg_type_env tcg_env) ;