X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FGHC.hs;h=c786cbba1616b4bde39e3d77be45cdaca4e6d695;hb=49c98d143c382a1341e1046f5ca00819a25691ba;hp=250187afbe16b2640e544a0697289d58fbdde7e9;hpb=0bb19f30a4d773f4dd2f88bc5a3c2bdde2e74df0;p=ghc-hetmet.git

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 250187a..c786cbb 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -40,6 +40,9 @@ module GHC (
 	checkModule, CheckedModule(..),
 	TypecheckedSource, ParsedSource, RenamedSource,
 
+	-- * Parsing Haddock comments
+	parseHaddockComment,
+
 	-- * Inspecting the module structure of the program
 	ModuleGraph, ModSummary(..), ms_mod_name, ModLocation(..),
 	getModuleGraph,
@@ -91,7 +94,7 @@ module GHC (
 
 	-- ** Names
 	Name, 
-	nameModule, nameParent_maybe, pprParenSymName, nameSrcLoc,
+	nameModule, pprParenSymName, nameSrcLoc,
 	NamedThing(..),
 	RdrName(Qual,Unqual),
 	
@@ -191,7 +194,7 @@ import NameSet		( NameSet, nameSetToList, elemNameSet )
 import RdrName		( GlobalRdrEnv, GlobalRdrElt(..), RdrName(..), 
 			  globalRdrEnvElts, extendGlobalRdrEnv,
                           emptyGlobalRdrEnv )
-import HsSyn
+import HsSyn 
 import Type		( Kind, Type, dropForAlls, PredType, ThetaType,
 			  pprThetaArrow, pprParendType, splitForAllTys,
 			  funResultTy )
@@ -212,8 +215,7 @@ import FunDeps		( pprFundeps )
 import DataCon		( DataCon, dataConWrapId, dataConSig, dataConTyCon,
 			  dataConFieldLabels, dataConStrictMarks, 
 			  dataConIsInfix, isVanillaDataCon )
-import Name		( Name, nameModule, NamedThing(..), nameParent_maybe,
-			  nameSrcLoc )
+import Name		( Name, nameModule, NamedThing(..), nameSrcLoc )
 import OccName		( parenSymOcc )
 import NameEnv		( nameEnvElts )
 import InstEnv		( Instance, instanceDFunId, pprInstance, pprInstanceHdr )
@@ -244,6 +246,8 @@ import Outputable
 import BasicTypes
 import TcType           ( tcSplitSigmaTy, isDictTy )
 import Maybes		( expectJust, mapCatMaybes )
+import HaddockParse     ( parseHaddockParagraphs, parseHaddockString )
+import HaddockLex       ( tokenise )
 
 import Control.Concurrent
 import System.Directory ( getModificationTime, doesFileExist )
@@ -475,6 +479,12 @@ setGlobalTypeScope session ids
       hscEnv{ hsc_global_type_env = extendTypeEnvWithIds emptyTypeEnv ids }
 
 -- -----------------------------------------------------------------------------
+-- Parsing Haddock comments
+
+parseHaddockComment :: String -> Either String (HsDoc RdrName)
+parseHaddockComment string = parseHaddockParagraphs (tokenise string)
+
+-- -----------------------------------------------------------------------------
 -- Loading the program
 
 -- Perform a dependency analysis starting from the current targets
@@ -643,6 +653,8 @@ load2 s@(Session ref) how_much mod_graph = do
 	let cleanup = cleanTempFilesExcept dflags
 			  (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
 
+	debugTraceMsg dflags 2 (hang (text "Ready for upsweep") 
+				   2 (ppr mg))
         (upsweep_ok, hsc_env1, modsUpswept)
            <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
 			   pruned_hpt stable_mods cleanup mg
@@ -762,7 +774,8 @@ data CheckedModule =
 	--  fields within CheckedModule.
 
 type ParsedSource      = Located (HsModule RdrName)
-type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name])
+type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name],
+                          Maybe (HsDoc Name), HaddockModInfo Name)
 type TypecheckedSource = LHsBinds Id
 
 -- NOTE:
@@ -807,7 +820,8 @@ checkModule session@(Session ref) mod = do
 			   (Just (tc_binds, rdr_env, details))) -> do
 		   let minf = ModuleInfo {
 				minf_type_env  = md_types details,
-				minf_exports   = md_exports details,
+				minf_exports   = availsToNameSet $
+                                                     md_exports details,
 				minf_rdr_env   = Just rdr_env,
 				minf_instances = md_insts details
 			      }
@@ -1716,7 +1730,7 @@ getPrintUnqual s = withSession s (return . icPrintUnqual . hsc_IC)
 -- | Container for information about a 'Module'.
 data ModuleInfo = ModuleInfo {
 	minf_type_env  :: TypeEnv,
-	minf_exports   :: NameSet,
+	minf_exports   :: NameSet, -- ToDo, [AvailInfo] like ModDetails?
 	minf_rdr_env   :: Maybe GlobalRdrEnv,	-- Nothing for a compiled/package mod
 	minf_instances :: [Instance]
 	-- ToDo: this should really contain the ModIface too
@@ -1771,7 +1785,7 @@ getHomeModuleInfo hsc_env mdl =
       let details = hm_details hmi
       return (Just (ModuleInfo {
 			minf_type_env  = md_types details,
-			minf_exports   = md_exports details,
+			minf_exports   = availsToNameSet (md_exports details),
 			minf_rdr_env   = mi_globals $! hm_iface hmi,
 			minf_instances = md_insts details
 			}))