X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=e0d8632a6ae316038555171b93e69296f3dd7841;hb=6976a7121afdb4c154afbe636c315cc9595eaf00;hp=35f48d0db0c2bdc645ce788f9c866be6f656c753;hpb=45b7ef25fe0bdab56b817d17f24db0e725cc7688;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 35f48d0..e0d8632 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -45,6 +45,7 @@ import Inst
 import FamInst
 import InstEnv
 import FamInstEnv
+import TcAnnotations
 import TcBinds
 import TcDefaults
 import TcEnv
@@ -294,8 +295,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
        --              (in fact, it might not even need to be in the scope of
        --               this tcg_env at all)
    avails  <- getLocalNonValBinders (mkFakeGroup ldecls) ;
-   tc_envs <- extendGlobalRdrEnvRn False avails 
-			           emptyFsEnv {- no fixity decls -} ;
+   tc_envs <- extendGlobalRdrEnvRn avails emptyFsEnv {- no fixity decls -} ;
 
    setEnvs tc_envs $ do {
 
@@ -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,
@@ -391,8 +392,10 @@ tcRnSrcDecls boot_iface decls
 	    -- Even tcSimplifyTop may do some unification.
         traceTc (text "Tc9") ;
 	let { (tcg_env, _) = tc_envs
-	    ; TcGblEnv { tcg_type_env = type_env, tcg_binds = binds, 
-		         tcg_rules = rules, tcg_fords = fords } = tcg_env
+	    ; TcGblEnv { tcg_type_env = type_env,
+		         tcg_binds = binds,
+		         tcg_rules = rules,
+		         tcg_fords = fords } = tcg_env
 	    ; all_binds = binds `unionBags` inst_binds } ;
 
 	failIfErrsM ;	-- Don't zonk if there have been errors
@@ -469,26 +472,32 @@ tcRnHsBootDecls decls
 	     Nothing    -> return ()
 
 		-- Rename the declarations
-	; (tcg_env, rn_group) <- rnTopSrcDecls first_group
+	; (tcg_env, HsGroup { 
+		   hs_tyclds = tycl_decls, 
+		   hs_instds = inst_decls,
+		   hs_derivds = deriv_decls,
+		   hs_fords  = _,
+		   hs_defds  = _, -- Todo: check no foreign decls, no rules,
+		   hs_ruleds = _, -- no default decls and no annotation decls
+		   hs_annds  = _,
+		   hs_valds  = val_binds }) <- rnTopSrcDecls first_group
 	; setGblEnv tcg_env $ do {
 
-	-- Todo: check no foreign decls, no rules, no default decls
 
 		-- Typecheck type/class decls
 	; traceTc (text "Tc2")
-	; let tycl_decls = hs_tyclds rn_group
 	; tcg_env <- tcTyAndClassDecls emptyModDetails tycl_decls
 	; setGblEnv tcg_env	$ do {
 
 		-- Typecheck instance decls
 	; traceTc (text "Tc3")
 	; (tcg_env, inst_infos, _deriv_binds) 
-            <- tcInstDecls1 tycl_decls (hs_instds rn_group) (hs_derivds rn_group)
+            <- tcInstDecls1 tycl_decls inst_decls deriv_decls
 	; setGblEnv tcg_env	$ do {
 
 		-- Typecheck value declarations
 	; traceTc (text "Tc5") 
-	; val_ids <- tcHsBootSigs (hs_valds rn_group)
+	; val_ids <- tcHsBootSigs val_binds
 
 		-- Wrap up
 		-- No simplification or zonking to do
@@ -747,8 +756,8 @@ monad; it augments it and returns the new TcGblEnv.
 rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
 -- Fails if there are any errors
 rnTopSrcDecls group
- = do { -- Rename the source decls (with no shadowing; error on duplicates)
-	(tcg_env, rn_decls) <- checkNoErrs $ rnSrcDecls False group ;
+ = do { -- Rename the source decls
+	(tcg_env, rn_decls) <- checkNoErrs $ rnSrcDecls group ;
 
         -- save the renamed syntax, if we want it
 	let { tcg_env'
@@ -771,6 +780,7 @@ tcTopSrcDecls boot_details
                    hs_derivds = deriv_decls,
 		   hs_fords  = foreign_decls,
 		   hs_defds  = default_decls,
+		   hs_annds  = annotation_decls,
 		   hs_ruleds = rule_decls,
 		   hs_valds  = val_binds })
  = do {		-- Type-check the type and class decls, and all imported decls
@@ -821,6 +831,9 @@ tcTopSrcDecls boot_details
         traceTc (text "Tc7") ;
 	(foe_binds, foe_decls) <- tcForeignExports foreign_decls ;
 
+                -- Annotations
+	annotations <- tcAnnotations annotation_decls ;
+
 		-- Rules
 	rules <- tcRules rule_decls ;
 
@@ -830,12 +843,13 @@ tcTopSrcDecls boot_details
 	let { all_binds = tc_val_binds	 `unionBags`
 			  tc_deriv_binds `unionBags`
 			  inst_binds	 `unionBags`
-			  foe_binds  ;
+			  foe_binds;
 
 		-- 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_rules = tcg_rules tcg_env ++ rules,
+				    tcg_anns  = tcg_anns tcg_env ++ annotations,
 				    tcg_fords = tcg_fords tcg_env ++ foe_decls ++ fi_decls } } ;
   	return (tcg_env', tcl_env)
     }}}}}}