X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=591ea5e2c16d97240f620b29ba0294dc73ee5f97;hb=aedb94f5f220b5e442b23ecc445fd38c8d9b6ba0;hp=325b9db3f35302899bf9aa29c4bbb7e045c5d9e7;hpb=9bcd95bad83ee937c178970e8b729732e680fe1e;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 325b9db..591ea5e 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -320,7 +320,8 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 	my_exports = map (Avail . idName) bndrs ;
 		-- ToDo: export the data types also?
 
-	final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
+	final_type_env = 
+             extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
 
 	mod_guts = ModGuts {	mg_module    = this_mod,
 				mg_boot	     = False,
@@ -546,6 +547,15 @@ checkHiBootIface
 		-- Check the exports of the boot module, one by one
 	; mapM_ check_export boot_exports
 
+		-- Check instance declarations
+	; mb_dfun_prs <- mapM check_inst boot_insts
+	; let tcg_env' = tcg_env { tcg_binds    = binds `unionBags` dfun_binds,
+				   tcg_type_env = extendTypeEnvWithIds local_type_env boot_dfuns }
+	      dfun_prs   = catMaybes mb_dfun_prs
+	      boot_dfuns = map fst dfun_prs
+	      dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
+				     | (boot_dfun, dfun) <- dfun_prs ]
+
 		-- Check for no family instances
 	; unless (null boot_fam_insts) $
 	    panic ("TcRnDriver.checkHiBootIface: Cannot handle family " ++
@@ -560,7 +570,7 @@ checkHiBootIface
 	      final_type_env = extendTypeEnvWithIds local_type_env boot_dfuns
 	      dfun_prs   = catMaybes mb_dfun_prs
 	      boot_dfuns = map fst dfun_prs
-	      dfun_binds = listToBag [ noLoc $ VarBind boot_dfun (nlHsVar dfun)
+	      dfun_binds = listToBag [ mkVarBind boot_dfun (nlHsVar dfun)
 				     | (boot_dfun, dfun) <- dfun_prs ]
 
         ; failIfErrsM
@@ -904,7 +914,7 @@ check_main dflags tcg_env
 						    (mkTyConApp ioTyCon [res_ty])
 	      ; co  = mkWpTyApps [res_ty]
 	      ; rhs = nlHsApp (mkLHsWrap co (nlHsVar run_main_id)) main_expr
-	      ; main_bind = noLoc (VarBind root_main_id rhs) }
+	      ; main_bind = mkVarBind root_main_id rhs }
 
 	; return (tcg_env { tcg_binds = tcg_binds tcg_env 
 					`snocBag` main_bind,