diff --git a/CHANGES b/CHANGES
--- a/CHANGES
+++ b/CHANGES
@@ -1,6 +1,36 @@
+Changed in version 2.4.0:
+
+  * Add framed view of the HTML documentation
+
+  * Build with GHC 6.8.2 and 6.8.3 again
+
+  * Support images in documentation comments again
+
+  * Small improvements to the Hoogle output
+
+  * A few bugs has been fixed
+
+-----------------------------------------------------------------------------
+
+Changed in version 2.3.0:
+
+  * Support for GHC 6.10.1
+
+  * Slightly improved space usage
+
+  * Fix a bug that made hidden modules show up in the contents & index pages
+
+  * Fix a bug that made Haddock load modules twice
+
+  * Improvements to the Hoogle output
+
+-----------------------------------------------------------------------------
+
 Changed in version 2.2.2:
 
   * Relax version dependency on ghc-paths
+
+-----------------------------------------------------------------------------
 
 Changes in version 2.2.1:
 
diff --git a/doc/haddock.xml b/doc/haddock.xml
--- a/doc/haddock.xml
+++ b/doc/haddock.xml
@@ -16,7 +16,7 @@
       <holder>Simon Marlow</holder>
     </copyright>
     <abstract>
-      <para>This document describes Haddock version 2.2.2, a Haskell
+      <para>This document describes Haddock version 2.4.0, a Haskell
       documentation tool.</para>
     </abstract>
   </bookinfo>
@@ -219,6 +219,16 @@
 
     <para>The modules should <emphasis>not</emphasis> be mutually
     recursive, as Haddock don't like swimming in circles.</para>
+
+    <para>You must also specify an option for the output format.
+    Currently only the <option>-h</option> option for HTML and the
+    <option>--hoogle</option> option for outputting Hoogle data are
+    functional.</para>
+
+    <para>The packaging
+    tool <ulink url="http://www.haskell.org/ghc/docs/latest/html/Cabal/index.html">Cabal</ulink>
+    has Haddock support, and is often used instead of invoking Haddock
+    directly.</para>
 
     <para>The following options are available:</para>
 
diff --git a/haddock.cabal b/haddock.cabal
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -1,5 +1,5 @@
 name:                 haddock
-version:              2.2.2
+version:              2.4.0
 cabal-version:        >= 1.2
 license:              BSD3
 build-type:           Simple
@@ -56,24 +56,37 @@
 	html/haskell_icon.gif
 	html/minus.gif
 	html/plus.gif
-
+	html/frames.html
 
+flag in-ghc-tree
+  description: Are we in a GHC tree?
+  default: False
+  manual: True
 
 executable haddock
   build-depends:
     base,
     haskell98,
-    ghc == 6.8.2 || == 6.8.3,
-    ghc-paths,
+    ghc >= 6.8.2 && < 6.13,
     filepath,
     directory,
     pretty,
     containers,
     array
+
+  if flag(in-ghc-tree)
+    cpp-options: -DIN_GHC_TREE
+    extensions: ForeignFunctionInterface
+  else
+    build-depends: ghc-paths
+
+  if impl(ghc >= 6.9)
+    build-depends: Cabal >= 1.5
+
   main-is:              Main.hs
   hs-source-dirs:       src
   extensions:           CPP, PatternGuards, DeriveDataTypeable,
-                        PatternSignatures, MagicHash
+                        ScopedTypeVariables, MagicHash
   ghc-options:          -funbox-strict-fields -O2
 
   other-modules:
@@ -113,9 +126,16 @@
 library
   hs-source-dirs:       src
   extensions:           CPP, PatternGuards, DeriveDataTypeable,
-                        PatternSignatures, MagicHash
+                        ScopedTypeVariables, MagicHash
   exposed-modules:      Distribution.Haddock
   other-modules:
     Haddock.Types
     Haddock.InterfaceFile
     Haddock.Exception
+    Haddock.Utils
+  
+  -- Cabal doesn't define __GHC_PATCHLEVEL__
+  if impl(ghc == 6.8.3)
+    cpp-options: -D__GHC_PATCHLEVEL__=3
+  if impl(ghc == 6.8.2)
+    cpp-options: -D__GHC_PATCHLEVEL__=2
diff --git a/haddock.spec b/haddock.spec
--- a/haddock.spec
+++ b/haddock.spec
@@ -17,7 +17,7 @@
 # version label of your release tarball.
 
 %define name    haddock
-%define version 2.2.2
+%define version 2.4.0
 %define release 1
 
 Name:           %{name}
diff --git a/html/frames.html b/html/frames.html
new file mode 100644
--- /dev/null
+++ b/html/frames.html
@@ -0,0 +1,27 @@
+<html>
+<head>
+<script type="text/javascript"><!--
+/*
+
+  The synopsis frame needs to be updated using javascript, so we hide
+  it by default and only show it if javascript is enabled.
+
+  TODO: provide some means to disable it.
+*/
+function load() {
+  var d = document.getElementById("inner-fs");
+  d.rows = "50%,50%";
+}
+--></script>
+<frameset id="outer-fs" cols="25%,75%" onload="load()">
+  <frameset id="inner-fs" rows="100%,0%">
+
+    <frame src="index-frames.html" name="modules">
+    <frame src="" name="synopsis">
+
+  </frameset>
+  <frame src="index.html" name="main">
+
+</frameset>
+
+</html>
diff --git a/html/haddock-util.js b/html/haddock-util.js
--- a/html/haddock-util.js
+++ b/html/haddock-util.js
@@ -131,3 +131,9 @@
         return ""; // should never be reached
     }
 }
+
+function setSynopsis(filename) {
+    if (parent.window.synopsis) {
+      parent.window.synopsis.location = filename;
+    }
+}
diff --git a/html/haddock.css b/html/haddock.css
--- a/html/haddock.css
+++ b/html/haddock.css
@@ -4,6 +4,7 @@
   background-color: #ffffff;
   color: #000000;
   font-family: sans-serif;
+  padding: 0 0;
   } 
 
 A:link    { color: #0000e0; text-decoration: none }
@@ -264,4 +265,33 @@
 TD.botbar A:hover {
   background-color: #6060ff
   }
+
+/* --------- Mini Synopsis for Frame View --------- */
+
+.outer {
+  margin: 0 0;
+  padding: 0 0;
+}
+
+.mini-synopsis {
+  padding: 0.25em 0.25em;
+}
+
+.mini-synopsis H1 { font-size: 130%; }
+.mini-synopsis H2 { font-size: 110%; }
+.mini-synopsis H3 { font-size: 100%; }
+.mini-synopsis H1, .mini-synopsis H2, .mini-synopsis H3 {
+  margin-top: 0.5em;
+  margin-bottom: 0.25em;
+  padding: 0 0;
+}
+
+.mini-synopsis H1 { border-bottom: 1px solid #ccc; }
+
+.mini-topbar {
+  font-size: 130%;
+  background: #0077dd;
+  padding: 0.25em;
+}
+
 
diff --git a/src/Haddock/Backends/DevHelp.hs b/src/Haddock/Backends/DevHelp.hs
--- a/src/Haddock/Backends/DevHelp.hs
+++ b/src/Haddock/Backends/DevHelp.hs
@@ -7,12 +7,14 @@
 module Haddock.Backends.DevHelp (ppDevHelpFile) where
 
 import Haddock.ModuleTree
-import Haddock.Types
+import Haddock.Types hiding (Doc)
 import Haddock.Utils
 
-import Module        ( moduleName, moduleNameString, Module, mkModule, mkModuleName )
-import PackageConfig ( stringToPackageId )
+import Module
 import Name          ( Name, nameModule, getOccString, nameOccName )
+#if __GLASGOW_HASKELL__ < 609
+import PackageConfig (stringToPackageId)
+#endif
 
 import Data.Maybe    ( fromMaybe )
 import qualified Data.Map as Map
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -16,7 +16,7 @@
 import Haddock.GHC.Utils
 import Haddock.Types
 import Haddock.Utils
-import GHC hiding ((<.>))
+import GHC
 import SrcLoc
 import Outputable
 
@@ -33,10 +33,11 @@
          ,""]
 
 
-ppHoogle :: String -> String -> [Interface] -> FilePath -> IO ()
-ppHoogle package version ifaces odir = do
-    let filename = package <.> "txt"
+ppHoogle :: String -> String -> String -> Maybe (HsDoc RdrName) -> [Interface] -> FilePath -> IO ()
+ppHoogle package version synopsis prologue ifaces odir = do
+    let filename = package ++ ".txt"
         contents = prefix ++
+                   docWith (drop 2 $ dropWhile (/= ':') synopsis) prologue ++
                    ["@package " ++ package] ++
                    ["@version " ++ version | version /= ""] ++
                    concat [ppModule i | i <- ifaces, OptHide `notElem` ifaceOptions i]
@@ -46,15 +47,8 @@
 ppModule :: Interface -> [String]
 ppModule iface = "" : doc (ifaceDoc iface) ++
                  ["module " ++ moduleString (ifaceMod iface)] ++
-                 concatMap ppExport exported ++
+                 concatMap ppExport (ifaceExportItems iface) ++
                  concatMap ppInstance (ifaceInstances iface)
-    where
-        locals = Set.fromList $ ifaceLocals iface
-        exported = [i | i@(ExportDecl{expItemDecl=decl}) <- ifaceExportItems iface
-                      , isLocal (unLoc decl)]
-        isLocal decl
-          | Just name <- getMainDeclBinder decl = name `Set.member` locals
-          | otherwise = False
 
 
 ---------------------------------------------------------------------
@@ -79,7 +73,7 @@
 
 
 operator :: String -> String
-operator (x:xs) | not (isAlphaNum x) && x `notElem` " ([{" = "(" ++ x:xs ++ ")"
+operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = "(" ++ x:xs ++ ")"
 operator x = x
 
 
@@ -87,10 +81,11 @@
 -- How to print each export
 
 ppExport :: ExportItem Name -> [String]
-ppExport (ExportDecl decl dc _) = doc dc ++ f (unL decl)
+ppExport (ExportDecl decl dc _ _) = doc dc ++ f (unL decl)
     where
         f (TyClD d@TyData{}) = ppData d
         f (TyClD d@ClassDecl{}) = ppClass d
+        f (TyClD d@TySynonym{}) = ppSynonym d
         f (ForD (ForeignImport name typ _)) = ppSig $ TypeSig name typ
         f (ForD (ForeignExport name typ _)) = ppSig $ TypeSig name typ
         f (SigD sig) = ppSig sig
@@ -99,14 +94,22 @@
 
 
 ppSig :: Sig Name -> [String]
-ppSig (TypeSig name sig) = [operator (out name) ++ " :: " ++ out sig]
+ppSig (TypeSig name sig) = [operator (out name) ++ " :: " ++ out typ]
+    where
+        typ = case unL sig of
+                   HsForAllTy Explicit a b c -> HsForAllTy Implicit a b c
+                   x -> x
 ppSig _ = []
 
 
+ppSynonym :: TyClDecl Name -> [String]
+ppSynonym x = [out x]
+
+
 -- note: does not yet output documentation for class methods
 ppClass :: TyClDecl Name -> [String]
 ppClass x = out x{tcdSigs=[]} :
-            map (out . addContext . unL) (tcdSigs x)
+            concatMap (ppSig . addContext . unL) (tcdSigs x)
     where
         addContext (TypeSig name (L l sig)) = TypeSig name (L l $ f sig)
         f (HsForAllTy a b con d) = HsForAllTy a b (reL $ context : unL con) d
@@ -156,14 +159,20 @@
 ---------------------------------------------------------------------
 -- DOCUMENTATION
 
-ldoc :: Maybe (LHsDoc Name) -> [String]
+ldoc :: Outputable o => Maybe (LHsDoc o) -> [String]
 ldoc = doc . liftM unL
 
-doc :: Maybe (HsDoc Name) -> [String]
-doc Nothing = []
-doc (Just d) = "" : zipWith (++) ("-- | " : repeat "--   ") (showTags $ markup markupTag d)
+doc :: Outputable o => Maybe (HsDoc o) -> [String]
+doc = docWith ""
 
 
+docWith :: Outputable o => String -> Maybe (HsDoc o) -> [String]
+docWith [] Nothing = []
+docWith header d = ("":) $ zipWith (++) ("-- | " : repeat "--   ") $
+    [header | header /= ""] ++ ["" | header /= "" && isJust d] ++
+    maybe [] (showTags . markup markupTag) d
+
+
 data Tag = TagL Char [Tags] | TagP Tags | TagPre Tags | TagInline String Tags | Str String
            deriving Show
 
@@ -179,7 +188,7 @@
 -- or inlne for others (a,i,tt)
 -- entities (&,>,<) should always be appropriately escaped
 
-markupTag :: DocMarkup Name [Tag]
+markupTag :: Outputable o => DocMarkup o [Tag]
 markupTag = Markup {
   markupParagraph     = box TagP,
   markupEmpty         = str "",
@@ -189,9 +198,10 @@
   markupModule        = box (TagInline "a") . str,
   markupEmphasis      = box (TagInline "i"),
   markupMonospaced    = box (TagInline "tt"),
+  markupPic           = const $ str " ",
   markupUnorderedList = box (TagL 'u'),
   markupOrderedList   = box (TagL 'o'),
-  markupDefList       = box (TagL 'u') . map (\(a,b) -> TagInline "b" a : Str " " : b),
+  markupDefList       = box (TagL 'u') . map (\(a,b) -> TagInline "i" a : Str " " : b),
   markupCodeBlock     = box TagPre,
   markupURL           = box (TagInline "a") . str,
   markupAName         = const $ str ""
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -29,17 +29,23 @@
 import Control.Exception     ( bracket )
 import Control.Monad         ( when, unless )
 import Data.Char             ( isUpper, toUpper )
-import Data.List             ( sortBy )
+import Data.List             ( sortBy, groupBy )
 import Data.Maybe
 import Foreign.Marshal.Alloc ( allocaBytes )
 import System.IO             ( IOMode(..), hClose, hGetBuf, hPutBuf, openFile )
 import Data.Map              ( Map )
 import qualified Data.Map as Map hiding ( Map )
+import Data.Function
+import Data.Ord              ( comparing )
 
+#if __GLASGOW_HASKELL__ >= 609
+import GHC hiding ( NoLink, moduleInfo )
+#else
 import GHC hiding ( NoLink )
+#endif
 import Name
 import Module
-import PackageConfig         ( stringToPackageId )
+import PackageConfig
 import RdrName hiding ( Qual )
 import SrcLoc   
 import FastString            ( unpackFS )
@@ -72,7 +78,6 @@
   let
 	visible_ifaces = filter visible ifaces
 	visible i = OptHide `notElem` ifaceOptions i
-
   when (not (isJust maybe_contents_url)) $ 
     ppHtmlContents odir doctitle maybe_package
         maybe_html_help_format maybe_index_url maybe_source_url maybe_wiki_url
@@ -142,7 +147,7 @@
 	copyLibFile f = do
 	   copyFile (pathJoin [libhtmldir, f]) (pathJoin [odir, f])
   copyFile css_file css_destination
-  mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile ]
+  mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile, framesFile ]
 
 footer :: HtmlTable
 footer = 
@@ -327,6 +332,9 @@
 	    footer
 	  )
   writeFile (pathJoin [odir, contentsHtmlFile]) (renderHtml html)
+
+  -- XXX: think of a better place for this?
+  ppHtmlContentsFrame odir doctitle ifaces
   
   -- Generate contents page for Html Help if requested
   case maybe_html_help_format of
@@ -406,9 +414,40 @@
         (u,id') = mkNode (s:ss) x (depth+1) id
 
 -- The URL for source and wiki links, and the current module
-type LinksInfo = (SourceURLs, WikiURLs, Interface)
+type LinksInfo = (SourceURLs, WikiURLs)
 
+-- | Turn a module tree into a flat list of full module names.  E.g.,
+-- @
+--  A
+--  +-B
+--  +-C
+-- @
+-- becomes
+-- @["A", "A.B", "A.B.C"]@
+flatModuleTree :: [InstalledInterface] -> [Html]
+flatModuleTree ifaces =
+    map (uncurry ppModule' . head)
+            . groupBy ((==) `on` fst)
+            . sortBy (comparing fst)
+            $ mods
+  where
+    mods = [ (moduleString mod, mod) | mod <- map instMod ifaces ]
+    ppModule' txt mod =
+      anchor ! [href ((moduleHtmlFile mod)), target mainFrameName]
+        << toHtml txt
 
+ppHtmlContentsFrame odir doctitle ifaces = do
+  let mods = flatModuleTree ifaces
+      html =
+        header
+            (documentCharacterEncoding +++
+	     thetitle (toHtml doctitle) +++
+	     styleSheet +++
+	     (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
+        body << vanillaTable << p << (
+            foldr (+++) noHtml (map (+++br) mods))
+  writeFile (pathJoin [odir, frameIndexHtmlFile]) (renderHtml html)
+
 -- ---------------------------------------------------------------------------
 -- Generate the index
 
@@ -530,7 +569,12 @@
 	header (documentCharacterEncoding +++
 		thetitle (toHtml mdl) +++
 		styleSheet +++
-		(script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
+		(script ! [src jsFile, thetype "text/javascript"] $ noHtml) +++
+                (script ! [thetype "text/javascript"]
+                     -- XXX: quoting errors possible?
+                     << Html [HtmlString ("window.onload = function () {setSynopsis(\"mini_" 
+                                ++ moduleHtmlFile mod ++ "\")};")])
+               ) +++
         body << vanillaTable << (
 	    pageHeader mdl iface doctitle
 		maybe_source_url maybe_wiki_url
@@ -539,7 +583,22 @@
 	    footer
          )
   writeFile (pathJoin [odir, moduleHtmlFile mod]) (renderHtml html)
+  ppHtmlModuleMiniSynopsis odir doctitle iface
 
+ppHtmlModuleMiniSynopsis :: FilePath -> String -> Interface -> IO ()
+ppHtmlModuleMiniSynopsis odir _doctitle iface = do
+  let mod = ifaceMod iface
+      html =
+        header
+          (documentCharacterEncoding +++
+	   thetitle (toHtml $ moduleString mod) +++
+	   styleSheet +++
+	   (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
+        body << thediv ! [ theclass "outer" ] << (
+           (thediv ! [theclass "mini-topbar"]
+             << toHtml (moduleString mod)) +++
+           miniSynopsis mod iface)
+  writeFile (pathJoin [odir, "mini_" ++ moduleHtmlFile mod]) (renderHtml html)
 
 ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> HtmlTable
 ifaceToHtml maybe_source_url maybe_wiki_url iface
@@ -549,7 +608,7 @@
  
     exports = numberSectionHeadings (ifaceRnExportItems iface)
 
-    has_doc (ExportDecl _ doc _) = isJust doc
+    has_doc (ExportDecl _ doc _ _) = isJust doc
     has_doc (ExportNoDecl _ _ _) = False
     has_doc (ExportModule _) = False
     has_doc _ = True
@@ -586,9 +645,55 @@
           _ -> tda [ theclass "section1" ] << toHtml "Documentation"
 
     bdy  = map (processExport False linksInfo docMap) exports
-    linksInfo = (maybe_source_url, maybe_wiki_url, iface)
+    linksInfo = (maybe_source_url, maybe_wiki_url)
 
+miniSynopsis :: Module -> Interface -> Html
+miniSynopsis mod iface =
+    thediv ! [ theclass "mini-synopsis" ]
+      << hsep (map (processForMiniSynopsis mod) $ exports)
 
+  where
+    exports = numberSectionHeadings (ifaceRnExportItems iface)
+
+processForMiniSynopsis :: Module -> ExportItem DocName -> Html
+processForMiniSynopsis mod (ExportDecl (L _loc decl0) _doc _ _insts) =
+  thediv ! [theclass "decl" ] <<
+  case decl0 of
+    TyClD d@(TyFamily{}) -> ppTyFamHeader True False d
+    TyClD d@(TyData{tcdTyPats = ps})
+      | Nothing <- ps    -> keyword "data" <++> ppTyClBinderWithVarsMini mod d
+      | Just _ <- ps     -> keyword "data" <++> keyword "instance"
+                                           <++> ppTyClBinderWithVarsMini mod d
+    TyClD d@(TySynonym{tcdTyPats = ps})
+      | Nothing <- ps    -> keyword "type" <++> ppTyClBinderWithVarsMini mod d
+      | Just _ <- ps     -> keyword "type" <++> keyword "instance"
+                                           <++> ppTyClBinderWithVarsMini mod d
+    TyClD d@(ClassDecl {}) ->
+                            keyword "class" <++> ppTyClBinderWithVarsMini mod d
+    SigD (TypeSig (L _ n) (L _ t)) ->
+        let nm = docNameOcc n
+        in ppNameMini mod nm
+    _ -> noHtml
+processForMiniSynopsis mod (ExportGroup lvl _id txt) =
+  let heading | lvl == 1 = h1
+              | lvl == 2 = h2
+              | lvl >= 3 = h3
+  in heading << docToHtml txt
+processForMiniSynopsis _ _ = noHtml
+
+ppNameMini :: Module -> OccName -> Html
+ppNameMini mod nm =
+    anchor ! [ href ( moduleHtmlFile mod ++ "#"
+                      ++ (escapeStr (anchorNameStr nm)))
+             , target mainFrameName ]
+      << ppBinder' nm
+
+ppTyClBinderWithVarsMini :: Module -> TyClDecl DocName -> Html
+ppTyClBinderWithVarsMini mod decl =
+  let n = unLoc $ tcdLName decl
+      ns = tyvarNames $ tcdTyVars decl
+  in ppTypeApp n ns (ppNameMini mod . docNameOcc) ppTyName
+
 ppModuleContents :: [ExportItem DocName] -> Maybe HtmlTable
 ppModuleContents exports
   | length sections == 0 = Nothing
@@ -626,8 +731,8 @@
 processExport :: Bool -> LinksInfo -> DocMap -> (ExportItem DocName) -> HtmlTable
 processExport _ _ _ (ExportGroup lev id0 doc)
   = ppDocGroup lev (namedAnchor id0 << docToHtml doc)
-processExport summary links docMap (ExportDecl decl doc insts)
-  = ppDecl summary links decl doc insts docMap
+processExport summary links docMap (ExportDecl decl doc subdocs insts)
+  = ppDecl summary links decl doc insts docMap subdocs
 processExport summmary _ _ (ExportNoDecl _ y [])
   = declBox (ppDocName y)
 processExport summmary _ _ (ExportNoDecl _ y subs)
@@ -649,16 +754,17 @@
   | lev == 3  = tda [ theclass "section3" ] << doc
   | otherwise = tda [ theclass "section4" ] << doc
 
-declWithDoc :: Bool -> LinksInfo -> SrcSpan -> Name -> Maybe (HsDoc DocName) -> Html -> HtmlTable
+declWithDoc :: Bool -> LinksInfo -> SrcSpan -> DocName -> Maybe (HsDoc DocName) -> Html -> HtmlTable
 declWithDoc True  _     _   _  _          html_decl = declBox html_decl
 declWithDoc False links loc nm Nothing    html_decl = topDeclBox links loc nm html_decl
 declWithDoc False links loc nm (Just doc) html_decl = 
 		topDeclBox links loc nm html_decl </> docBox (docToHtml doc)
 
 
+-- TODO: use DeclInfo DocName or something
 ppDecl :: Bool -> LinksInfo -> LHsDecl DocName -> 
-          Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> HtmlTable
-ppDecl summ links (L loc decl) mbDoc instances docMap = case decl of
+          Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> [(DocName, HsDoc DocName)] -> HtmlTable
+ppDecl summ links (L loc decl) mbDoc instances docMap subdocs = case decl of
   TyClD d@(TyFamily {})          -> ppTyFam summ False links loc mbDoc d
   TyClD d@(TyData {})
     | Nothing <- tcdTyPats d     -> ppDataDecl summ links instances loc mbDoc d
@@ -666,24 +772,24 @@
   TyClD d@(TySynonym {})
     | Nothing <- tcdTyPats d     -> ppTySyn summ links loc mbDoc d
     | Just _  <- tcdTyPats d     -> ppTyInst summ False links loc mbDoc d
-  TyClD d@(ClassDecl {})         -> ppClassDecl summ links instances loc mbDoc docMap d
-  SigD (TypeSig (L _ n) (L _ t)) -> ppFunSig summ links loc mbDoc (docNameOrig n) t
+  TyClD d@(ClassDecl {})         -> ppClassDecl summ links instances loc mbDoc docMap subdocs d
+  SigD (TypeSig (L _ n) (L _ t)) -> ppFunSig summ links loc mbDoc n t
   ForD d                         -> ppFor summ links loc mbDoc d
   InstD d                        -> Html.emptyTable
 
 ppFunSig :: Bool -> LinksInfo -> SrcSpan -> Maybe (HsDoc DocName) ->
-            Name -> HsType DocName -> HtmlTable
-ppFunSig summary links loc mbDoc name typ =
-  ppTypeOrFunSig summary links loc name typ mbDoc 
-    (ppTypeSig summary (nameOccName name) typ, 
-     ppBinder False (nameOccName name), dcolon)
-
+            DocName -> HsType DocName -> HtmlTable
+ppFunSig summary links loc mbDoc docname typ =
+  ppTypeOrFunSig summary links loc docname typ mbDoc 
+    (ppTypeSig summary occname typ, ppBinder False occname, dcolon)
+  where
+    occname = nameOccName . docNameOrig $ docname
 
-ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> Name -> HsType DocName ->
+ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> DocName -> HsType DocName ->
                   Maybe (HsDoc DocName) -> (Html, Html, Html) -> HtmlTable
-ppTypeOrFunSig summary links loc name typ doc (pref1, pref2, sep)
-  | summary || noArgDocs typ = declWithDoc summary links loc name doc pref1
-  | otherwise = topDeclBox links loc name pref2 </>
+ppTypeOrFunSig summary links loc docname typ doc (pref1, pref2, sep)
+  | summary || noArgDocs typ = declWithDoc summary links loc docname doc pref1
+  | otherwise = topDeclBox links loc docname pref2 </>
     (tda [theclass "body"] << vanillaTable <<  (
       do_args sep typ </>
         (case doc of
@@ -728,17 +834,16 @@
   where f x = docNameOrig . hsTyVarName . unLoc $ x
   
 ppFor summary links loc mbDoc (ForeignImport (L _ name) (L _ typ) _)
-  = ppFunSig summary links loc mbDoc (docNameOrig name) typ
+  = ppFunSig summary links loc mbDoc name typ
 ppFor _ _ _ _ _ = error "ppFor"
 
 -- we skip type patterns for now
 ppTySyn summary links loc mbDoc (TySynonym (L _ name) ltyvars _ ltype) 
-  = ppTypeOrFunSig summary links loc n (unLoc ltype) mbDoc 
+  = ppTypeOrFunSig summary links loc name (unLoc ltype) mbDoc 
                    (full, hdr, spaceHtml +++ equals)
   where
     hdr  = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars ltyvars)
     full = hdr <+> equals <+> ppLType ltype
-    n    = docNameOrig name
     occ  = docNameOcc name
 
 
@@ -782,7 +887,7 @@
               TyClDecl DocName -> HtmlTable
 ppTyFam summary associated links loc mbDoc decl
   
-  | summary = declWithDoc summary links loc name mbDoc 
+  | summary = declWithDoc summary links loc docname mbDoc 
               (ppTyFamHeader True associated decl)
   
   | associated, isJust mbDoc         = header </> bodyBox << doc 
@@ -793,13 +898,13 @@
   | otherwise                        = header </> bodyBox << instancesBit
 
   where
-    name = docNameOrig . tcdName $ decl
+    docname = tcdName decl
 
-    header = topDeclBox links loc name (ppTyFamHeader summary associated decl)
+    header = topDeclBox links loc docname (ppTyFamHeader summary associated decl)
 
     doc = ndocBox . docToHtml . fromJust $ mbDoc 
 
-    instId = collapseId name
+    instId = collapseId (docNameOrig docname)
 
     instancesBit = instHdr instId </>
   	  tda [theclass "body"] << 
@@ -838,16 +943,16 @@
             TyClDecl DocName -> HtmlTable
 ppTyInst summary associated links loc mbDoc decl
   
-  | summary = declWithDoc summary links loc name mbDoc
+  | summary = declWithDoc summary links loc docname mbDoc
               (ppTyInstHeader True associated decl)
   
   | isJust mbDoc = header </> bodyBox << doc 
   | otherwise    = header
 
   where
-    name = docNameOrig . tcdName $ decl
+    docname = tcdName decl
 
-    header = topDeclBox links loc name (ppTyInstHeader summary associated decl)
+    header = topDeclBox links loc docname (ppTyInstHeader summary associated decl)
 
     doc = case mbDoc of
       Just d -> ndocBox (docToHtml d)
@@ -869,13 +974,11 @@
 --------------------------------------------------------------------------------
     
 
-ppAssocType :: Bool -> LinksInfo -> DocMap -> LTyClDecl DocName -> HtmlTable
-ppAssocType summ links docMap (L loc decl) = 
+ppAssocType :: Bool -> LinksInfo -> Maybe (HsDoc DocName) -> LTyClDecl DocName -> HtmlTable
+ppAssocType summ links doc (L loc decl) = 
   case decl of
     TyFamily  {} -> ppTyFam summ True links loc doc decl
     TySynonym {} -> ppTySyn summ links loc doc decl
-  where
-    doc = Map.lookup (docNameOrig $ tcdName decl) docMap
 
 
 --------------------------------------------------------------------------------
@@ -967,8 +1070,8 @@
 	fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> toHtml "->" <+>
 			       hsep (map ppDocName vars2)
 
-ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> DocMap -> HtmlTable
-ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc docMap = 
+ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> [(DocName, HsDoc DocName)] -> HtmlTable
+ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc subdocs = 
   if null sigs && null ats
     then (if summary then declBox else topDeclBox links loc nm) hdr
     else (if summary then declBox else topDeclBox links loc nm) (hdr <+> keyword "where")
@@ -977,33 +1080,33 @@
 				bodyBox <<
 					aboves
 					(
-						map (ppAssocType summary links docMap) ats ++
-
-						[ ppFunSig summary links loc mbDoc n typ
-						| L _ (TypeSig (L _ fname) (L _ typ)) <- sigs
-						, let n = docNameOrig fname, let mbDoc = Map.lookup n docMap ] 
+						[ ppAssocType summary links doc at | at <- ats
+                                                , let doc = lookup (tcdName $ unL at) subdocs ]  ++
 
+						[ ppFunSig summary links loc doc n typ
+						| L _ (TypeSig (L _ n) (L _ typ)) <- sigs
+						, let doc = lookup n subdocs ] 
 					)
 				)
   where
     hdr = ppClassHdr summary lctxt (unLoc lname) tvs fds
-    nm  = docNameOrig . unLoc $ lname
+    nm  = unLoc lname
     
 
 
 ppClassDecl :: Bool -> LinksInfo -> [InstHead DocName] -> SrcSpan ->
-               Maybe (HsDoc DocName) -> DocMap -> TyClDecl DocName -> 
+               Maybe (HsDoc DocName) -> DocMap -> [(DocName, HsDoc DocName)] -> TyClDecl DocName -> 
                HtmlTable
-ppClassDecl summary links instances loc mbDoc docMap
+ppClassDecl summary links instances loc mbDoc docMap subdocs
 	decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _)
-  | summary = ppShortClassDecl summary links decl loc docMap
+  | summary = ppShortClassDecl summary links decl loc subdocs
   | otherwise = classheader </> bodyBox << (classdoc </> body </> instancesBit)
   where 
     classheader
       | null lsigs = topDeclBox links loc nm hdr
       | otherwise  = topDeclBox links loc nm (hdr <+> keyword "where")
 
-    nm   = docNameOrig . unLoc $ tcdLName decl
+    nm   = unLoc $ tcdLName decl
     ctxt = unLoc lctxt
 
     hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
@@ -1019,13 +1122,14 @@
                     s8 </> methHdr </> bodyBox << methodTable 
  
     methodTable =
-      abovesSep s8 [ ppFunSig summary links loc doc (docNameOrig n) typ
+      abovesSep s8 [ ppFunSig summary links loc doc n typ
                    | L _ (TypeSig (L _ n) (L _ typ)) <- lsigs
-                   , let doc = Map.lookup (docNameOrig n) docMap ]
+                   , let doc = lookup n subdocs ]
 
-    atTable = abovesSep s8 $ map (ppAssocType summary links docMap) ats
+    atTable = abovesSep s8 $ [ ppAssocType summary links doc at | at <- ats
+                             , let doc = lookup (tcdName $ unL at) subdocs ]
 
-    instId = collapseId nm
+    instId = collapseId (docNameOrig nm)
     instancesBit
       | null instances = Html.emptyTable
       | otherwise 
@@ -1070,14 +1174,14 @@
   
   where
     dataHeader = 
-      (if summary then declBox else topDeclBox links loc name)
+      (if summary then declBox else topDeclBox links loc docname)
       ((ppDataHeader summary dataDecl) <+> 
       case resTy of ResTyGADT _ -> keyword "where"; _ -> empty)
 
     doConstr c con = declBox (toHtml [c] <+> ppShortConstr summary (unLoc con))
     doGADTConstr con = declBox (ppShortConstr summary (unLoc con))
 
-    name      = docNameOrig . unLoc . tcdLName $ dataDecl
+    docname   = unLoc . tcdLName $ dataDecl
     context   = unLoc (tcdCtxt dataDecl)
     newOrData = tcdND dataDecl
     tyVars    = tyvarNames (tcdTyVars dataDecl)
@@ -1089,7 +1193,7 @@
               SrcSpan -> Maybe (HsDoc DocName) -> TyClDecl DocName -> HtmlTable
 ppDataDecl summary links instances loc mbDoc dataDecl
   
-  | summary = declWithDoc summary links loc name mbDoc 
+  | summary = declWithDoc summary links loc docname mbDoc 
               (ppShortDataDecl summary links loc mbDoc dataDecl)
   
   | otherwise
@@ -1102,7 +1206,7 @@
 
 
   where
-    name      = docNameOrig . unLoc . tcdLName $ dataDecl
+    docname   = unLoc . tcdLName $ dataDecl
     context   = unLoc (tcdCtxt dataDecl)
     newOrData = tcdND dataDecl
     tyVars    = tyvarNames (tcdTyVars dataDecl)
@@ -1110,7 +1214,7 @@
     cons      = tcdCons dataDecl
     resTy     = (con_res . unLoc . head) cons 
       
-    header = topDeclBox links loc name (ppDataHeader summary dataDecl
+    header = topDeclBox links loc docname (ppDataHeader summary dataDecl
              <+> whereBit)
 
     whereBit 
@@ -1134,7 +1238,7 @@
 	  aboves (map ppSideBySideConstr cons)
         )
 
-    instId = collapseId name
+    instId = collapseId (docNameOrig docname)
 
     instancesBit
       | null instances = Html.emptyTable
@@ -1492,6 +1596,7 @@
   markupEmphasis      = emphasize . toHtml,
   markupMonospaced    = tt . toHtml,
   markupUnorderedList = ulist . concatHtml . map (li <<),
+  markupPic           = \path -> image ! [src path],
   markupOrderedList   = olist . concatHtml . map (li <<),
   markupDefList       = dlist . concatHtml . map markupDef,
   markupCodeBlock     = pre,
@@ -1538,10 +1643,13 @@
 hsep [] = noHtml
 hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls
 
-infixr 8 <+>
+infixr 8 <+>, <++>
 (<+>) :: Html -> Html -> Html
 a <+> b = Html (getHtmlElements (toHtml a) ++ HtmlString " ": getHtmlElements (toHtml b))
 
+(<++>) :: Html -> Html -> Html
+a <++> b = a +++ spaceHtml +++ b
+
 keyword :: String -> Html
 keyword s = thespan ! [theclass "keyword"] << toHtml s
 
@@ -1600,9 +1708,9 @@
 
 -- a box for top level documented names
 -- it adds a source and wiki link at the right hand side of the box
-topDeclBox :: LinksInfo -> SrcSpan -> Name -> Html -> HtmlTable
-topDeclBox ((_,_,Nothing), (_,_,Nothing), _) _ _ html = declBox html
-topDeclBox ((_,_,maybe_source_url), (_,_,maybe_wiki_url), iface)
+topDeclBox :: LinksInfo -> SrcSpan -> DocName -> Html -> HtmlTable
+topDeclBox ((_,_,Nothing), (_,_,Nothing)) _ _ html = declBox html
+topDeclBox ((_,_,maybe_source_url), (_,_,maybe_wiki_url))
            loc name html =
   tda [theclass "topdecl"] <<
   (        table ! [theclass "declbar"] <<
@@ -1615,26 +1723,26 @@
             Nothing  -> Html.emptyTable
             Just url -> tda [theclass "declbut"] <<
                           let url' = spliceURL (Just fname) (Just origMod)
-                                               (Just name) (Just loc) url
+                                               (Just n) (Just loc) url
                            in anchor ! [href url'] << toHtml "Source"
 
-        -- for source links, we want to point to the original module,
-        -- because only that will have the source.
-        origMod = case Map.lookup (nameOccName name) (ifaceEnv iface) of
-          Just n -> case nameModule_maybe n of
-            Just m -> m
-            Nothing -> mod
-          _ -> error "This shouldn't happen (topDeclBox)"
-
         wikiLink =
           case maybe_wiki_url of
             Nothing  -> Html.emptyTable
             Just url -> tda [theclass "declbut"] <<
                           let url' = spliceURL (Just fname) (Just mod)
-                                               (Just name) (Just loc) url
+                                               (Just n) (Just loc) url
                            in anchor ! [href url'] << toHtml "Comments"
   
-        mod = ifaceMod iface
+        -- For source links, we want to point to the original module,
+        -- because only that will have the source.  
+        -- TODO: do something about type instances. They will point to
+        -- the module defining the type family, which is wrong.
+        origMod = nameModule n
+
+        -- Name must be documented, otherwise we wouldn't get here
+        Documented n mod = name
+
         fname = unpackFS (srcSpanFile loc)
 
 
diff --git a/src/Haddock/DocName.hs b/src/Haddock/DocName.hs
--- a/src/Haddock/DocName.hs
+++ b/src/Haddock/DocName.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_HADDOCK hide #-}
+
 --
 -- Haddock - A Haskell Documentation Tool
 --
@@ -5,22 +7,16 @@
 --
 
 
-{-# OPTIONS_HADDOCK hide #-}
-
-
 module Haddock.DocName where
 
 
-import Haddock.GHC.Utils
-
 import GHC
-import OccName
 import Name
 import Binary
-import Outputable
 
 
 data DocName = Documented Name Module | Undocumented Name
+  deriving Eq
 
 
 docNameOcc :: DocName -> OccName
@@ -33,10 +29,10 @@
 
 
 instance Binary DocName where
-  put_ bh (Documented name mod) = do
+  put_ bh (Documented name modu) = do
     putByte bh 0
     put_ bh name
-    put_ bh mod
+    put_ bh modu
   put_ bh (Undocumented name) = do
     putByte bh 1
     put_ bh name
@@ -46,8 +42,9 @@
     case h of
       0 -> do
         name <- get bh
-        mod  <- get bh
-        return (Documented name mod)
+        modu <- get bh
+        return (Documented name modu)
       1 -> do
         name <- get bh
         return (Undocumented name)
+      _ -> error "get DocName: Bad h"
diff --git a/src/Haddock/Exception.hs b/src/Haddock/Exception.hs
--- a/src/Haddock/Exception.hs
+++ b/src/Haddock/Exception.hs
@@ -19,8 +19,16 @@
 
 
 data HaddockException = HaddockException String deriving Typeable
-throwE str = throwDyn (HaddockException str)
 
 
 instance Show HaddockException where
   show (HaddockException str) = str
+
+
+throwE :: String -> a
+#if __GLASGOW_HASKELL__ >= 609
+instance Exception HaddockException
+throwE str = throw (HaddockException str)
+#else
+throwE str = throwDyn (HaddockException str)
+#endif
diff --git a/src/Haddock/GHC.hs b/src/Haddock/GHC.hs
--- a/src/Haddock/GHC.hs
+++ b/src/Haddock/GHC.hs
@@ -7,7 +7,6 @@
 
 module Haddock.GHC (
   startGhc,
-  loadPackages,
   module Haddock.GHC.Typecheck,
   module Haddock.GHC.Utils
 ) where
@@ -26,24 +25,40 @@
 import DynFlags hiding (Option)
 import Packages hiding (package)
 import StaticFlags
+import SrcLoc
 
 
 -- | Start a GHC session with the -haddock flag set. Also turn off 
 -- compilation and linking.  
+#if __GLASGOW_HASKELL__ >= 609 
+startGhc :: String -> [String] -> (DynFlags -> Ghc a) -> IO a
+startGhc libDir flags ghcActs = do
+  -- TODO: handle warnings?
+  (restFlags, _) <- parseStaticFlags (map noLoc flags)
+  runGhc (Just libDir) $ do
+    dynflags  <- getSessionDynFlags
+#else
 startGhc :: String -> [String] -> IO (Session, DynFlags)
 startGhc libDir flags = do
   restFlags <- parseStaticFlags flags
-  session   <- newSession (Just libDir)
-  dynflags  <- getSessionDynFlags session
-  let dynflags' = dopt_set dynflags Opt_Haddock
-  let dynflags'' = dynflags' {
-      hscTarget = HscAsm,
-      ghcMode   = CompManager,
-      ghcLink   = NoLink
-    }
-  dynflags''' <- parseGhcFlags dynflags'' restFlags flags
-  setSessionDynFlags session dynflags'''
-  return (session, dynflags''')
+  session <- newSession (Just libDir)
+  dynflags <- getSessionDynFlags session
+  do
+#endif
+    let dynflags' = dopt_set dynflags Opt_Haddock
+    let dynflags'' = dynflags' {
+        hscTarget = HscAsm,
+        ghcMode   = CompManager,
+        ghcLink   = NoLink
+      }
+    dynflags''' <- parseGhcFlags dynflags'' restFlags flags
+#if __GLASGOW_HASKELL__ >= 609 
+    setSessionDynFlags dynflags'''
+    ghcActs dynflags'''
+#else
+    setSessionDynFlags session dynflags'''
+    return (session, dynflags''')
+#endif
 
 
 -- | Expose the list of packages to GHC. Then initialize GHC's package state
@@ -51,6 +66,8 @@
 -- list of packages. The matching packages might be newer versions of the 
 -- supplied ones. For each matching package, return its InstalledPackageInfo. 
 
+-- Commented out, since it is unused and doesn't build with GHC >= 6.9
+{-
 loadPackages :: Session -> [String] -> IO [InstalledPackageInfo]
 
 -- It would be better to try to get the "in scope" packages from GHC instead.
@@ -86,11 +103,16 @@
   where
     handleParse (Just pkg) = return (pkgName pkg)
     handleParse Nothing = throwE "Could not parse package identifier"
-
+-}
 
 -- | Try to parse dynamic GHC flags
 parseGhcFlags dynflags flags origFlags = do
+  -- TODO: handle warnings?
+#if __GLASGOW_HASKELL__ >= 609
+  (dynflags', rest, _) <- parseDynamicFlags dynflags flags
+#else
   (dynflags', rest) <- parseDynamicFlags dynflags flags
+#endif
   if not (null rest)
     then throwE ("Couldn't parse GHC options: " ++ (unwords origFlags))
     else return dynflags'
diff --git a/src/Haddock/GHC/Typecheck.hs b/src/Haddock/GHC/Typecheck.hs
--- a/src/Haddock/GHC/Typecheck.hs
+++ b/src/Haddock/GHC/Typecheck.hs
@@ -6,7 +6,7 @@
 
 
 module Haddock.GHC.Typecheck (
-  typecheckFiles  
+  mkGhcModule
 ) where
 
 
@@ -17,6 +17,7 @@
 import Data.Maybe
 import Control.Monad
 import GHC
+import HscTypes ( msHsFilePath )
 import Digraph
 import BasicTypes
 import SrcLoc
@@ -32,37 +33,6 @@
                         TypecheckedSource, 
                         ModuleInfo)
 
-
--- TODO: make it handle cleanup
-typecheckFiles :: Session -> [FilePath] -> IO [GhcModule]
-typecheckFiles session files = do 
-
-  -- load all argument files
-
-  targets <- mapM (\f -> guessTarget f Nothing) files
-  setTargets session targets
-
-  flag <- load session LoadAllTargets
-  when (failed flag) $ 
-    throwE "Failed to load all needed modules"
-
-  modgraph <- getModuleGraph session
-
-  let mods = concatMap flattenSCC $ topSortModuleGraph False modgraph Nothing
-      getModFile = fromJust . ml_hs_file . ms_location
-      mods'= [ (ms_mod modsum, ms_hspp_opts modsum, getModFile modsum) |
-               modsum <- mods ]
-
-  -- typecheck the argument modules
-
-  ghcMods <- forM mods' $ \(mod, flags, file) -> do
-    mbMod <- checkModule session (moduleName mod) False
-    case mbMod of
-      Just (CheckedModule a (Just b) (Just c) (Just d) _) 
-        -> return $ mkGhcModule (mod, file, (a,b,c,d)) flags
-      _ -> throwE ("Failed to check module: " ++ moduleString mod)
-
-  return ghcMods
 
 -- | Dig out what we want from the typechecker output
 mkGhcModule :: CheckedMod -> DynFlags -> GhcModule 
diff --git a/src/Haddock/GHC/Utils.hs b/src/Haddock/GHC/Utils.hs
--- a/src/Haddock/GHC/Utils.hs
+++ b/src/Haddock/GHC/Utils.hs
@@ -16,12 +16,12 @@
 import Data.Version
 import qualified Data.Map as Map
 
-import GHC
 import HsSyn
 import SrcLoc
 import Outputable
 import Name
 import Packages
+import Module
 
 
 unL :: Located a -> a
@@ -37,14 +37,20 @@
 
 
 -- return the name of the package, with version info
+modulePackageString :: Module -> String
 modulePackageString = packageIdString . modulePackageId
 
 
 -- return the (name,version) of the package
-modulePackageInfo mod = case unpackPackageId pkg of
+modulePackageInfo :: Module -> (String, [Char])
+modulePackageInfo modu = case unpackPackageId pkg of
                           Nothing -> (packageIdString pkg, "")
+#if __GLASGOW_HASKELL__ >= 609
+                          Just x -> (display $ pkgName x, showVersion (pkgVersion x))
+#else
                           Just x -> (pkgName x, showVersion (pkgVersion x))
-    where pkg = modulePackageId mod
+#endif
+  where pkg = modulePackageId modu
 
 
 mkModuleNoPackage :: String -> Module
@@ -75,23 +81,28 @@
 getMainDeclBinder _ = Nothing
 
 
+isTyClD :: HsDecl a -> Bool
 isTyClD (TyClD _) = True
 isTyClD _ = False
 
 
+isClassD :: HsDecl a -> Bool
 isClassD (TyClD d) = isClassDecl d
 isClassD _ = False
 
 
+isDocD :: HsDecl a -> Bool
 isDocD (DocD _) = True
 isDocD _ = False
 
 
+isInstD :: HsDecl a -> Bool
 isInstD (InstD _) = True
 isInstD (TyClD d) = isFamInstDecl d
 isInstD _ = False
 
 
+declATs :: HsDecl a -> [a]
 declATs (TyClD d) | isClassDecl d = map (tcdName . unL) $ tcdATs d
 declATs _ = []
 
diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs
--- a/src/Haddock/Interface.hs
+++ b/src/Haddock/Interface.hs
@@ -21,52 +21,150 @@
 import Haddock.Types
 import Haddock.Options
 import Haddock.GHC.Utils
+import Haddock.GHC.Typecheck
+import Haddock.Exception
+import Haddock.Utils
 
 import qualified Data.Map as Map
 import Data.Map (Map)
 import Data.List
 import Control.Monad
+import Control.Exception ( evaluate )
 
+import GHC
 import Name
+import HscTypes ( msHsFilePath )
+import Digraph
+import BasicTypes
+import SrcLoc
 
 
--- | Turn a topologically sorted list of GhcModules into interfaces. Also
--- return the home link environment created in the process, and any error
--- messages.
-createInterfaces :: [GhcModule] -> LinkEnv -> [Flag] -> ([Interface], LinkEnv, [ErrMsg])
-createInterfaces modules externalLinks flags = (interfaces, homeLinks, messages)
-  where 
-    ((interfaces, homeLinks), messages) = runWriter $ do
+-- | Turn a topologically sorted list of module names/filenames into interfaces. Also
+-- return the home link environment created in the process.
+#if __GLASGOW_HASKELL__ >= 609
+createInterfaces :: [String] -> LinkEnv -> [Flag] -> Ghc ([Interface], LinkEnv)
+createInterfaces modules externalLinks flags = do
+  -- part 1, create interfaces
+  interfaces <- createInterfaces' modules flags
+#else
+createInterfaces :: Session -> [String] -> LinkEnv -> [Flag] -> IO ([Interface], LinkEnv)
+createInterfaces session modules externalLinks flags = do
+  -- part 1, create interfaces
+  interfaces <- createInterfaces' session modules flags
+#endif
+  -- part 2, build link environment
+  let homeLinks = buildHomeLinks interfaces
+      links     = homeLinks `Map.union` externalLinks
+      allNames  = Map.keys links
 
-      -- part 1, create the interfaces
-      interfaces <- createInterfaces' modules flags
+  -- part 3, attach instances
+  let interfaces' = attachInstances interfaces allNames
 
-      -- part 2, build the link environment
-      let homeLinks = buildHomeLinks interfaces
-      let links = homeLinks `Map.union` externalLinks
-      let allNames = Map.keys links
+  -- part 4, rename interfaces
+  let warnings = Flag_NoWarnings `notElem` flags
+  let (interfaces'', msgs) = 
+         runWriter $ mapM (renameInterface links warnings) interfaces'
+  liftIO $ mapM_ putStrLn msgs
 
-      -- part 3, attach the instances
-      let interfaces' = attachInstances interfaces allNames
- 
-      -- part 3, rename the interfaces
-      let warnings = Flag_NoWarnings `notElem` flags
-      interfaces'' <- mapM (renameInterface links warnings) interfaces'
+  return (interfaces'', homeLinks)  
 
-      return (interfaces'', homeLinks)
-  
 
-createInterfaces' :: [GhcModule] -> [Flag] -> ErrMsgM [Interface]
+#if __GLASGOW_HASKELL__ >= 609
+createInterfaces' :: [String] -> [Flag] -> Ghc [Interface]
 createInterfaces' modules flags = do
-  resultMap <- foldM addInterface Map.empty modules
-  return (Map.elems resultMap)
-  where
-    addInterface :: ModuleMap -> GhcModule -> ErrMsgM ModuleMap
-    addInterface map mod = do
-      interface <- createInterface mod flags map
-      return $ Map.insert (ifaceMod interface) interface map
+  targets <- mapM (\f -> guessTarget f Nothing) modules
+  setTargets targets
+  modgraph <- depanal [] False
+  let orderedMods = flattenSCCs $ topSortModuleGraph False modgraph Nothing
+  (ifaces, _) <- foldM (\(ifaces, modMap) modsum -> do
+    interface <- processModule modsum flags modMap
+#else
+createInterfaces' :: Session -> [String] -> [Flag] -> IO [Interface]
+createInterfaces' session modules flags = do
+  targets <- mapM (\f -> guessTarget f Nothing) modules
+  setTargets session targets
+  mbGraph <- depanal session [] False
+  modgraph <- case mbGraph of
+    Just graph -> return graph
+    Nothing -> throwE "Failed to create dependecy graph"
+  let orderedMods = flattenSCCs $ topSortModuleGraph False modgraph Nothing
+  (ifaces, _) <- foldM (\(ifaces, modMap) modsum -> do
+    interface <- processModule session modsum flags modMap
+#endif
+    return $ (interface : ifaces , Map.insert (ifaceMod interface) interface modMap)
+    ) ([], Map.empty) orderedMods
+  return (reverse ifaces)
 
- 
+{-    liftIO $ do
+     putStrLn . ppModInfo $ ifaceInfo interface
+     putStrLn . show $ fmap pretty (ifaceDoc interface)
+     print (ifaceOptions interface)
+     mapM (putStrLn . pretty . fst) (Map.elems . ifaceDeclMap $ interface)
+     mapM (putStrLn . show . fmap pretty . snd) (Map.elems . ifaceDeclMap $ interface)
+     mapM (putStrLn . ppExportItem) (ifaceExportItems interface)
+     mapM (putStrLn . pretty) (ifaceLocals interface)
+     mapM (putStrLn . pretty) (ifaceExports interface)
+     mapM (putStrLn . pretty) (ifaceVisibleExports interface)
+     mapM (putStrLn . pretty) (ifaceInstances interface)
+     mapM (\(a,b) -> putStrLn $ pretty a ++ pretty b)  (Map.toList $ ifaceSubMap interface)
+     mapM (putStrLn . pretty) (ifaceInstances interface)-}
+
+{-
+
+ppInsts = concatMap ppInst 
+
+ppInst (a,b,c) = concatMap pretty a ++ pretty b ++ concatMap pretty c 
+
+
+ppExportItem (ExportDecl decl (Just doc) insts) = pretty decl ++ pretty doc ++ ppInsts insts
+ppExportItem (ExportDecl decl Nothing insts) = pretty decl ++ ppInsts insts
+ppExportItem (ExportNoDecl name name2 names) = pretty name ++ pretty name2 ++ pretty names
+ppExportItem (ExportGroup level id doc) = show level ++ show id ++ pretty doc
+ppExportItem (ExportDoc doc) = pretty doc
+ppExportItem (ExportModule mod) = pretty mod
+
+
+ppModInfo (HaddockModInfo a b c d) = show (fmap pretty a) ++ show b ++ show c ++ show d 
+-}
+
+#if __GLASGOW_HASKELL__ >= 609
+processModule :: ModSummary -> [Flag] -> ModuleMap -> Ghc Interface
+processModule modsum flags modMap = 
+
+  let handleSrcErrors action = flip handleSourceError action $ \err -> do 
+        printExceptionAndWarnings err
+        throwE ("Failed to check module: " ++ moduleString (ms_mod modsum))
+
+  in handleSrcErrors $ do
+       let filename = msHsFilePath modsum
+       let dynflags = ms_hspp_opts modsum
+       tc_mod <- loadModule =<< typecheckModule =<< parseModule modsum
+       let Just renamed_src = renamedSource tc_mod
+       let ghcMod = mkGhcModule (ms_mod modsum,
+                             filename,
+                             (parsedSource tc_mod,
+                              renamed_src,
+                              typecheckedSource tc_mod,
+                              moduleInfo tc_mod))
+                             dynflags
+       let (interface, msg) = runWriter $ createInterface ghcMod flags modMap
+       liftIO $ mapM_ putStrLn msg
+       liftIO $ evaluate interface
+       return interface
+#else
+processModule :: Session -> ModSummary -> [Flag] -> ModuleMap -> IO Interface
+processModule session modsum flags modMap = do
+  let filename = msHsFilePath modsum
+  mbMod <- checkAndLoadModule session modsum False
+  ghcMod <- case mbMod of
+    Just (CheckedModule a (Just b) (Just c) (Just d) _)
+      -> return $ mkGhcModule (ms_mod modsum, filename, (a,b,c,d)) (ms_hspp_opts modsum)
+    _ -> throwE ("Failed to check module: " ++ (moduleString $ ms_mod modsum))
+  let (interface, msg) = runWriter $ createInterface ghcMod flags modMap
+  mapM_ putStrLn msg
+  return interface
+#endif
+
 -- | Build a mapping which for each original name, points to the "best"
 -- place to link to in the documentation.  For the definition of
 -- "best", we use "the module nearest the bottom of the dependency
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -43,9 +43,9 @@
       where
         newItems = map attachExport (ifaceExportItems mod)
 
-        attachExport (ExportDecl decl@(L _ (TyClD d)) doc _)
+        attachExport (ExportDecl decl@(L _ (TyClD d)) doc subs _)
           | isClassDecl d || isDataDecl d || isFamilyDecl d =
-             ExportDecl decl doc (case Map.lookup (tcdName d) instMap of
+             ExportDecl decl doc subs (case Map.lookup (tcdName d) instMap of
                                     Nothing -> []
                                     Just instheads -> instheads)
         attachExport export = export
@@ -78,6 +78,7 @@
                     Just tycon <- nub (is_tcs inst) ]    
 
 
+-- TODO: should we support PredTy here?
 instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], Name, [SimpleType])
 instHead (_, _, cls, args)
   = (map argCount args, className cls, map simplify args)
@@ -86,7 +87,6 @@
     argCount (TyConApp _ ts) = length ts
     argCount (FunTy _ _ ) = 2
     argCount (ForAllTy _ t) = argCount t
-    argCount (NoteTy _ t) = argCount t
     argCount _ = 0
 
     simplify (ForAllTy _ t) = simplify t
@@ -96,7 +96,6 @@
       where (SimpleType s args) = simplify t1
     simplify (TyVarTy v) = SimpleType (tyVarName v) []
     simplify (TyConApp tc ts) = SimpleType (tyConName tc) (map simplify ts)
-    simplify (NoteTy _ t) = simplify t
     simplify _ = error "simplify"
 
 
@@ -145,7 +144,6 @@
   FunTy a b -> HsFunTy (toLHsType a) (toLHsType b)
   ForAllTy v t -> cvForAll [v] t 
   PredTy p -> HsPredTy (toHsPred p) 
-  NoteTy _ t -> toHsType t
   where
     tycon tc = HsTyVar (tyConName tc)
     app tc ts = foldl (\a b -> HsAppTy (noLoc a) (noLoc b)) tc (map toHsType ts)
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -53,24 +53,21 @@
   let group         = ghcGroup ghcMod
       exports       = fmap (reverse . map unLoc) (ghcMbExports ghcMod)
       localNames    = ghcDefinedNames ghcMod
-      subMap        = mkSubMap group
-      decls         = topDecls group
-      decls'        = filterOutInstances decls
-      declMap       = mkDeclMap decls'
-      famMap        = Map.empty --mkFamMap decls'
+      decls0        = declInfos . topDecls $ group
+      decls         = filterOutInstances decls0
+      declMap       = mkDeclMap decls
       ignoreExps    = Flag_IgnoreAllExports `elem` flags
       exportedNames = ghcExportedNames ghcMod
-      origEnv       = Map.fromList [ (nameOccName n, n) | n <- exportedNames ]
       instances     = ghcInstances ghcMod
 
-  warnAboutFilteredDecls mod decls
+  warnAboutFilteredDecls mod decls0
 
   visibleNames <- mkVisibleNames mod modMap localNames 
                                  (ghcNamesInScope ghcMod) 
-                                 subMap exports opts declMap 
+                                 exports opts declMap 
 
-  exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod) decls' declMap
-                               famMap subMap opts exports ignoreExps instances
+  exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod) decls declMap
+                               opts exports ignoreExps instances
 
   -- prune the export list to just those declarations that have
   -- documentation, if the 'prune' option is on.
@@ -88,10 +85,8 @@
     ifaceOptions         = opts,
     ifaceLocals          = localNames,
     ifaceRnDocMap        = Map.empty,
-    ifaceSubMap          = subMap,
     ifaceExportItems     = prunedExportItems,
     ifaceRnExportItems   = [],
-    ifaceEnv             = origEnv, 
     ifaceExports         = exportedNames,
     ifaceVisibleExports  = visibleNames, 
     ifaceDeclMap         = declMap,
@@ -130,54 +125,41 @@
 -- Declarations
 --------------------------------------------------------------------------------
 
-type DeclWithDoc = (LHsDecl Name, Maybe (HsDoc Name))
 
-
--- | A list of type or data instance declarations with an optional family
--- declaration.
-type Family = (Maybe DeclWithDoc, [DeclWithDoc])
-
-
--- | Make a map from names to declarations with documentation. The map excludes
--- all kinds of instance declarations (including type family instances) and
--- documentation declarations.
--- Subordinate names are mapped to the parent declaration, but with the doc
--- for the subordinate declaration.
-mkDeclMap :: [DeclWithDoc] -> Map Name DeclWithDoc
-mkDeclMap decls = Map.fromList [ (n, (L loc d, doc)) | (L loc d, doc) <- decls 
-                               , (n, doc) <- (declName d, doc) : subordinates d
-                               , not (isDocD d), not (isInstD d) ]
+-- Make a map from names to 'DeclInfo's. Exclude declarations that don't
+-- have names (instances and stand-alone documentation comments). Include
+-- subordinate names, but map them to their parent declarations. 
+mkDeclMap :: [DeclInfo] -> Map Name DeclInfo
+mkDeclMap decls = Map.fromList . concat $
+  [ (declName d, (parent, doc, subs)) : subDecls
+  | (parent@(L _ d), doc, subs) <- decls 
+  , let subDecls = [ (n, (parent, doc', [])) | (n, doc') <- subs ]
+  , not (isDocD d), not (isInstD d) ]
 
 
--- | Group type family instances together. Include the family declaration
--- if found.
-{-mkFamMap :: [DeclWithDoc] -> Map Name Family
-mkFamMap decls = 
-  Map.fromList [ (tcdName $ ex $ head $ g, family g) | g <- groups ]
-  where
-    family g = first listToMaybe $ partition (isFamilyDecl . ex) g
-    groups   = groupBy (comparing (tcdName . ex)) $ 
-               filter (isTyClD . unLoc . fst) decls
-    ex ((L _ (TyClD d)), _) = d
--}
-
+declInfos :: [(Decl, Maybe Doc)] -> [DeclInfo]
+declInfos decls = [ (parent, doc, subordinates d)
+                  | (parent@(L _ d), doc) <- decls]
 
 
 subordinates (TyClD d) = classDataSubs d
 subordinates _ = []
 
 
-classDataSubs :: TyClDecl Name -> [(Name, Maybe (HsDoc Name))]
+classDataSubs :: TyClDecl Name -> [(Name, Maybe Doc)]
 classDataSubs decl
-  | isClassDecl decl = classMeths
-  | isDataDecl  decl = recordFields
+  | isClassDecl decl = classSubs
+  | isDataDecl  decl = dataSubs
   | otherwise        = []
   where
-    classMeths   = [ (declName d, doc) | (L _ d, doc) <- classDecls decl ]
-    recordFields = [ (unLoc lname, fmap unLoc doc) |
-                     ConDeclField lname _ doc <- fields ]
-    cons         = [ con | L _ con <- tcdCons decl ]
-    fields       = concat [ fields | RecCon fields <- map con_details cons]
+    classSubs = [ (declName d, doc) | (L _ d, doc) <- classDecls decl ]
+    dataSubs  = constrs ++ fields   
+      where
+        cons    = map unL $ tcdCons decl
+        constrs = [ (unL $ con_name c, fmap unL $ con_doc c) | c <- cons ]
+        fields  = [ (unL n, fmap unL doc)
+                  | RecCon flds <- map con_details cons
+                  , ConDeclField n _ doc <- flds ]
 
 
 -- All the sub declarations of a class (that we handle), ordered by
@@ -201,16 +183,16 @@
 
 -- | The top-level declarations of a module that we care about, 
 -- ordered by source location, with documentation attached if it exists.
-topDecls :: HsGroup Name -> [DeclWithDoc] 
+topDecls :: HsGroup Name -> [(Decl, Maybe Doc)] 
 topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . declsFromGroup
 
 
-filterOutInstances = filter (\(L _ d, _) -> not (isInstD d))
+filterOutInstances = filter (\(L _ d, _, _) -> not (isInstD d))
 
 
 -- | Take all declarations in an 'HsGroup' and convert them into a list of
--- 'LHsDecl's
-declsFromGroup :: HsGroup Name -> [LHsDecl Name]
+-- 'Decl's
+declsFromGroup :: HsGroup Name -> [Decl]
 -- TODO: actually take all declarations
 declsFromGroup group = 
   decls hs_tyclds TyClD group ++
@@ -234,7 +216,7 @@
 warnAboutFilteredDecls mod decls = do
   let modStr = moduleString mod
   let typeInstances =
-        nub [ tcdName d | (L _ (TyClD d), _) <- decls, isFamInstDecl d ]
+        nub [ tcdName d | (L _ (TyClD d), _, _) <- decls, isFamInstDecl d ]
 
   when (not $null typeInstances) $
     tell $ nub [
@@ -243,7 +225,7 @@
       ++ "will be filtered out:\n  " ++ (concat $ intersperse ", "
       $ map (occNameString . nameOccName) typeInstances) ]
 
-  let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _) <- decls
+  let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _, _) <- decls
                                  , not (null ats) ]
 
   when (not $ null instances) $
@@ -262,7 +244,7 @@
 
 
 -- | Filter out declarations that we don't handle in Haddock
-filterDecls :: [DeclWithDoc] -> [DeclWithDoc]
+filterDecls :: [(Decl, Maybe Doc)] -> [(Decl, Maybe Doc)]
 filterDecls decls = filter (isHandled . unL . fst) decls
   where
     isHandled (ForD (ForeignImport {})) = True
@@ -275,7 +257,7 @@
 
 
 -- | Go through all class declarations and filter their sub-declarations
-filterClasses :: [DeclWithDoc] -> [DeclWithDoc]
+filterClasses :: [(Decl, Maybe Doc)] -> [(Decl, Maybe Doc)]
 filterClasses decls = [ if isClassD d then (L loc (filterClass d), doc) else x 
                       | x@(L loc d, doc) <- decls ]
   where
@@ -284,19 +266,6 @@
 
 
 --------------------------------------------------------------------------------
--- Instances
---------------------------------------------------------------------------------
-
-{-
-matchingInsts :: Name -> [Instances] -> [Instances]
-matchingInsts name instances = filter ((==) name . is_cls) instances
-
-
-instToData :: Instance -> LHsDecl Name
-instToData inst = TyData {
--}
-
---------------------------------------------------------------------------------
 -- Collect docs
 --
 -- To be able to attach the right Haddock comment to the right declaration,
@@ -306,11 +275,11 @@
 
 
 -- | Collect the docs and attach them to the right declaration
-collectDocs :: [LHsDecl Name] -> [DeclWithDoc]
+collectDocs :: [Decl] -> [(Decl, (Maybe Doc))]
 collectDocs decls = collect Nothing DocEmpty decls
 
 
-collect :: Maybe (LHsDecl Name) -> HsDoc Name -> [LHsDecl Name] -> [DeclWithDoc]
+collect :: Maybe Decl -> Doc -> [Decl] -> [(Decl, (Maybe Doc))]
 collect d doc_so_far [] =
    case d of
         Nothing -> []
@@ -332,7 +301,7 @@
         | otherwise -> finishedDoc d0 doc_so_far (collect (Just e) DocEmpty es)
 
 
-finishedDoc :: LHsDecl Name -> HsDoc Name -> [DeclWithDoc] -> [DeclWithDoc]
+finishedDoc :: Decl -> Doc -> [(Decl, (Maybe Doc))] -> [(Decl, (Maybe Doc))]
 finishedDoc d DocEmpty rest = (d, Nothing) : rest
 finishedDoc d doc rest | notDocDecl d = (d, Just doc) : rest
   where
@@ -344,11 +313,6 @@
 sameDecl d1 d2 = getLoc d1 == getLoc d2
 
 
-mkSubMap :: HsGroup Name -> Map Name [Name]
-mkSubMap group = Map.fromList [ (name, subs) | L _ tycld <- hs_tyclds group,
- let name:subs = map unLoc (tyClDeclNames tycld) ]
-
-
 {-
 attachATs :: [IE Name] -> ([IE Name], [Name])
 attachATs exports = 
@@ -364,23 +328,21 @@
   :: ModuleMap
   -> Module			-- this module
   -> [Name]			-- exported names (orig)
-  -> [DeclWithDoc]
-  -> Map Name DeclWithDoc -- maps local names to declarations
-  -> Map Name Family
-  -> Map Name [Name]	-- sub-map for this module
+  -> [DeclInfo]
+  -> Map Name DeclInfo             -- maps local names to declarations
   -> [DocOption]
   -> Maybe [IE Name]
   -> Bool				-- --ignore-all-exports flag
   -> [Instance]
   -> ErrMsgM [ExportItem Name]
 
-mkExportItems modMap this_mod exported_names decls declMap famMap sub_map
+mkExportItems modMap this_mod exported_names decls declMap
               opts maybe_exps ignore_all_exports instances
   | isNothing maybe_exps || ignore_all_exports || OptIgnoreExports `elem` opts
     = everything_local_exported
   | Just specs <- maybe_exps = liftM concat $ mapM lookupExport specs
   where
-    instances = [ d  | d@(L _ decl, _) <- decls, isInstD decl ]
+    instances = [ d | d@(L _ decl, _, _) <- decls, isInstD decl ]
 
     everything_local_exported =  -- everything exported
       return (fullContentsOfThisModule this_mod decls)
@@ -401,7 +363,7 @@
     lookupExport (IEGroup lev doc)     = return [ ExportGroup lev "" doc ]
     lookupExport (IEDoc doc)           = return [ ExportDoc doc ] 
     lookupExport (IEDocNamed str) = do
-      r <- findNamedDoc str (map (unLoc . fst) decls)
+      r <- findNamedDoc str [ unL d | (d,_,_) <- decls ]
       case r of
         Nothing -> return []
         Just found -> return [ ExportDoc found ]
@@ -411,16 +373,20 @@
       -- temp hack: we filter out separately declared ATs, since we haven't decided how
       -- to handle them yet. We should really give an warning message also, and filter the
       -- name out in mkVisibleNames...
-      | Just (decl, maybeDoc) <- findDecl t, t `notElem` declATs (unL decl) =
-          return [ ExportDecl (restrictTo subs (extractDecl t mdl decl)) maybeDoc [] ]
+      | Just x@(decl,_,_) <- findDecl t,
+        t `notElem` declATs (unL decl) = return [ mkExportDecl t x ]
       | otherwise = return []
-     where 
-       mdl = nameModule t
-       subs = filter (`elem` exported_names) all_subs
-       all_subs
-         | mdl == this_mod = Map.findWithDefault [] t sub_map
-         | otherwise       = allSubsOfName modMap t
 
+
+    mkExportDecl :: Name -> DeclInfo -> ExportItem Name
+    mkExportDecl n (decl, doc, subs) = decl'
+      where
+        decl' = ExportDecl (restrictTo subs' (extractDecl n mdl decl)) doc subdocs []
+        mdl = nameModule n
+        subs' = filter (`elem` exported_names) $ map fst subs
+        subdocs = [ (n, doc) | (n, Just doc) <- subs ]
+
+
     fullContentsOf m  
 	| m == this_mod = return (fullContentsOfThisModule this_mod decls)
 	| otherwise = 
@@ -431,9 +397,9 @@
 		| otherwise -> return [ ExportModule m ]
 	     Nothing -> return [] -- already emitted a warning in visibleNames
 
-    findDecl :: Name -> Maybe (LHsDecl Name, Maybe (HsDoc Name))
+    findDecl :: Name -> Maybe DeclInfo
     findDecl n 
-	    | m == this_mod = Map.lookup n declMap
+      | m == this_mod = Map.lookup n declMap
       | otherwise = case Map.lookup m modMap of
                       Just iface -> Map.lookup n (ifaceDeclMap iface) 
                       Nothing -> Nothing
@@ -441,11 +407,14 @@
         m = nameModule n
 
 
-fullContentsOfThisModule :: Module -> [(LHsDecl Name, Maybe (HsDoc Name))] -> [ExportItem Name]
+fullContentsOfThisModule :: Module -> [DeclInfo] -> [ExportItem Name]
 fullContentsOfThisModule module_ decls = catMaybes (map mkExportItem decls)
   where
-    mkExportItem (L _ (DocD (DocGroup lev doc)), _) = Just $ ExportGroup lev "" doc
-    mkExportItem (decl, doc) = Just $ ExportDecl decl doc []
+    mkExportItem (L _ (DocD (DocGroup lev doc)), _, _) = Just $ ExportGroup lev "" doc
+    mkExportItem (L _ (DocD (DocCommentNamed _ doc)), _, _)   = Just $ ExportDoc doc
+    mkExportItem (decl, doc, subs) = Just $ ExportDecl decl doc subdocs []
+      where subdocs = [ (n, doc) | (n, Just doc) <- subs ]
+
 --    mkExportItem _ = Nothing -- TODO: see if this is really needed
 
 
@@ -453,7 +422,7 @@
 -- it might be an individual record selector or a class method.  In these
 -- cases we have to extract the required declaration (and somehow cobble 
 -- together a type signature for it...)
-extractDecl :: Name -> Module -> LHsDecl Name -> LHsDecl Name
+extractDecl :: Name -> Module -> Decl -> Decl
 extractDecl name mdl decl
   | Just n <- getMainDeclBinder (unLoc decl), n == name = decl
   | otherwise  =  
@@ -513,7 +482,7 @@
 -- Pruning
 pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
 pruneExportItems items = filter hasDoc items
-  where hasDoc (ExportDecl _ d _) = isJust d
+  where hasDoc (ExportDecl _ d _ _) = isJust d
 	hasDoc _ = True
 
 
@@ -522,13 +491,12 @@
              -> ModuleMap
              -> [Name] 
              -> [Name]
-             -> Map Name [Name]
              -> Maybe [IE Name]
              -> [DocOption]
-             -> Map Name (LHsDecl Name, Maybe (HsDoc Name))
+             -> Map Name DeclInfo
              -> ErrMsgM [Name]
 
-mkVisibleNames mdl modMap localNames scope subMap maybeExps opts declMap 
+mkVisibleNames mdl modMap localNames scope maybeExps opts declMap 
   -- if no export list, just return all local names 
   | Nothing <- maybeExps         = return (filter hasDecl localNames)
   | OptIgnoreExports `elem` opts = return localNames
@@ -546,7 +514,7 @@
     IEThingAbs t -> return [t]
     IEThingAll t -> return (t : all_subs)
 	 where
-	      all_subs | nameModule t == mdl = Map.findWithDefault [] t subMap
+	      all_subs | nameModule t == mdl = subsOfName t declMap
 		       | otherwise = allSubsOfName modMap t
 
     IEThingWith t cs -> return (t : cs)
@@ -573,23 +541,27 @@
 -- | 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).
-allSubsOfName :: ModuleMap -> Name -> [Name]
-allSubsOfName modMap name 
-  | isExternalName name =
-    case Map.lookup (nameModule name) modMap of
-      Just iface -> Map.findWithDefault [] name (ifaceSubMap iface)
-      Nothing   -> []
-  | otherwise =  error $ "Main.allSubsOfName: unexpected unqual'd name"
+allSubsOfName :: Map Module Interface -> Name -> [Name]
+allSubsOfName ifaces name =
+  case Map.lookup (nameModule name) ifaces of
+    Just iface -> subsOfName name (ifaceDeclMap iface)
+    Nothing -> []
 
 
--- Named documentation
+subsOfName :: Name -> Map Name DeclInfo -> [Name]
+subsOfName n declMap =
+  case Map.lookup n declMap of
+    Just (_, _, subs) -> map fst subs
+    Nothing -> []
 
-findNamedDoc :: String -> [HsDecl Name] -> ErrMsgM (Maybe (HsDoc Name))
+
+-- | Find a stand-alone documentation comment by its name
+findNamedDoc :: String -> [HsDecl Name] -> ErrMsgM (Maybe Doc)
 findNamedDoc name decls = search decls
-	where
+  where
     search [] = do
-		  tell ["Cannot find documentation for: $" ++ name]
-		  return Nothing
+      tell ["Cannot find documentation for: $" ++ name]
+      return Nothing
     search ((DocD (DocCommentNamed name' doc)):rest) 
       | name == name' = return (Just doc)
       | otherwise = search rest
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -38,7 +38,7 @@
   let localEnv = foldl fn renamingEnv (ifaceVisibleExports mod)
         where fn env name = Map.insert name (ifaceMod mod) env
       
-      docMap = Map.map (\(_, doc) -> doc) $ ifaceDeclMap mod
+      docMap = Map.map (\(_,x,_) -> x) (ifaceDeclMap mod)
       docs   = [ (n, doc) | (n, Just doc) <- Map.toList docMap ]
       renameMapElem (k,d) = do d' <- renameDoc d; return (k, d') 
 
@@ -130,10 +130,6 @@
 --------------------------------------------------------------------------------
 
 
-keep n = Undocumented n
-keepL (L loc n) = L loc (Undocumented n)
-
-
 rename = lookupRn id 
 renameL (L loc name) = return . L loc =<< rename name
 
@@ -188,6 +184,7 @@
     doc' <- renameDoc doc
     return (DocCodeBlock doc')
   DocURL str -> return (DocURL str) 
+  DocPic str -> return (DocPic str)
   DocAName str -> return (DocAName str)
 
 
@@ -340,12 +337,13 @@
   where
     renameLCon (L loc con) = return . L loc =<< renameCon con
     renameCon (ConDecl lname expl ltyvars lcontext details restype mbldoc) = do
+      lname'    <- renameL lname
       ltyvars'  <- mapM renameLTyVarBndr ltyvars
       lcontext' <- renameLContext lcontext
       details'  <- renameDetails details
       restype'  <- renameResType restype
       mbldoc'   <- mapM renameLDoc mbldoc
-      return (ConDecl (keepL lname) expl ltyvars' lcontext' details' restype' mbldoc') 
+      return (ConDecl lname' expl ltyvars' lcontext' details' restype' mbldoc') 
 
     renameDetails (RecCon fields) = return . RecCon =<< mapM renameField fields
     renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
@@ -355,31 +353,38 @@
       return (InfixCon a' b')
 
     renameField (ConDeclField name t doc) = do
+      name' <- renameL name
       t'   <- renameLType t
       doc' <- mapM renameLDoc doc
-      return (ConDeclField (keepL name) t' doc')
+      return (ConDeclField name' t' doc')
 
     renameResType (ResTyH98) = return ResTyH98
     renameResType (ResTyGADT t) = return . ResTyGADT =<< renameLType t
 
-    renameLFunDep (L loc (xs, ys)) = return (L loc (map keep xs, map keep ys))
+    renameLFunDep (L loc (xs, ys)) = do
+      xs' <- mapM rename xs
+      ys' <- mapM rename ys
+      return (L loc (xs', ys'))
    
     renameLSig (L loc sig) = return . L loc =<< renameSig sig
 
       
 renameSig sig = case sig of 
-  TypeSig (L loc name) ltype -> do 
+  TypeSig lname ltype -> do 
+    lname' <- renameL lname
     ltype' <- renameLType ltype
-    return (TypeSig (L loc (keep name)) ltype')
+    return (TypeSig lname' ltype')
   -- we have filtered out all other kinds of signatures in Interface.Create
 
 
 renameForD (ForeignImport lname ltype x) = do
+  lname' <- renameL lname
   ltype' <- renameLType ltype
-  return (ForeignImport (keepL lname) ltype' x)
+  return (ForeignImport lname' ltype' x)
 renameForD (ForeignExport lname ltype x) = do
+  lname' <- renameL lname
   ltype' <- renameLType ltype
-  return (ForeignExport (keepL lname) ltype' x)
+  return (ForeignExport lname' ltype' x)
 
 
 renameInstD (InstDecl ltype _ _ lATs) = do
@@ -394,11 +399,12 @@
   ExportGroup lev id doc -> do
     doc' <- renameDoc doc
     return (ExportGroup lev id doc')
-  ExportDecl decl doc instances -> do
+  ExportDecl decl doc subs instances -> do
     decl' <- renameLDecl decl
     doc'  <- mapM renameDoc doc
+    subs' <- mapM renameSub subs
     instances' <- mapM renameInstHead instances
-    return (ExportDecl decl' doc' instances')
+    return (ExportDecl decl' doc' subs' instances')
   ExportNoDecl x y subs -> do
     y'    <- lookupRn id y
     subs' <- mapM (lookupRn id) subs
@@ -406,3 +412,9 @@
   ExportDoc doc -> do
     doc' <- renameDoc doc
     return (ExportDoc doc')
+
+
+renameSub (n,doc) = do
+  n' <- rename n
+  doc' <- renameDoc doc
+  return (n', doc')
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 --
 -- Haddock - A Haskell Documentation Tool
 --
@@ -7,14 +9,14 @@
 
 module Haddock.InterfaceFile (
   InterfaceFile(..),
-  readInterfaceFile,
+  readInterfaceFile, nameCacheFromGhc, freshNameCache, NameCacheAccessor,
   writeInterfaceFile
 ) where
 
 
 import Haddock.DocName ()
 import Haddock.Types
-import Haddock.Exception
+import Haddock.Utils
 
 import Data.List
 import Data.Word
@@ -32,11 +34,11 @@
 import UniqFM
 import IfaceEnv
 import Module
-import Packages
 import HscTypes
 import FastMutInt
-import InstEnv
 import HsDoc
+import FastString
+import Unique
 
 
 data InterfaceFile = InterfaceFile {
@@ -48,32 +50,64 @@
 binaryInterfaceMagic :: Word32
 binaryInterfaceMagic = 0xD0Cface
 
+
+-- Since datatypes in GHC might change between patchlevel versions,
+-- and because we store GHC datatypes in our interface files,
+-- we need to make sure we version our interface files accordingly.
+--
+-- Instead of adding one, we add three to all version numbers
+-- when one of our own (stored) datatypes is changed. 
 binaryInterfaceVersion :: Word16
-binaryInterfaceVersion = 1
+#if __GLASGOW_HASKELL__ == 608 && __GHC_PATCHLEVEL__ == 2
+binaryInterfaceVersion = 2
+#endif         
+#if __GLASGOW_HASKELL__ == 608 && __GHC_PATCHLEVEL__ == 3
+binaryInterfaceVersion = 3
+#endif           
+#if __GLASGOW_HASKELL__ >= 609
+binaryInterfaceVersion = 4
+#endif
 
+
 initBinMemSize :: Int
 initBinMemSize = 1024*1024
 
 
 writeInterfaceFile :: FilePath -> InterfaceFile -> IO ()
 writeInterfaceFile filename iface = do 
-  bh <- openBinMem initBinMemSize
-  put_ bh binaryInterfaceMagic
-  put_ bh binaryInterfaceVersion
+  bh0 <- openBinMem initBinMemSize
+  put_ bh0 binaryInterfaceMagic
+  put_ bh0 binaryInterfaceVersion
 
   -- remember where the dictionary pointer will go
-  dict_p_p <- tellBin bh
-  put_ bh dict_p_p	
+  dict_p_p <- tellBin bh0
+  put_ bh0 dict_p_p
 
   -- remember where the symbol table pointer will go
-  symtab_p_p <- tellBin bh
-  put_ bh symtab_p_p
+  symtab_p_p <- tellBin bh0
+  put_ bh0 symtab_p_p
 
   -- Make some intial state
+#if __GLASGOW_HASKELL__ >= 609
+  symtab_next <- newFastMutInt
+  writeFastMutInt symtab_next 0
+  symtab_map <- newIORef emptyUFM
+  let bin_symtab = BinSymbolTable {
+                      bin_symtab_next = symtab_next,
+                      bin_symtab_map  = symtab_map }
+  dict_next_ref <- newFastMutInt
+  writeFastMutInt dict_next_ref 0
+  dict_map_ref <- newIORef emptyUFM
+  let bin_dict = BinDictionary {
+                      bin_dict_next = dict_next_ref,
+                      bin_dict_map  = dict_map_ref }
+  ud <- newWriteState (putName bin_symtab) (putFastString bin_dict)
+#else
   ud <- newWriteState
+#endif
 
   -- put the main thing
-  bh <- return $ setUserData bh ud
+  bh <- return $ setUserData bh0 ud
   put_ bh iface
 
   -- write the symtab pointer at the fornt of the file
@@ -82,9 +116,14 @@
   seekBin bh symtab_p		
 
   -- write the symbol table itself
-  symtab_next <- readFastMutInt (ud_symtab_next ud)
-  symtab_map  <- readIORef (ud_symtab_map ud)
-  putSymbolTable bh symtab_next symtab_map
+#if __GLASGOW_HASKELL__ >= 609
+  symtab_next' <- readFastMutInt symtab_next
+  symtab_map'  <- readIORef symtab_map
+#else
+  symtab_next' <- readFastMutInt (ud_symtab_next ud)
+  symtab_map'  <- readIORef (ud_symtab_map ud)
+#endif
+  putSymbolTable bh symtab_next' symtab_map'
 
   -- write the dictionary pointer at the fornt of the file
   dict_p <- tellBin bh
@@ -92,23 +131,67 @@
   seekBin bh dict_p
 
   -- write the dictionary itself
+#if __GLASGOW_HASKELL__ >= 609
+  dict_next <- readFastMutInt dict_next_ref
+  dict_map  <- readIORef dict_map_ref
+#else
   dict_next <- readFastMutInt (ud_dict_next ud)
   dict_map  <- readIORef (ud_dict_map ud)
+#endif
   putDictionary bh dict_next dict_map
 
-	-- snd send the result to the file
+  -- and send the result to the file
   writeBinMem bh filename
   return ()
 
+type NameCacheAccessor m = (m NameCache, NameCache -> m ())
+
+
+#if __GLASGOW_HASKELL__ >= 609
+nameCacheFromGhc :: NameCacheAccessor Ghc
+nameCacheFromGhc = ( read_from_session , write_to_session )
+  where
+    read_from_session = do
+       ref <- withSession (return . hsc_NC)
+       liftIO $ readIORef ref
+    write_to_session nc' = do
+       ref <- withSession (return . hsc_NC)
+       liftIO $ writeIORef ref nc'
+#else
+nameCacheFromGhc :: Session -> NameCacheAccessor IO
+nameCacheFromGhc session = ( read_from_session , write_to_session )
+  where
+    read_from_session = readIORef . hsc_NC =<< sessionHscEnv session
+    write_to_session nc' = do
+      ref <- liftM hsc_NC $ sessionHscEnv session
+      writeIORef ref nc'
+#endif
+
+
+freshNameCache :: NameCacheAccessor IO
+freshNameCache = ( create_fresh_nc , \_ -> return () )
+  where
+    create_fresh_nc = do
+       u  <- mkSplitUniqSupply 'a' -- ??
+       return (initNameCache u [])
+
 -- | Read a Haddock (@.haddock@) interface file. Return either an 
--- 'InterfaceFile' or an error message. If given a GHC 'Session', the function
--- registers all read names in the name cache of the session.
-readInterfaceFile :: Maybe Session -> FilePath -> IO (Either String InterfaceFile)
-readInterfaceFile mbSession filename = do
-  bh <- readBinMem filename
+-- 'InterfaceFile' or an error message.
+--
+-- This function can be called in two ways.  Within a GHC session it will
+-- update the use and update the session's name cache.  Outside a GHC session
+-- a new empty name cache is used.  The function is therefore generic in the
+-- monad being used.  The exact monad is whichever monad the first
+-- argument, the getter and setter of the name cache, requires.
+--
+readInterfaceFile :: MonadIO m =>
+                     NameCacheAccessor m
+                  -> FilePath -> m (Either String InterfaceFile)
+readInterfaceFile (get_name_cache, set_name_cache) filename = do
+  bh0 <- liftIO $ readBinMem filename
 
-  magic   <- get bh
-  version <- get bh
+  magic   <- liftIO $ get bh0
+  version <- liftIO $ get bh0
 
   case () of
     _ | magic /= binaryInterfaceMagic -> return . Left $
@@ -117,54 +200,93 @@
       "Interface file is of wrong version: " ++ filename
       | otherwise -> do
 
-      -- get the dictionary
-      dict_p <- get bh
-      data_p <- tellBin bh		
-      seekBin bh dict_p
-      dict <- getDictionary bh
-      seekBin bh data_p		
-
-      -- initialise the user-data field of bh
-      ud <- newReadState dict
-      bh <- return (setUserData bh ud)
-
-      -- get the name cache from ghc if we have a ghc session,
-      -- otherwise create a new one
-      (theNC, mbRef) <- case mbSession of
-        Just session -> do
-          ref <- withSession session (return . hsc_NC)
-          nc <- readIORef ref
-          return (nc, Just ref)
-        Nothing -> do
-          -- construct an empty name cache
-          u  <- mkSplitUniqSupply 'a' -- ??
-          return (initNameCache u [], Nothing)
-
-      -- get the symbol table
-      symtab_p <- get bh
-      data_p   <- tellBin bh
-      seekBin bh symtab_p
-      (nc', symtab) <- getSymbolTable bh theNC
-      seekBin bh data_p
+      dict  <- get_dictionary bh0
+      bh1   <- init_handle_user_data bh0 dict
 
-      -- write back the new name cache if we have a ghc session
-      case mbRef of
-        Just ref -> writeIORef ref nc'
-        Nothing  -> return ()
+      theNC <- get_name_cache
+      (nc', symtab) <- get_symbol_table bh1 theNC
+      set_name_cache nc'
 
       -- set the symbol table
-      let ud = getUserData bh
-      bh <- return $! setUserData bh ud{ud_symtab = symtab}
+      let ud' = getUserData bh1
+      bh2 <- return $! setUserData bh1 ud'{ud_symtab = symtab}
 
       -- load the actual data
-      iface <- get bh
+      iface <- liftIO $ get bh2
       return (Right iface)
+ where
+   get_dictionary bin_handle = liftIO $ do
+      dict_p <- get bin_handle
+      data_p <- tellBin bin_handle
+      seekBin bin_handle dict_p
+      dict <- getDictionary bin_handle
+      seekBin bin_handle data_p
+      return dict
 
+   init_handle_user_data bin_handle dict = liftIO $ do
+      ud <- newReadState dict
+      return (setUserData bin_handle ud)
 
+   get_symbol_table bh1 theNC = liftIO $ do
+      symtab_p <- get bh1
+      data_p'  <- tellBin bh1
+      seekBin bh1 symtab_p
+      (nc', symtab) <- getSymbolTable bh1 theNC
+      seekBin bh1 data_p'
+      return (nc', symtab)
+
 -------------------------------------------------------------------------------
 -- Symbol table
 -------------------------------------------------------------------------------
 
+
+#if __GLASGOW_HASKELL__ >= 609
+putName :: BinSymbolTable -> BinHandle -> Name -> IO ()
+putName BinSymbolTable{
+            bin_symtab_map = symtab_map_ref,
+            bin_symtab_next = symtab_next }    bh name
+  = do
+    symtab_map <- readIORef symtab_map_ref
+    case lookupUFM symtab_map name of
+      Just (off,_) -> put_ bh off
+      Nothing -> do
+         off <- readFastMutInt symtab_next
+         writeFastMutInt symtab_next (off+1)
+         writeIORef symtab_map_ref
+             $! addToUFM symtab_map name (off,name)
+         put_ bh off
+
+
+data BinSymbolTable = BinSymbolTable {
+        bin_symtab_next :: !FastMutInt, -- The next index to use
+        bin_symtab_map  :: !(IORef (UniqFM (Int,Name)))
+                                -- indexed by Name
+  }
+
+
+putFastString :: BinDictionary -> BinHandle -> FastString -> IO ()
+putFastString BinDictionary { bin_dict_next = j_r,
+                              bin_dict_map  = out_r}  bh f
+  = do
+    out <- readIORef out_r
+    let unique = getUnique f
+    case lookupUFM out unique of
+        Just (j, _)  -> put_ bh j
+        Nothing -> do
+           j <- readFastMutInt j_r
+           put_ bh j
+           writeFastMutInt j_r (j + 1)
+           writeIORef out_r $! addToUFM out unique (j, f)
+
+
+data BinDictionary = BinDictionary {
+        bin_dict_next :: !FastMutInt, -- The next index to use
+        bin_dict_map  :: !(IORef (UniqFM (Int,FastString)))
+                                -- indexed by FastString
+  }
+#endif
+
+
 putSymbolTable :: BinHandle -> Int -> UniqFM (Int,Name) -> IO ()
 putSymbolTable bh next_off symtab = do
   put_ bh next_off
@@ -189,28 +311,28 @@
    -> NameCache
    -> OnDiskName
    -> (NameCache, Name)
-fromOnDiskName arr nc (pid, mod_name, occ) =
+fromOnDiskName _ nc (pid, mod_name, occ) =
   let 
-        mod   = mkModule pid mod_name
+        modu  = mkModule pid mod_name
         cache = nsNames nc
   in
-  case lookupOrigNameCache cache  mod occ of
+  case lookupOrigNameCache cache modu occ of
      Just name -> (nc, name)
      Nothing   -> 
         let 
                 us        = nsUniqs nc
-                uniq      = uniqFromSupply us
-                name      = mkExternalName uniq mod occ noSrcSpan
-                new_cache = extendNameCache cache mod occ name
+                u         = uniqFromSupply us
+                name      = mkExternalName u modu occ noSrcSpan
+                new_cache = extendNameCache cache modu occ name
         in        
         case splitUniqSupply us of { (us',_) -> 
         ( nc{ nsUniqs = us', nsNames = new_cache }, name )
         }
 
 serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
-serialiseName bh name symtab = do
-  let mod = nameModule name
-  put_ bh (modulePackageId mod, moduleName mod, nameOccName name)
+serialiseName bh name _ = do
+  let modu = nameModule name
+  put_ bh (modulePackageId modu, moduleName modu, nameOccName name)
 
 
 -------------------------------------------------------------------------------
@@ -230,20 +352,20 @@
 
 
 instance Binary InstalledInterface where
-  put_ bh (InstalledInterface mod info docMap exps visExps) = do
-    put_ bh mod
+  put_ bh (InstalledInterface modu info docMap exps visExps) = do
+    put_ bh modu
     put_ bh info
     put_ bh (Map.toList docMap)
     put_ bh exps
     put_ bh visExps
 
   get bh = do
-    mod     <- get bh
+    modu    <- get bh
     info    <- get bh
     docMap  <- get bh
     exps    <- get bh
     visExps <- get bh
-    return (InstalledInterface mod info (Map.fromList docMap) exps visExps)
+    return (InstalledInterface modu info (Map.fromList docMap) exps visExps)
 
 
 instance Binary DocOption where
@@ -310,8 +432,11 @@
     put_ bh (DocURL am) = do
             putByte bh 12
             put_ bh am
-    put_ bh (DocAName an) = do
+    put_ bh (DocPic x) = do
             putByte bh 13
+            put_ bh x
+    put_ bh (DocAName an) = do
+            putByte bh 14
             put_ bh an
     get bh = do
             h <- getByte bh
@@ -356,6 +481,9 @@
                     am <- get bh
                     return (DocURL am)
               13 -> do
+                    x <- get bh
+                    return (DocPic x)
+              14 -> do
                     an <- get bh
                     return (DocAName an)
               _ -> fail "invalid binary data found"
diff --git a/src/Haddock/ModuleTree.hs b/src/Haddock/ModuleTree.hs
--- a/src/Haddock/ModuleTree.hs
+++ b/src/Haddock/ModuleTree.hs
@@ -9,7 +9,11 @@
 import Haddock.DocName
 import GHC           ( HsDoc, Name )
 import Module        ( Module, moduleNameString, moduleName, modulePackageId )
-import PackageConfig ( packageIdString )
+#if __GLASGOW_HASKELL__ >= 609
+import Module (packageIdString)
+#else
+import PackageConfig (packageIdString)
+#endif
 
 data ModuleTree = Node String Bool (Maybe String) (Maybe (HsDoc Name)) [ModuleTree]
 
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_HADDOCK hide #-}
+
 --
 -- Haddock - A Haskell Documentation Tool
 --
@@ -5,24 +7,26 @@
 --
 
 
-{-# OPTIONS_HADDOCK hide #-}
-
-
 module Haddock.Types where
 
 
-import Haddock.GHC.Utils
 import Haddock.DocName
-
 import Data.Map (Map)
 import qualified Data.Map as Map
-
 import GHC hiding (NoLink)
-import Outputable
-import OccName
 import Name
 
 
+-- convenient short-hands
+type Decl = LHsDecl Name
+type Doc  = HsDoc Name
+
+
+-- | A declaration that may have documentation, including its subordinates,
+-- which may also have documentation
+type DeclInfo = (Decl, Maybe Doc, [(Name, Maybe Doc)])
+
+
 {-! for DocOption derive: Binary !-}
 data DocOption
   = OptHide           -- ^ This module should not appear in the docs
@@ -43,6 +47,9 @@
       -- | Maybe a doc comment
       expItemMbDoc :: Maybe (HsDoc name),
 
+      -- | Documentation for subordinate declarations
+      expItemSubDocs :: [(name, HsDoc name)],
+
       -- | Instances relevant to this declaration
       expItemInstances :: [InstHead name]
 	
@@ -116,31 +123,28 @@
   ifaceOrigFilename    :: FilePath,
 
   -- | Textual information about the module 
-  ifaceInfo            :: HaddockModInfo Name,
+  ifaceInfo            :: !(HaddockModInfo Name),
 
   -- | The documentation header for this module
-  ifaceDoc             :: Maybe (HsDoc Name),
+  ifaceDoc             :: !(Maybe (HsDoc Name)),
 
   -- | The renamed documentation header for this module
   ifaceRnDoc           :: Maybe (HsDoc DocName),
 
   -- | The Haddock options for this module (prune, ignore-exports, etc)
-  ifaceOptions         :: [DocOption],
+  ifaceOptions         :: ![DocOption],
 
-  ifaceDeclMap         :: Map Name (LHsDecl Name, Maybe (HsDoc Name)),
+  ifaceDeclMap         :: Map Name DeclInfo,
   ifaceRnDocMap        :: Map Name (HsDoc DocName),
 
-  ifaceExportItems     :: [ExportItem Name],
+  ifaceExportItems     :: ![ExportItem Name],
   ifaceRnExportItems   :: [ExportItem DocName],
 
-  -- | Environment mapping exported names to *original* names
-	ifaceEnv             :: Map OccName Name,
-
   -- | All the names that are defined in this module
-  ifaceLocals          :: [Name],
+  ifaceLocals          :: ![Name],
 
   -- | All the names that are exported by this module
-  ifaceExports         :: [Name],
+  ifaceExports         :: ![Name],
 
   -- | All the visible names exported by this module
   -- For a name to be visible, it has to:
@@ -149,12 +153,10 @@
   --   exception that it can't be from another package.
   -- Basically, a visible name is a name that will show up in the documentation
   -- for this module.
-  ifaceVisibleExports  :: [Name],
-
-  ifaceSubMap          :: Map Name [Name],
+  ifaceVisibleExports  :: ![Name],
 
   -- | The instances exported by this module
-  ifaceInstances       :: [Instance]
+  ifaceInstances       :: ![Instance]
 }
 
 
@@ -194,7 +196,8 @@
   markupDefList       :: [(a,a)] -> a,
   markupCodeBlock     :: a -> a,
   markupURL           :: String -> a,
-  markupAName         :: String -> a
+  markupAName         :: String -> a,
+  markupPic           :: String -> a
 }
 
 
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternSignatures #-}
+
 --
 -- Haddock - A Haskell Documentation Tool
 --
@@ -6,9 +8,6 @@
 --
 
 
-{-# LANGUAGE PatternSignatures #-}
-
-
 module Haddock.Utils (
 
   -- * Misc utilities
@@ -18,9 +17,12 @@
   -- * Filename utilities
   basename, dirname, splitFilename3, 
   moduleHtmlFile, nameHtmlRef,
-  contentsHtmlFile, indexHtmlFile, subIndexHtmlFile, pathJoin,
+  contentsHtmlFile, indexHtmlFile,
+  frameIndexHtmlFile,
+  moduleIndexFrameName, mainFrameName, synopsisFrameName,
+  subIndexHtmlFile, pathJoin,
   anchorNameStr,
-  cssFile, iconFile, jsFile, plusFile, minusFile,
+  cssFile, iconFile, jsFile, plusFile, minusFile, framesFile,
 
   -- * Miscellaneous utilities
   getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,
@@ -37,6 +39,9 @@
 
   -- * Binary extras
 --  FormatVersion, mkFormatVersion  
+  
+  -- * MTL stuff
+  MonadIO(..)
  ) where
 
 import Haddock.Types
@@ -48,16 +53,15 @@
 import OccName
 import Binary
 import Module
-import PackageConfig ( stringToPackageId )
 
-import Control.Monad ( liftM, MonadPlus(..) )
-import Data.Char ( isAlpha, isSpace, toUpper, ord, chr )
+import Control.Monad ( liftM )
+import Data.Char ( isAlpha, ord, chr )
 import Numeric ( showIntAtBase )
 import Data.Map ( Map )
 import qualified Data.Map as Map hiding ( Map )
 import Data.IORef ( IORef, newIORef, readIORef )
-import Data.List ( intersect, isSuffixOf, intersperse )
-import Data.Maybe ( maybeToList, fromMaybe, isJust, fromJust )
+import Data.List ( isSuffixOf )
+import Data.Maybe ( fromJust )
 import Data.Word ( Word8 )
 import Data.Bits ( testBit )
 import System.Environment ( getProgName )
@@ -65,6 +69,14 @@
 import System.IO ( hPutStr, stderr )
 import System.IO.Unsafe	 ( unsafePerformIO )
 
+#if __GLASGOW_HASKELL__ >= 609
+import MonadUtils ( MonadIO(..) )
+#else
+class Monad m => MonadIO m where
+    liftIO :: IO a -> m a                                              
+instance MonadIO IO where liftIO = id
+#endif
+
 -- -----------------------------------------------------------------------------
 -- Some Utilities
 
@@ -89,6 +101,7 @@
     case restrictCons names (tcdCons d) of
       []    -> TyClD (d { tcdND = DataType, tcdCons = [] }) 
       [con] -> TyClD (d { tcdCons = [con] })
+      _ -> error "Should not happen"
   TyClD d | isClassDecl d -> 
     TyClD (d { tcdSigs = restrictDecls names (tcdSigs d),
                tcdATs = restrictATs names (tcdATs d) })
@@ -112,7 +125,7 @@
         field_avail (ConDeclField n _ _) = (unLoc n) `elem` names
         field_types flds = [ t | ConDeclField _ t _ <- flds ] 
       
-    keep d | otherwise = Nothing
+    keep _ | otherwise = Nothing
 
 restrictDecls :: [Name] -> [LSig Name] -> [LSig Name]
 restrictDecls names decls = filter keep decls
@@ -185,6 +198,17 @@
 contentsHtmlFile = "index.html"
 indexHtmlFile = "doc-index.html"
 
+-- | The name of the module index file to be displayed inside a frame.
+-- Modules are display in full, but without indentation.  Clicking opens in
+-- the main window.
+frameIndexHtmlFile :: String
+frameIndexHtmlFile = "index-frames.html"
+
+moduleIndexFrameName, mainFrameName, synopsisFrameName :: String
+moduleIndexFrameName = "modules"
+mainFrameName = "main"
+synopsisFrameName = "synopsis"
+
 subIndexHtmlFile :: Char -> String
 subIndexHtmlFile a = "doc-index-" ++ b ++ ".html"
    where b | isAlpha a = [a]
@@ -206,12 +230,13 @@
 -- -----------------------------------------------------------------------------
 -- Files we need to copy from our $libdir
 
-cssFile, iconFile, jsFile, plusFile,minusFile :: String
+cssFile, iconFile, jsFile, plusFile, minusFile, framesFile :: String
 cssFile   = "haddock.css"
 iconFile  = "haskell_icon.gif"
 jsFile    = "haddock-util.js"
 plusFile  = "plus.gif"
 minusFile = "minus.gif"
+framesFile = "frames.html"
 
 -----------------------------------------------------------------------------
 -- misc.
@@ -258,7 +283,7 @@
         myShowHex :: Int -> ShowS
         myShowHex n r =  case showIntAtBase 16 (toChrHex) n r of
             []  -> "00"
-            [c] -> ['0',c]
+            [a] -> ['0',a]
             cs  -> cs
         toChrHex d
             | d < 10    = chr (ord '0' + fromIntegral d)
@@ -270,6 +295,8 @@
 isUnreserved :: Char -> Bool
 isUnreserved c = isAlphaNumChar c || (c `elem` "-_.~")
 
+
+isAlphaChar, isDigitChar, isAlphaNumChar :: Char -> Bool
 isAlphaChar c    = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')
 isDigitChar c    = (c >= '0' && c <= '9')
 isAlphaNumChar c = isAlphaChar c || isDigitChar c
@@ -299,6 +326,7 @@
 -----------------------------------------------------------------------------
 
 
+replace :: Eq a => a -> a -> [a] -> [a]
 replace a b xs = map (\x -> if x == a then b else x) xs 
 
 
@@ -320,6 +348,7 @@
 markup m (DocCodeBlock d)      = markupCodeBlock m (markup m d)
 markup m (DocURL url)          = markupURL m url
 markup m (DocAName ref)        = markupAName m ref
+markup m (DocPic img)          = markupPic m img
 
 markupPair :: DocMarkup id a -> (HsDoc id, HsDoc id) -> (a, a)
 markupPair m (a,b) = (markup m a, markup m b)
@@ -339,15 +368,11 @@
   markupOrderedList   = DocOrderedList,
   markupDefList       = DocDefList,
   markupCodeBlock     = DocCodeBlock,
-  markupURL	      = DocURL,
-  markupAName	      = DocAName
+  markupURL           = DocURL,
+  markupAName         = DocAName,
+  markupPic           = DocPic
   }
 
--- | Since marking up is just a matter of mapping 'Doc' into some
--- other type, we can \'rename\' documentation by marking up 'Doc' into
--- the same thing, modifying only the identifiers embedded in it.
-
-mapIdent f = idMarkup { markupIdentifier = f }
 
 -----------------------------------------------------------------------------
 -- put here temporarily
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE ForeignFunctionInterface, PatternSignatures #-}
+
 --
 -- Haddock - A Haskell Documentation Tool
 --
@@ -23,22 +25,43 @@
 import Paths_haddock
 
 import Control.Monad
-import Control.Exception
+#if __GLASGOW_HASKELL__ >= 609
+import Control.OldException
+import qualified Control.Exception as NewException
+#else
 import Control.Exception
+#endif
 import Data.Dynamic
 import Data.Maybe
 import Data.IORef
 import qualified Data.Map as Map
+import Data.Version
 import System.IO
 import System.Exit
 import System.Environment
+import System.FilePath
 
-import GHC
+#if defined(mingw32_HOST_OS)
+import Foreign
+import Foreign.C
+import Data.Int
+#endif
+
+#ifndef IN_GHC_TREE
 import GHC.Paths
+#endif
+
+import GHC
 import DynFlags
 import Bag
-import Util (handleDyn)
 import ErrUtils
+#if __GLASGOW_HASKELL__ >= 609
+import Panic (handleGhcException)
+import Util
+import MonadUtils ( MonadIO(..) )
+#else
+import Util hiding (handle)
+#endif
 
 
 --------------------------------------------------------------------------------
@@ -65,28 +88,39 @@
 
 
 handleHaddockExceptions inner = 
-  handleDyn (\(e::HaddockException) -> do
-    putStrLn $ "haddock: " ++ (show e)
-    exitFailure
-  ) inner
+#if __GLASGOW_HASKELL__ >= 609
+  NewException.catches inner [NewException.Handler handler]
+#else
+  handleDyn handler inner
+#endif
+  where
+    handler (e::HaddockException) = do
+      putStrLn $ "haddock: " ++ (show e)
+      exitFailure
 
 
 handleGhcExceptions inner = 
   -- compilation errors: messages with locations attached
-  handleDyn (\dyn -> do
+#if __GLASGOW_HASKELL__ < 609
+ handleDyn (\e -> do
     putStrLn "haddock: Compilation error(s):"
-    printBagOfErrors defaultDynFlags (unitBag dyn)
+    printBagOfErrors defaultDynFlags (unitBag e)
     exitFailure
   ) $
+#endif
 
   -- error messages propagated as exceptions
-  handleDyn (\dyn -> do
+#if __GLASGOW_HASKELL__ >= 609
+  handleGhcException (\e -> do
+#else
+  handleDyn (\e -> do
+#endif
     hFlush stdout
-    case dyn of
+    case e of
       PhaseFailed _ code -> exitWith code
       Interrupted -> exitFailure
       _ -> do 
-        print (dyn :: GhcException)
+        print (e :: GhcException)
         exitFailure
   ) inner
 
@@ -113,35 +147,63 @@
   if not (null fileArgs)
     then do
 
-      let libDir
-            | Just dir <- getGhcLibDir flags = dir
-            | otherwise = libdir -- from GHC.Paths
+      libDir <- case getGhcLibDir flags of
+                Just dir -> return dir
+                Nothing ->
+#ifdef IN_GHC_TREE
+                    do m <- getExecDir
+                       case m of
+                           Nothing -> error "No GhcLibDir found"
+                           Just d -> return (d </> "..")
+#else
+                    return libdir -- from GHC.Paths
+#endif
 
+#if __GLASGOW_HASKELL__ >= 609
       -- initialize GHC
+      startGhc libDir (ghcFlags flags) $ \dynflags -> do
+
+        -- get packages supplied with --read-interface
+        packages <- readInterfaceFiles nameCacheFromGhc (ifacePairs flags)
+
+        -- combine the link envs of the external packages into one
+        let extLinks = Map.unions (map (ifLinkEnv . fst) packages)
+
+        -- create the interfaces -- this is the core part of Haddock
+        (interfaces, homeLinks) <- createInterfaces fileArgs extLinks flags
+
+        let visibleIfaces = [ i | i <- interfaces, OptHide `notElem` ifaceOptions i ]
+ 
+        liftIO $ do
+          -- render the interfaces
+          renderStep packages visibleIfaces
+ 
+          -- last but not least, dump the interface file
+          dumpInterfaceFile (map toInstalledIface visibleIfaces) homeLinks flags
+#else
+      -- initialize GHC
       (session, dynflags) <- startGhc libDir (ghcFlags flags)
 
       -- get packages supplied with --read-interface
-      packages <- readInterfaceFiles (Just session) (ifacePairs flags)
-
-      -- typecheck argument modules using GHC
-      modules <- typecheckFiles session fileArgs
+      packages <- readInterfaceFiles (nameCacheFromGhc session) (ifacePairs flags)
 
       -- combine the link envs of the external packages into one
       let extLinks = Map.unions (map (ifLinkEnv . fst) packages)
 
       -- create the interfaces -- this is the core part of Haddock
-      let (interfaces, homeLinks, messages) = createInterfaces modules extLinks flags
-      mapM_ putStrLn messages
+      (interfaces, homeLinks) <- createInterfaces session fileArgs extLinks flags
 
+      let visibleIfaces = [ i | i <- interfaces, OptHide `notElem` ifaceOptions i ]
+
       -- render the interfaces
-      renderStep packages interfaces
+      renderStep packages visibleIfaces
  
       -- last but not least, dump the interface file
-      dumpInterfaceFile (map toInstalledIface interfaces) homeLinks flags
-
+      dumpInterfaceFile (map toInstalledIface visibleIfaces) homeLinks flags
+#endif
     else do
       -- get packages supplied with --read-interface
-      packages <- readInterfaceFiles Nothing (ifacePairs flags)
+      packages <- readInterfaceFiles freshNameCache (ifacePairs flags)
 
       -- render even though there are no input files (usually contents/index)
       renderStep packages []
@@ -154,7 +216,7 @@
 
 -- | Render the interfaces with whatever backend is specified in the flags 
 render :: [Flag] -> [Interface] -> [InstalledInterface] -> IO ()
-render flags interfaces installedIfaces = do
+render flags visibleIfaces installedIfaces = do
   let
     title = case [str | Flag_Heading str <- flags] of
 		[] -> ""
@@ -171,7 +233,15 @@
     verbose = Flag_Verbose `elem` flags
 
   libdir <- case [str | Flag_Lib str <- flags] of
-		[] -> getDataDir -- provided by Cabal
+		[] ->
+#ifdef IN_GHC_TREE
+                      do m <- getExecDir
+                         case m of
+                             Nothing -> error "No libdir found"
+                             Just d -> return (d </> "..")
+#else
+                      getDataDir -- provided by Cabal
+#endif
 		fs -> return (last fs)
 
   let css_file = case [str | Flag_CSS str <- flags] of
@@ -201,9 +271,6 @@
   prologue <- getPrologue flags
 
   let 
-    -- visible home-module interfaces
-    visibleIfaces = [ m | m <- interfaces, OptHide `notElem` (ifaceOptions m) ]
-
     -- *all* visible interfaces including external package modules
     allVisibleIfaces = map toInstalledIface visibleIfaces
                        ++ installedIfaces
@@ -236,24 +303,26 @@
     copyHtmlBits odir libdir css_file
 
   when (Flag_Hoogle `elem` flags) $ do
-    ppHoogle pkgName pkgVer visibleIfaces odir
+    ppHoogle pkgName pkgVer title prologue visibleIfaces odir
 
 -------------------------------------------------------------------------------
 -- Reading and dumping interface files
 -------------------------------------------------------------------------------
 
 
-readInterfaceFiles :: Maybe Session -> [(FilePath, FilePath)] ->
-                      IO [(InterfaceFile, FilePath)]
-readInterfaceFiles session pairs = do
+readInterfaceFiles :: MonadIO m =>
+                      NameCacheAccessor m
+                   -> [(FilePath, FilePath)] ->
+                      m [(InterfaceFile, FilePath)]
+readInterfaceFiles name_cache_accessor pairs = do
   mbPackages <- mapM tryReadIface pairs
   return (catMaybes mbPackages)
   where
     -- try to read an interface, warn if we can't
     tryReadIface (html, iface) = do
-      eIface <- readInterfaceFile session iface
+      eIface <- readInterfaceFile name_cache_accessor iface
       case eIface of
-        Left err -> do
+        Left err -> liftIO $ do
           putStrLn ("Warning: Cannot read " ++ iface ++ ":")
           putStrLn ("   " ++ show err)
           putStrLn "Skipping this interface."
@@ -321,3 +390,21 @@
 		Left err -> throwE err
 		Right doc -> return (Just doc)
 	_otherwise -> throwE "multiple -p/--prologue options"
+
+getExecDir :: IO (Maybe String)
+#if defined(mingw32_HOST_OS)
+getExecDir = allocaArray len $ \buf -> do
+    ret <- getModuleFileName nullPtr buf len
+    if ret == 0
+        then return Nothing
+        else do s <- peekCString buf
+                return (Just (dropFileName s))
+  where len = 2048 -- Plenty, PATH_MAX is 512 under Win32.
+
+foreign import stdcall unsafe  "GetModuleFileNameA"
+  getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
+#else
+getExecDir = return Nothing
+#endif
+
+