Adapt to latest GHC

8 files changed, 228 insertions, 116 deletions

diff --git a/haddock.cabal b/haddock.cabal
index d226d8e1..a9749119 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -9,7 +9,7 @@ maintainer: Simon Marlow <simonmar@microsoft.com>
 stability: stable
 homepage: http://www.haskell.org/haddock/
 synopsis: Haddock is a documentation-generation tool for Haskell libraries
-build-depends: base>=1.0, haskell98>=1.0, mtl>=1.0, network>=1.0, ghc
+build-depends: base>=1.0, haskell98>=1.0, mtl>=1.0, ghc, network>=1.0
 data-files:
 	html/haddock-DEBUG.css
 	html/haddock.css
diff --git a/src/HaddockDevHelp.hs b/src/HaddockDevHelp.hs
index adfee1e2..8bf65d1a 100644
--- a/src/HaddockDevHelp.hs
+++ b/src/HaddockDevHelp.hs
@@ -4,18 +4,18 @@ import HaddockModuleTree
 import HaddockTypes
 import HaddockUtil
 
-import Module ( moduleString, Module )
-import Name   ( Name, nameModule, getOccString )
+import Module        ( moduleName, moduleNameString, Module, mkModule, mkModuleName )
+import PackageConfig ( stringToPackageId )
+import Name          ( Name, nameModule, getOccString )
 
-import Data.Maybe ( fromMaybe )
+import Data.Maybe    ( fromMaybe )
 import qualified Data.Map as Map
 import Text.PrettyPrint
 
 ppDevHelpFile :: FilePath -> String -> Maybe String -> [HaddockModule] -> IO ()
 ppDevHelpFile odir doctitle maybe_package modules = do
   let devHelpFile = package++".devhelp"
-      tree = mkModuleTree [ (hmod_mod mod, hmod_package mod, toDescription mod)
-			    | mod <- modules ]
+      tree = mkModuleTree True [ (hmod_mod mod, toDescription mod) | mod <- modules ]
       doc =
         text "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>" $$
         (text "<book xmlns=\"http://www.devhelp.net/book\" title=\""<>text doctitle<>
@@ -37,7 +37,7 @@ ppDevHelpFile odir doctitle maybe_package modules = do
     ppModuleTree _  []     = error "HaddockHH.ppHHContents.fn: no module trees given"
 
     ppNode :: [String] -> ModuleTree -> Doc
-    ppNode ss (Node s leaf _pkg _short ts) =
+    ppNode ss (Node s leaf _ _short ts) =
         case ts of
           [] -> text "<sub"<+>ppAttribs<>text "/>"
           ts -> 
@@ -45,7 +45,8 @@ ppDevHelpFile odir doctitle maybe_package modules = do
             nest 4 (ppModuleTree (s:ss) ts) $+$
             text "</sub>"
         where
-          ppLink | leaf      = text (moduleHtmlFile mdl)
+          ppLink | leaf      = text (moduleHtmlFile (mkModule (stringToPackageId "") 
+                                                              (mkModuleName mdl)))
                  | otherwise = empty
 
           ppAttribs = text "name="<>doubleQuotes (text s)<+>text "link="<>doubleQuotes ppLink
@@ -69,6 +70,6 @@ ppDevHelpFile odir doctitle maybe_package modules = do
 
     ppReference :: Name -> [Module] -> Doc
     ppReference name [] = empty
-    ppReference name (mod:refs) = let modName = moduleString mod in 
-      text "<function name=\""<>text (escapeStr (getOccString name))<>text"\" link=\""<>text (nameHtmlRef modName name)<>text"\"/>" $$
+    ppReference name (mod:refs) =  
+      text "<function name=\""<>text (escapeStr (getOccString name))<>text"\" link=\""<>text (nameHtmlRef mod name)<>text"\"/>" $$
       ppReference name refs
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index e0c7121b..07d1dca8 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -37,6 +37,7 @@ import qualified Data.Map as Map hiding ( Map )
 import GHC 
 import Name
 import Module
+import PackageConfig ( stringToPackageId )
 import RdrName hiding ( Qual )
 import SrcLoc   
 import FastString ( unpackFS )
@@ -73,8 +74,8 @@ ppHtml doctitle maybe_package hmods odir prologue maybe_html_help_format
   when (not (isJust maybe_contents_url)) $ 
     ppHtmlContents odir doctitle maybe_package
         maybe_html_help_format maybe_index_url maybe_source_url maybe_wiki_url
-	[ hmod { hmod_package = Nothing } | hmod <- visible_hmods ]
-	-- we don't want to display the packages in a single-package contents
+	visible_hmods
+	False -- we don't want to display the packages in a single-package contents
 	prologue
 
   when (not (isJust maybe_index_url)) $ 
@@ -137,7 +138,8 @@ copyHtmlBits odir libdir maybe_css = do
 	css_destination = pathJoin [odir, cssFile]
 	copyLibFile f = do
 	   copyFile (pathJoin [libhtmldir, f]) (pathJoin [odir, f])
- 
+  print css_file 
+  print css_destination
   copyFile css_file css_destination
   mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile ]
 
@@ -167,7 +169,7 @@ spliceURL maybe_file maybe_mod maybe_name url = run url
   file = fromMaybe "" maybe_file
   mod = case maybe_mod of
           Nothing           -> ""
-          Just mod -> moduleString mod  
+          Just mod -> moduleString mod 
   
   (name, kind) =
     case maybe_name of
@@ -290,13 +292,13 @@ ppHtmlContents
    -> Maybe String
    -> SourceURLs
    -> WikiURLs
-   -> [HaddockModule] -> Maybe (GHC.HsDoc GHC.RdrName)
+   -> [HaddockModule] -> Bool -> Maybe (GHC.HsDoc GHC.RdrName)
    -> IO ()
 ppHtmlContents odir doctitle
   maybe_package maybe_html_help_format maybe_index_url
-  maybe_source_url maybe_wiki_url modules prologue = do
-  let tree = mkModuleTree 
-         [(hmod_mod mod, hmod_package mod, toDescription mod) | mod <- modules]
+  maybe_source_url maybe_wiki_url modules showPkgs prologue = do
+  let tree = mkModuleTree showPkgs
+         [(hmod_mod mod, toDescription mod) | mod <- modules]
       html = 
 	header 
 		(documentCharacterEncoding +++
@@ -365,12 +367,14 @@ mkNode ss (Node s leaf pkg short ts) depth id = htmlNode
 	Just doc -> tda [theclass "rdoc"] (origDocToHtml doc)
 
     htmlModule 
-      | leaf      = ppModule mdl
+      | leaf      = ppModule (mkModule (stringToPackageId pkgName) 
+                                       (mkModuleName mdl)) ""
       | otherwise = toHtml s
 
-    htmlPkg = case pkg of
-      Nothing -> td << empty
-      Just p  -> td << toHtml p
+    -- ehm.. TODO: change the ModuleTree type
+    (htmlPkg, pkgName) = case pkg of
+      Nothing -> (td << empty, "")
+      Just p  -> (td << toHtml p, p)
 
     mdl = foldr (++) "" (s' : map ('.':) ss')
     (s':ss') = reverse (s:ss)
@@ -540,7 +544,7 @@ ppHtmlModule odir doctitle
 	    hmodToHtml maybe_source_url maybe_wiki_url hmod </> s15 </>
 	    footer
          )
-  writeFile (pathJoin [odir, moduleHtmlFile mdl]) (renderHtml html)
+  writeFile (pathJoin [odir, moduleHtmlFile mod]) (renderHtml html)
 
 hmodToHtml :: SourceURLs -> WikiURLs -> HaddockModule -> HtmlTable
 hmodToHtml maybe_source_url maybe_wiki_url hmod
@@ -633,7 +637,7 @@ processExport summmary _ _ (ExportNoDecl2 _ y subs)
 processExport _ _ _ (ExportDoc2 doc)
   = docBox (docToHtml doc)
 processExport _ _ _ (ExportModule2 mod)
-  = declBox (toHtml "module" <+> ppModule (moduleString mod))
+  = declBox (toHtml "module" <+> ppModule mod "")
 
 forSummary :: (ExportItem2 DocName) -> Bool
 forSummary (ExportGroup2 _ _ _) = False
@@ -716,7 +720,7 @@ ppTyVars tvs = map ppName (tyvarNames tvs)
 tyvarNames = map f 
   where f x = let NoLink n = hsTyVarName (unLoc x) in n
   
-ppFor summary links loc mbDoc (ForeignImport lname ltype _ _)
+ppFor summary links loc mbDoc (ForeignImport lname ltype _)
   = ppSig summary links loc mbDoc (TypeSig lname ltype)
 ppFor _ _ _ _ _ = error "ppFor"
 
@@ -1104,18 +1108,16 @@ ppBinder False nm = linkTarget nm +++ bold << ppBinder' nm
 ppBinder' :: Name -> Html
 ppBinder' name = toHtml (getOccString name)
 
-linkId :: GHC.Module -> Maybe Name -> Html -> Html
+linkId :: Module -> Maybe Name -> Html -> Html
 linkId mod mbName = anchor ! [href hr]
   where 
     hr = case mbName of
-      Nothing   -> moduleHtmlFile modName
-      Just name -> nameHtmlRef modName name
-    modName = moduleString mod   
+      Nothing   -> moduleHtmlFile mod
+      Just name -> nameHtmlRef mod name
 
-ppModule :: String -> Html
-ppModule mdl = anchor ! [href ((moduleHtmlFile modname) ++ ref)] << toHtml mdl
-  where 
-        (modname,ref) = break (== '#') mdl
+ppModule :: Module -> String -> Html
+ppModule mod ref = anchor ! [href ((moduleHtmlFile mod) ++ ref)] 
+                   << toHtml (moduleString mod)
 
 -- -----------------------------------------------------------------------------
 -- * Doc Markup
@@ -1127,7 +1129,7 @@ parHtmlMarkup ppId = Markup {
   markupString        = toHtml,
   markupAppend        = (+++),
   markupIdentifier    = tt . ppId . head,
-  markupModule        = ppModule,
+  markupModule        = \m -> ppModule (mkModuleNoPkg m) "",
   markupEmphasis      = emphasize . toHtml,
   markupMonospaced    = tt . toHtml,
   markupUnorderedList = ulist . concatHtml . map (li <<),
diff --git a/src/HaddockModuleTree.hs b/src/HaddockModuleTree.hs
index ffc8b98e..e32cb960 100644
--- a/src/HaddockModuleTree.hs
+++ b/src/HaddockModuleTree.hs
@@ -1,15 +1,18 @@
 module HaddockModuleTree ( ModuleTree(..), mkModuleTree ) where
 
-import HaddockTypes ( DocName )
-import GHC          ( HsDoc, Name )
-import Module       ( Module, moduleString )
+import HaddockTypes  ( DocName )
+import GHC           ( HsDoc, Name )
+import Module        ( Module, moduleNameString, moduleName, modulePackageId )
+import PackageConfig ( packageIdString )
 
 data ModuleTree = Node String Bool (Maybe String) (Maybe (HsDoc Name)) [ModuleTree]
 
-mkModuleTree :: [(Module, Maybe String, Maybe (HsDoc Name))] -> [ModuleTree]
-mkModuleTree mods = 
-  foldr fn [] [ (splitModule mod, pkg, short) | (mod,pkg,short) <- mods ]
-  where 
+mkModuleTree :: Bool -> [(Module, Maybe (HsDoc Name))] -> [ModuleTree]
+mkModuleTree showPkgs mods = 
+  foldr fn [] [ (splitModule mod, modPkg mod, short) | (mod, short) <- mods ]
+  where
+    modPkg mod | showPkgs = Just (packageIdString (modulePackageId mod))
+               | otherwise = Nothing
     fn (mod,pkg,short) trees = addToTrees mod pkg short trees
 
 addToTrees :: [String] -> Maybe String -> Maybe (HsDoc Name) -> [ModuleTree] -> [ModuleTree]
@@ -29,7 +32,7 @@ mkSubTree [s]    pkg short = [Node s True pkg short []]
 mkSubTree (s:ss) pkg short = [Node s (null ss) Nothing Nothing (mkSubTree ss pkg short)]
 
 splitModule :: Module -> [String]
-splitModule mod = split (moduleString mod)
+splitModule mod = split (moduleNameString (moduleName mod))
   where split mod0 = case break (== '.') mod0 of
      			(s1, '.':s2) -> s1 : split s2
      			(s1, _)      -> [s1]
diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs
index 8f7698ac..65af08e8 100644
--- a/src/HaddockRename.hs
+++ b/src/HaddockRename.hs
@@ -294,12 +294,12 @@ renameSig sig = case sig of
       return (FixitySig lname' x)
 -}
 
-renameForD (ForeignImport lname ltype x y) = do
+renameForD (ForeignImport lname ltype x) = do
   ltype' <- renameLType ltype
-  return (ForeignImport (keepL lname) ltype' x y)
-renameForD (ForeignExport lname ltype x y) = do
+  return (ForeignImport (keepL lname) ltype' x)
+renameForD (ForeignExport lname ltype x) = do
   ltype' <- renameLType ltype
-  return (ForeignExport (keepL lname) ltype' x y)
+  return (ForeignExport (keepL lname) ltype' x)
 
 renameExportItem :: ExportItem2 Name -> RnM (ExportItem2 DocName)
 renameExportItem item = case item of 
diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs
index 5dace7b8..8eaf14b0 100644
--- a/src/HaddockTypes.hs
+++ b/src/HaddockTypes.hs
@@ -119,9 +119,7 @@ data HaddockModule = HM {
 
 -- | The instances exported by this module
 
-  hmod_instances          :: [Instance],
-
-  hmod_package            :: Maybe String
+  hmod_instances          :: [Instance]
 }
 
 data DocMarkup id a = Markup {
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index 185a4cb7..7fe6f796 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -20,6 +20,7 @@ module HaddockUtil (
 
   -- * Miscellaneous utilities
   getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,
+  moduleString, mkModuleNoPkg,
 
   -- * HTML cross reference mapping
   html_xrefs_ref,
@@ -41,6 +42,8 @@ import SrcLoc
 import Name
 import OccName
 import Binary
+import Module
+import PackageConfig ( stringToPackageId )
 
 import Control.Monad ( liftM, MonadPlus(..) )
 import Data.Char ( isAlpha, isSpace, toUpper, ord )
@@ -144,15 +147,16 @@ isPathSeparator ch =
   ch == '/'
 #endif
 
-moduleHtmlFile :: String -> FilePath
+moduleHtmlFile :: Module -> FilePath
 moduleHtmlFile mdl =
-  case Map.lookup (mkModule mdl) html_xrefs of
+  case Map.lookup mdl html_xrefs of
     Nothing  -> mdl' ++ ".html"
     Just fp0 -> pathJoin [fp0, mdl' ++ ".html"]
   where
-   mdl' = map (\c -> if c == '.' then '-' else c) mdl
+   mdl' = map (\c -> if c == '.' then '-' else c) 
+              (moduleNameString (moduleName mdl))
 
-nameHtmlRef :: String -> Name -> String	
+nameHtmlRef :: Module -> Name -> String	
 nameHtmlRef mdl str = moduleHtmlFile mdl ++ '#':escapeStr (anchorNameStr str)
 
 contentsHtmlFile, indexHtmlFile :: String
@@ -224,6 +228,12 @@ escapeStr = flip escapeString unreserved
 escapeStr = escapeURIString isUnreserved
 #endif
 
+moduleString :: Module -> String
+moduleString = moduleNameString . moduleName 
+
+mkModuleNoPkg :: String -> Module
+mkModuleNoPkg str = mkModule (stringToPackageId "") (mkModuleName str)
+
 -----------------------------------------------------------------------------
 -- HTML cross references
 
diff --git a/src/Main.hs b/src/Main.hs
index c0e9745f..44d18f25 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -22,7 +22,7 @@ import Control.Monad ( when, liftM )
 import Control.Monad.Writer ( Writer, runWriter, tell )
 import Data.Char ( isSpace )
 import Data.IORef ( writeIORef )
-import Data.List ( nub, (\\), foldl', sortBy, foldl1 )
+import Data.List ( nub, (\\), foldl', sortBy, foldl1, init, mapAccumL, find )
 import Data.Maybe ( isJust, isNothing, maybeToList, listToMaybe )
 --import Debug.Trace
 import System.Console.GetOpt ( getOpt, usageInfo, ArgOrder(..), OptDescr(..), ArgDescr(..) )
@@ -39,12 +39,13 @@ import Data.Maybe
 import Data.List ( nubBy )
 import Data.FunctorM ( fmapM )
 
-import GHC
+import qualified GHC ( init )
+import GHC hiding ( init )
 import Outputable
 import SrcLoc
 import qualified Digraph as Digraph
 import Name
-import Module ( moduleString, mkModule ) 
+import Module ( mkModule ) 
 import InstEnv
 import Class
 import TypeRep
@@ -54,28 +55,104 @@ import PrelNames
 import FastString
 #define FSLIT(x) (mkFastString# (x#))
 import DynFlags hiding ( Option )
+import StaticFlags ( parseStaticFlags )
 import Unique ( mkUnique )
 import Packages
 
 -----------------------------------------------------------------------------
 -- Top-level stuff
 
-type CheckedMods = [(Module, FullyCheckedMod, FilePath)]
+type CheckedMod = (Module, FullyCheckedMod, FilePath)
 
 main :: IO ()
 main = do
   args <- getArgs
   (libDir, rest) <- getLibDir args 
-  (session, ghcFlags, nonGHCOpts) <- startGHC libDir rest
-  (flags, args) <- parseHaddockOpts nonGHCOpts
-  handleEagerFlags flags
-  modules <- sortAndCheckModules session ghcFlags args
-  (ifaces, htmls) <- getIfacesAndHtmls flags ghcFlags  
+  let (isGHCMode, rest') = parseModeFlag rest
+  (session, dynflags) <- startGHC libDir
+
+  (dynflags', rest'') <- if isGHCMode 
+    then parseGHCFlags_GHCMode     dynflags rest'   
+    else parseGHCFlags_HaddockMode dynflags rest' 
+
+  (flags, fileArgs) <- parseHaddockOpts rest''
+
+  mbPkgName <- handleEagerFlags flags  
+  let dynflags'' = case mbPkgName of
+        Just name -> setPackageName name dynflags'
+        Nothing -> dynflags'
+
+  setSessionDynFlags session dynflags''
+ 
+  modules <- sortAndCheckModules session dynflags' fileArgs
+  (ifaces, htmls) <- getIfacesAndHtmls flags dynflags'
   let (modss, envs) = unzip ifaces
-  updateHTMLXRefs htmls modss
+  updateHTMLXRefs htmls modss 
   -- TODO: continue to break up the run function into parts
   run flags modules envs
 
+parseModeFlag :: [String] -> (Bool, [String])
+parseModeFlag ("--ghc-flags":rest) = (True, rest)
+parseModeFlag rest = (False, rest)
+
+parseGHCFlags_GHCMode :: DynFlags -> [String] -> IO (DynFlags, [String])
+parseGHCFlags_GHCMode dynflags args = do
+  (dynflags', rest) <- parseDynamicFlags dynflags args
+  rest' <- parseStaticFlags rest
+  return (dynflags', rest')
+
+parseGHCFlags_HaddockMode = parseGHCFlags
+
+parseGHCFlags :: DynFlags -> [String] -> IO (DynFlags, [String])
+parseGHCFlags dynflags args = case args of
+  [] -> return (dynflags, args)
+  ("-g":rest) -> worker rest 
+  (('-':'-':'g':'h':'c':'-':'f':'l':'a':'g':[]):rest) -> worker rest
+  (x:xs) -> do 
+    (flags, rest) <- parseGHCFlags dynflags xs
+    return (flags, x:rest)
+  where 
+    worker rest = do
+      (mbFlags, rest') <- parseGHCFlag dynflags rest
+      case mbFlags of 
+        Just flags -> parseGHCFlags flags rest'
+        Nothing -> parseGHCFlags dynflags rest'
+ 
+parseGHCFlag :: DynFlags -> [String] -> IO (Maybe DynFlags, [String])
+parseGHCFlag _ [] = die "No GHC flag supplied\n"
+parseGHCFlag dynflags args = do
+  mbDyn <- findDynamic
+  case mbDyn of 
+    Just (dynflags', rest) -> return (Just dynflags', rest)   
+    Nothing -> do
+      mbStat <- findStatic
+      case mbStat of
+        Just (_, rest) -> return (Nothing, rest)
+        Nothing -> die ("Not a GHC flag: " ++ (head args) ++ "\n")
+  where
+    findDynamic = findFlag (
+        \xs -> 
+        (do 
+           (fs, xs') <- parseDynamicFlags dynflags xs
+           if xs' /= xs then return (Just fs) else return Nothing
+        ) 
+        `catch` (\_ -> return Nothing) 
+      ) 
+    findStatic = findFlag (\xs -> do 
+      xs' <- parseStaticFlags xs
+      if xs /= xs' then return (Just ()) else return Nothing)
+
+    findFlag p = do 
+      xs <- (sequence . snd) (mapAccumL (f p) [] args)
+      case [ (x, index) | Just x <- xs | index <- [1..] ] of
+        ((x, index):_) -> return (Just (x, drop index args))
+        _ -> return Nothing
+
+    f :: ([String] -> IO a) -> [String] -> String -> ([String], IO a)
+    f parser previousArgs arg = 
+      let args' = previousArgs ++ [arg]
+      in (args', parser args')
+
 parseHaddockOpts :: [String] -> IO ([Flag], [String])
 parseHaddockOpts words =
   case getOpt Permute (options True) words of
@@ -92,23 +169,20 @@ getLibDir ("-B":dir:rest) = return (dir, rest)
 getLibDir (('-':'B':dir):rest) | not (null dir) = return (dir, rest)
 getLibDir _ = die "Missing GHC lib dir option: -B <dir>\n"
 
--- | Initialize GHC, parse the passed in strings and set the corresponding
--- GHC flags (if any). Also add the -haddock flag. Return the Session handle
--- and the strings that were not GHC flags.
-startGHC :: String -> [String] -> IO (Session, DynFlags, [String])
-startGHC libDir possibleOpts = do
+extractGHCFlags :: [Flag] -> [String]
+extractGHCFlags flags = [ flag | Flag_GHCFlag flag <- flags ]
+
+startGHC :: String -> IO (Session, DynFlags)
+startGHC libDir = do
   GHC.init (Just libDir)
   let ghcMode = JustTypecheck
   session <- newSession ghcMode
   flags   <- getSessionDynFlags session
   flags'  <- initPackages flags
-  (flags'', nonOpts) <- parseDynamicFlags flags' possibleOpts
-  let flags''' = dopt_set flags'' Opt_Haddock 
-  setSessionDynFlags session flags'''
-  return (session, flags''', nonOpts)
+  let flags'' = dopt_set flags' Opt_Haddock 
+  return (session, flags'')
 
-sortAndCheckModules :: Session -> DynFlags -> [FilePath] -> 
-                       IO [(Module, FullyCheckedMod, FilePath)]
+sortAndCheckModules :: Session -> DynFlags -> [FilePath] -> IO [CheckedMod]
 sortAndCheckModules session flags files = defaultErrorHandler flags $ do 
   targets <- mapM (\s -> guessTarget s Nothing) files
   setTargets session targets 
@@ -124,7 +198,7 @@ sortAndCheckModules session flags files = defaultErrorHandler flags $ do
                       modsum <- sortedModules, 
                       modSumFile modsum `elem` files ]
   checkedMods <- mapM (\(mod, file) -> do
-    mbMod <- checkModule session mod
+    mbMod <- checkModule session (moduleName mod)
     checkedMod <- case mbMod of 
       Just m  -> return m
       Nothing -> die ("Failed to load module: " ++ moduleString mod)
@@ -133,7 +207,7 @@ sortAndCheckModules session flags files = defaultErrorHandler flags $ do
   where
     ensureFullyChecked modules 
       | length modules' == length modules = return modules'
-      | otherwise = die "Fail to check all modules properly\n" 
+      | otherwise = die "Failed to check all modules properly\n" 
       where modules' = [ (mod, (a,b,c,d), f) | 
                          (mod, CheckedModule a (Just b) (Just c) (Just d), f) 
                          <- modules ] 
@@ -179,6 +253,7 @@ data Flag
   | Flag_IgnoreAllExports
   | Flag_HideModule String
   | Flag_UsePackage String
+  | Flag_GHCFlag String
   deriving (Eq)
 
 options :: Bool -> [OptDescr Flag]
@@ -244,32 +319,35 @@ options backwardsCompat =
     Option [] ["hide"] (ReqArg Flag_HideModule "MODULE")
 	"behave as if MODULE has the hide attribute",
     Option [] ["use-package"] (ReqArg Flag_UsePackage "PACKAGE")
-	"the modules being processed depend on PACKAGE"
+	"the modules being processed depend on PACKAGE",
+    Option ['g'] ["ghc-flag"] (ReqArg Flag_GHCFlag "FLAG")
+ 	"send a flag to the Glasgow Haskell Compiler"       
   ]
 
 handleEagerFlags flags = do
   whenFlag Flag_Help $ do
     prog <- getProgramName
     bye (usageInfo (usageHeader prog) (options False))
+
   whenFlag Flag_Version $
     bye ("Haddock version " ++ projectVersion ++ 
          ", (c) Simon Marlow 2003; port to GHC-api by David Waern 2006\n")
+
   when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags)
         && Flag_Html `elem` flags) $
     die ("-h cannot be used with --gen-index or --gen-contents")
+
+  return (listToMaybe [str | Flag_Package str <- flags])
   where 
     whenFlag flag action = when (flag `elem` flags) action 
 
-
-run :: [Flag] -> CheckedMods -> [Map Name Name] -> IO ()
+run :: [Flag] -> [CheckedMod] -> [Map Name Name] -> IO ()
 run flags modules extEnvs = do
   let
     title = case [str | Flag_Heading str <- flags] of
 		[] -> ""
 		(t:_) -> t
 
-    package = listToMaybe [str | Flag_Package str <- flags]
-
     maybe_source_urls = (listToMaybe [str | Flag_SourceBaseURL   str <- flags]
                         ,listToMaybe [str | Flag_SourceModuleURL str <- flags]
                         ,listToMaybe [str | Flag_SourceEntityURL str <- flags])
@@ -316,7 +394,7 @@ run flags modules extEnvs = do
   prologue <- getPrologue flags
 
   let 
-    (modMap, messages) = runWriter (pass1 modules flags package) 
+    (modMap, messages) = runWriter (pass1 modules flags) 
     haddockMods = catMaybes [ Map.lookup mod modMap | (mod,_,_) <- modules ]
     homeEnv = buildGlobalDocEnv haddockMods
     env = Map.unions (homeEnv:extEnvs)
@@ -326,25 +404,28 @@ run flags modules extEnvs = do
   mapM_ putStrLn messages
   mapM_ putStrLn messages'
 
-  let visibleMods = [ m | m <- haddockMods'', OptHide `notElem` (hmod_options m) ]
+  let 
+    visibleMods = [ m | m <- haddockMods'', OptHide `notElem` (hmod_options m) ]
+    packageName = (Just . packageIdString . modulePackageId . 
+                   hmod_mod . head) visibleMods
  
   when (Flag_GenIndex `elem` flags) $ do
-	ppHtmlIndex odir title package maybe_html_help_format
+	ppHtmlIndex odir title packageName maybe_html_help_format
                 maybe_contents_url maybe_source_urls maybe_wiki_urls
                 visibleMods
 	copyHtmlBits odir libdir css_file
         
   when (Flag_GenContents `elem` flags && Flag_GenIndex `elem` flags) $ do
-    ppHtmlHelpFiles title package visibleMods odir maybe_html_help_format []
+    ppHtmlHelpFiles title packageName visibleMods odir maybe_html_help_format []
 
   when (Flag_GenContents `elem` flags) $ do
-	ppHtmlContents odir title package maybe_html_help_format
+	ppHtmlContents odir title packageName maybe_html_help_format
 	               maybe_index_url maybe_source_urls maybe_wiki_urls
-	               visibleMods prologue
+	               visibleMods True prologue
 	copyHtmlBits odir libdir css_file
 
   when (Flag_Html `elem` flags) $ do
-    ppHtml title package visibleMods odir
+    ppHtml title packageName visibleMods odir
                 prologue maybe_html_help_format
                 maybe_source_urls maybe_wiki_urls
                 maybe_contents_url maybe_index_url
@@ -355,7 +436,7 @@ run flags modules extEnvs = do
   -- dump an interface if requested
   case dumpIface of
     Nothing -> return ()
-    Just fn -> dumpInterfaces env (map hmod_mod visibleMods) fn
+    Just fn -> dumpInterfaces env (map hmod_mod visibleMods) fn 
   where
     pprList [] = []
     pprList [x] = show x
@@ -383,10 +464,9 @@ type FullyCheckedMod = (ParsedSource,
 printEntity (DocEntity doc) = show doc
 printEntity (DeclEntity name) = show $ ppr name defaultUserStyle
 
-pass1 :: [(Module, FullyCheckedMod, FilePath)] -> [Flag] -> Maybe String -> ErrMsgM ModuleMap2
-pass1 modules flags package = worker modules (Map.empty) flags
+pass1 :: [CheckedMod] -> [Flag] -> ErrMsgM ModuleMap2
+pass1 modules flags = worker modules (Map.empty) flags
   where
-    worker :: [(Module, FullyCheckedMod, FilePath)] -> ModuleMap2 -> [Flag] -> ErrMsgM ModuleMap2
     worker [] moduleMap _ = return moduleMap
     worker ((mod, checked_mod, filename):rest_modules) moduleMap flags = do
  
@@ -405,7 +485,8 @@ pass1 modules flags package = worker modules (Map.empty) flags
           theseEntityNames = entityNames entities 
           subNames = allSubnamesInGroup group
           localNames = theseEntityNames ++ subNames
-          -- guaranteed to be Just, since the module has been compiled from scratch 
+          -- guaranteed to be Just, since the module has been compiled from 
+          -- scratch 
           scopeNames = fromJust $ modInfoTopLevelScope moduleInfo 
       
           subMap = mk_sub_map_from_group group
@@ -415,13 +496,17 @@ pass1 modules flags package = worker modules (Map.empty) flags
           docMap = mkDocMap group 
 
           ignoreAllExports = Flag_IgnoreAllExports `elem` flags
+  
+          packageId = modulePackageId mod
       
       theseVisibleNames <- visibleNames mod moduleMap localNames scopeNames 
-                                        subMap exports opts localDeclMap
+                                        subMap exports opts localDeclMap 
+                                        packageId
 
       exportItems <- mkExportItems moduleMap mod exportedNames
-                                   exportedDeclMap localDeclMap subMap entities opts  
-                                   exports ignoreAllExports docMap
+                                   exportedDeclMap localDeclMap subMap entities 
+                                   opts exports ignoreAllExports docMap 
+                                   packageId
 
      -- prune the export list to just those declarations that have
      -- documentation, if the 'prune' option is on.
@@ -447,8 +532,7 @@ pass1 modules flags package = worker modules (Map.empty) flags
             hmod_exports            = exportedNames,
             hmod_visible_exports    = theseVisibleNames, 
             hmod_exported_decl_map  = exportedDeclMap,
-            hmod_instances          = instances,
-            hmod_package            = package
+            hmod_instances          = instances
           }
 
           moduleMap' = Map.insert mod haddock_module moduleMap
@@ -493,7 +577,8 @@ mkDocMap group = Map.fromList (topDeclDocs ++ classMethDocs ++ recordFieldDocs)
 collectDocs :: [DocEntity Name] -> [(Name, HsDoc Name)]
 collectDocs entities = collect Nothing DocEmpty entities
 
-collect :: Maybe (DocEntity Name) -> HsDoc Name -> [DocEntity Name] -> [(Name, HsDoc Name)]
+collect :: Maybe (DocEntity Name) -> HsDoc Name -> [DocEntity Name] -> 
+           [(Name, HsDoc Name)]
 collect d doc_so_far [] =
    case d of
         Nothing -> []
@@ -592,8 +677,8 @@ getDeclFromGroup group name =
       _      -> Nothing
       where
         matching = [ for | for <- lfors, forName (unLoc for) == name ]
-        forName (ForeignExport n _ _ _) = unLoc n
-        forName (ForeignImport n _ _ _) = unLoc n
+        forName (ForeignExport n _ _) = unLoc n
+        forName (ForeignImport n _ _) = unLoc n
  
 parseIfaceOption :: String -> (FilePath,FilePath)
 parseIfaceOption s = 
@@ -613,9 +698,9 @@ getPrologue flags
 	[filename] -> do
 	   str <- readFile filename
 	   case parseHaddockComment str of
-		Left err -> dieMsg err
+		Left err -> die err
 		Right doc -> return (Just doc)
-	_otherwise -> dieMsg "multiple -p/--prologue options"
+	_otherwise -> die "multiple -p/--prologue options"
 
 -- -----------------------------------------------------------------------------
 -- Phase 2
@@ -675,10 +760,11 @@ mkExportItems
 	-> Maybe [IE Name]
 	-> Bool				-- --ignore-all-exports flag
         -> Map Name (HsDoc Name)
+        -> PackageId
 	-> ErrMsgM [ExportItem2 Name]
 
 mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_map entities
-              opts maybe_exps ignore_all_exports docMap
+              opts maybe_exps ignore_all_exports docMap packageId
   | isNothing maybe_exps || ignore_all_exports || OptIgnoreExports `elem` opts
     = everything_local_exported
   | Just specs <- maybe_exps = do 
@@ -692,7 +778,7 @@ mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_m
     lookupExport (IEThingAbs t)        = declWith t
     lookupExport (IEThingAll t)        = declWith t
     lookupExport (IEThingWith t cs)    = declWith t
-    lookupExport (IEModuleContents m)  = fullContentsOf m
+    lookupExport (IEModuleContents m)  = fullContentsOf (mkModule packageId m)
     lookupExport (IEGroup lev doc)     = return [ ExportGroup2 lev "" doc ]
     lookupExport (IEDoc doc)           = return [ ExportDoc2 doc ] 
     lookupExport (IEDocNamed str)
@@ -827,9 +913,10 @@ visibleNames :: Module
              -> Maybe [IE Name]
              -> [DocOption]
              -> Map Name (LHsDecl Name)
+             -> PackageId
              -> ErrMsgM [Name]
 
-visibleNames mdl modMap localNames scope subMap maybeExps opts declMap
+visibleNames mdl modMap localNames scope subMap maybeExps opts declMap packageId
   -- if no export list, just return all local names 
   | Nothing <- maybeExps         = return (filter hasDecl localNames)
   | OptIgnoreExports `elem` opts = return localNames
@@ -853,18 +940,22 @@ visibleNames mdl modMap localNames scope subMap maybeExps opts declMap
     IEThingWith t cs -> return (t : cs)
 	
     IEModuleContents m
-	| m == mdl -> return localNames 
-	| otherwise ->
-	  case Map.lookup m modMap of
+	| mkModule packageId m == mdl -> return localNames 
+	| otherwise -> let m' = mkModule packageId m in
+	  case Map.lookup m' modMap of
 	    Just mod
 		| OptHide `elem` hmod_options mod ->
 		    return (filter (`elem` scope) (hmod_exports mod))
 		| otherwise -> return []
 	    Nothing
-		-> tell ["Can not reexport a package module"] >> return []
-
+		-> tell (exportModuleMissingErr mdl m') >> return []
+  
     _ -> return []
 
+exportModuleMissingErr this mdl 
+  = ["Warning: in export list of " ++ show (moduleString this)
+	 ++ ": module not found: " ++ show (moduleString mdl)]
+
 -- for a given entity, find all the names it "owns" (ie. all the
 -- constructors and field names of a tycon, or all the methods of a
 -- class).
@@ -1046,9 +1137,12 @@ type ErrMsgM a = Writer [ErrMsg] a
 getPackageFiles :: DynFlags -> IO [(String, String)]
 getPackageFiles dynflags = do
   packages <- getExplicitPackagesAnd dynflags []
-  mbFiles <- mapM check packages
+  mbFiles <- mapM check (filter notRTS packages)
   return [ pair | Just pair <- mbFiles ]
   where
+    -- no better way to do this?
+    notRTS p = pkgName (package p) /= packageIdString rtsPackageId  
+
     check p = (do
       pair <- check' p
       return (Just pair)) `catch` (\e -> do  
@@ -1080,7 +1174,7 @@ getPackageFiles dynflags = do
 
 -- -----------------------------------------------------------------------------
 -- The interface file format
--- ehhm. this is a hack...
+-- ehhm. this is a temporary hack...
 
 thisFormatVersion :: FormatVersion
 thisFormatVersion = mkFormatVersion 3
@@ -1155,9 +1249,13 @@ instance Binary OccName where
     return (mkOccName (decodeNS ns) string)
 
 instance Binary Module where
-  put_ bh m = put_ bh (moduleString m)
-  get bh = do m <- get bh; return (mkModule m)
-
+  put_ bh m = do
+    put_ bh (moduleString m)
+    put_ bh ((packageIdString . modulePackageId) m)
+  get bh = do 
+    m <- get bh
+    p <- get bh
+    return (mkModule (stringToPackageId p) (mkModuleName m))
 {-
 thisFormatVersion :: FormatVersion
 thisFormatVersion = mkFormatVersion 2