X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=60f0fe93dd478964e7ab803a76701454aef147dc;hb=d2f11ea842a25bebd51d6c0c730a756c1d987e25;hp=a42e85dadbe215df158b44cb381e6055240691cc;hpb=e8fa04cf0d656c4a2ff737278b8cea9fce3b5a2b;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index a42e85d..60f0fe9 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -364,7 +364,7 @@ tcRnSrcDecls :: ModDetails -> [LHsDecl RdrName] -> TcM TcGblEnv
 	-- Reason: solely to report unused imports and bindings
 tcRnSrcDecls boot_iface decls
  = do {   	-- Do all the declarations
-	(tc_envs, lie) <- getConstraints $ tc_rn_src_decls boot_iface decls ;
+	(tc_envs, lie) <- captureConstraints $ tc_rn_src_decls boot_iface decls ;
       ; traceTc "Tc8" empty ;
       ; setEnvs tc_envs $ 
    do { 
@@ -394,20 +394,22 @@ tcRnSrcDecls boot_iface decls
 	-- Even simplifyTop may do some unification.
         -- This pass also warns about missing type signatures
 	let { (tcg_env, _) = tc_envs
-	    ; TcGblEnv { tcg_type_env = type_env,
-		         tcg_binds    = binds,
-		         tcg_sigs     = sig_ns,
-		         tcg_ev_binds = cur_ev_binds,
-		         tcg_rules    = rules,
-		         tcg_fords    = fords } = tcg_env
+	    ; TcGblEnv { tcg_type_env  = type_env,
+		         tcg_binds     = binds,
+		         tcg_sigs      = sig_ns,
+		         tcg_ev_binds  = cur_ev_binds,
+		         tcg_imp_specs = imp_specs,
+		         tcg_rules     = rules,
+		         tcg_fords     = fords } = tcg_env
             ; all_ev_binds = cur_ev_binds `unionBags` new_ev_binds } ;
 
-	(bind_ids, ev_binds', binds', fords', rules') 
-            <- zonkTopDecls all_ev_binds binds sig_ns rules fords ;
+	(bind_ids, ev_binds', binds', fords', imp_specs', rules') 
+            <- zonkTopDecls all_ev_binds binds sig_ns rules imp_specs fords ;
 	
 	let { final_type_env = extendTypeEnvWithIds type_env bind_ids
 	    ; tcg_env' = tcg_env { tcg_binds    = binds',
 				   tcg_ev_binds = ev_binds',
+				   tcg_imp_specs = imp_specs',
 				   tcg_rules 	= rules', 
 				   tcg_fords 	= fords' } } ;
 
@@ -480,7 +482,7 @@ tcRnHsBootDecls decls
 		   hs_ruleds = rule_decls, 
 		   hs_annds  = _,
 		   hs_valds  = val_binds }) <- rnTopSrcDecls first_group
-	; (gbl_env, lie) <- getConstraints $ setGblEnv tcg_env $ do {
+	; (gbl_env, lie) <- captureConstraints $ setGblEnv tcg_env $ do {
 
 
 		-- Check for illegal declarations
@@ -860,14 +862,14 @@ tcTopSrcDecls boot_details
 		-- Now GHC-generated derived bindings, generics, and selectors
 		-- Do not generate warnings from compiler-generated code;
 		-- hence the use of discardWarnings
-	(tc_aux_binds,   tcl_env) <- discardWarnings (tcTopBinds aux_binds) ;
-	(tc_deriv_binds, tcl_env) <- setLclTypeEnv tcl_env $ 
-			 	     discardWarnings (tcTopBinds deriv_binds) ;
+	(tc_aux_binds,   specs1, tcl_env) <- discardWarnings (tcTopBinds aux_binds) ;
+	(tc_deriv_binds, specs2, tcl_env) <- setLclTypeEnv tcl_env $ 
+			 	             discardWarnings (tcTopBinds deriv_binds) ;
 
 		-- Value declarations next
         traceTc "Tc5" empty ;
-	(tc_val_binds, tcl_env) <- setLclTypeEnv tcl_env $
-			 	   tcTopBinds val_binds;
+	(tc_val_binds, specs3, tcl_env) <- setLclTypeEnv tcl_env $
+			 	           tcTopBinds val_binds;
 
         setLclTypeEnv tcl_env $ do {	-- Environment doesn't change now
 
@@ -900,6 +902,7 @@ tcTopSrcDecls boot_details
 		-- Extend the GblEnv with the (as yet un-zonked) 
 		-- bindings, rules, foreign decls
 	    ; tcg_env' = tcg_env { tcg_binds = tcg_binds tcg_env `unionBags` all_binds
+	      	       	 	 , tcg_imp_specs = tcg_imp_specs tcg_env ++ specs1 ++ specs2 ++ specs3
                                  , tcg_sigs  = tcg_sigs tcg_env `unionNameSets` sig_names
 				 , tcg_rules = tcg_rules tcg_env ++ rules
 				 , tcg_anns  = tcg_anns tcg_env ++ annotations
@@ -1271,7 +1274,7 @@ tcGhciStmts stmts
 
 	-- OK, we're ready to typecheck the stmts
 	traceTc "TcRnDriver.tcGhciStmts: tc stmts" empty ;
-	((tc_stmts, ids), lie) <- getConstraints $ tc_io_stmts stmts $ \ _ ->
+	((tc_stmts, ids), lie) <- captureConstraints $ tc_io_stmts stmts $ \ _ ->
 					   mapM tcLookupId names ;
 					-- Look up the names right in the middle,
 					-- where they will all be in scope
@@ -1304,8 +1307,8 @@ tcRnExpr hsc_env ictxt rdr_expr
 
 	-- Now typecheck the expression; 
 	-- it might have a rank-2 type (e.g. :t runST)
-    ((_tc_expr, res_ty), lie)	<- getConstraints (tcInferRho rn_expr) ;
-    ((qtvs, dicts, _), lie_top) <- getConstraints (simplifyInfer False {- No MR for now -}
+    ((_tc_expr, res_ty), lie)	<- captureConstraints (tcInferRho rn_expr) ;
+    ((qtvs, dicts, _), lie_top) <- captureConstraints (simplifyInfer False {- No MR for now -}
                                                       (tyVarsOfType res_ty) lie)  ;
     _ <- simplifyInteractive lie_top ;       -- Ignore the dicionary bindings