X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=73cfb8352e2f9b0a414fe699eac18de1416a5c80;hb=d1038275d0c9664b63fd7745189cb65ae87bcebc;hp=c1db86ae3cb335f173aa5ee3776f1923f7db0497;hpb=365ab3dad0f9a77e01758a14bf3817dea0ee2a31;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index c1db86a..73cfb83 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -29,7 +29,7 @@ import StaticFlags	( opt_PprStyle_Debug )
 import HsSyn		( HsModule(..), HsExtCore(..), HsGroup(..), LHsDecl,
 			  SpliceDecl(..), HsBind(..), LHsBinds,
 			  emptyRdrGroup, emptyRnGroup, appendGroups, plusHsValBinds,
-			  nlHsApp, nlHsVar, pprLHsBinds )
+			  nlHsApp, nlHsVar, pprLHsBinds, HaddockModInfo(..) )
 import RdrHsSyn		( findSplice )
 
 import PrelNames	( runMainIOName, rootMainKey, rOOT_MAIN, mAIN,
@@ -59,6 +59,7 @@ import RnNames		( importsFromLocalDecls, rnImports, rnExports,
 			  reportUnusedNames, reportDeprecations )
 import RnEnv		( lookupSrcOcc_maybe )
 import RnSource		( rnSrcDecls, rnTyClDecls, checkModDeprec )
+import RnHsDoc          ( rnMbHsDoc )
 import PprCore		( pprRules, pprCoreBindings )
 import CoreSyn		( CoreRule, bindersOfBinds )
 import ErrUtils		( Messages, mkDumpDoc, showPass )
@@ -155,7 +156,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" ;
 
    let { this_pkg = thisPackage (hsc_dflags hsc_env) ;
@@ -232,7 +233,15 @@ tcRnModule hsc_env hsc_src save_rn_syntax
 	reportDeprecations (hsc_dflags hsc_env) tcg_env ;
 
 		-- Process the export list
-	rn_exports <- rnExports export_ies;
+	rn_exports <- rnExports export_ies ;
+                 
+		-- Rename the Haddock documentation header 
+	rn_module_doc <- rnMbHsDoc maybe_doc ;
+
+		-- Rename the Haddock module info 
+	rn_description <- rnMbHsDoc (hmi_description module_info) ;
+	let { rn_module_info = module_info { hmi_description = rn_description } } ;
+
         let { liftM2' fn a b = do a' <- a; b' <- b; return (fn a' b') } ;
         exports <- mkExportNameSet (isJust maybe_mod) 
 				   (liftM2' (,) rn_exports export_ies) ;
@@ -248,7 +257,10 @@ tcRnModule hsc_env hsc_src save_rn_syntax
                                                       else Nothing,
 				     tcg_dus = tcg_dus tcg_env `plusDU` usesOnly exports,
 				     tcg_deprecs = tcg_deprecs tcg_env `plusDeprecs` 
-						   mod_deprecs }
+						   mod_deprecs,
+				     tcg_doc = rn_module_doc, 
+				     tcg_hmi = rn_module_info
+				  }
 		-- A module deprecation over-rides the earlier ones
 	     } ;
 
@@ -473,7 +485,8 @@ tcRnHsBootDecls decls
 
 		-- Typecheck instance decls
 	; traceTc (text "Tc3")
-	; (tcg_env, inst_infos, _binds) <- tcInstDecls1 tycl_decls (hs_instds rn_group)
+	; (tcg_env, inst_infos, _binds) 
+            <- tcInstDecls1 tycl_decls (hs_instds rn_group) (hs_derivds rn_group)
 	; setGblEnv tcg_env	$ do {
 
 		-- Typecheck value declarations
@@ -561,8 +574,9 @@ checkHiBootIface
 missingBootThing thing
   = ppr thing <+> ptext SLIT("is defined in the hs-boot file, but not in the module")
 bootMisMatch thing boot_decl real_decl
-  = ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file")
-    $+$ (ppr boot_decl) $+$ (ppr real_decl)
+  = vcat [ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file"),
+	  ptext SLIT("Decl") <+> ppr real_decl,
+	  ptext SLIT("Boot file:") <+> ppr boot_decl]
 instMisMatch inst
   = hang (ppr inst)
        2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
@@ -629,6 +643,7 @@ tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
 tcTopSrcDecls boot_details
 	(HsGroup { hs_tyclds = tycl_decls, 
 		   hs_instds = inst_decls,
+                   hs_derivds = deriv_decls,
 		   hs_fords  = foreign_decls,
 		   hs_defds  = default_decls,
 		   hs_ruleds = rule_decls,
@@ -649,7 +664,8 @@ tcTopSrcDecls boot_details
 		-- Source-language instances, including derivings,
 		-- and import the supporting declarations
         traceTc (text "Tc3") ;
-	(tcg_env, inst_infos, deriv_binds) <- tcInstDecls1 tycl_decls inst_decls ;
+	(tcg_env, inst_infos, deriv_binds) 
+            <- tcInstDecls1 tycl_decls inst_decls deriv_decls;
 	setGblEnv tcg_env	$ do {
 
 	        -- Foreign import declarations next.  No zonking necessary