Merge pull request #857 from sjakobi/ghc-head-update-3

Update ghc-head

4 files changed, 187 insertions, 149 deletions

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index fe33fbe9..819c9aa6 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -52,36 +52,37 @@ ppDecl :: Bool                                     -- ^ print summary info only
        -> [(DocName, DocForDecl DocName)]          -- ^ documentation for all decls
        -> Splice
        -> Unicode                                  -- ^ unicode output
+       -> Maybe Package
        -> Qualification
        -> Html
-ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode qual = case decl of
-  TyClD _ (FamDecl _ d)          -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
-  TyClD _ d@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats splice unicode qual
-  TyClD _ d@(SynDecl {})         -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
-  TyClD _ d@(ClassDecl {})       -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
+ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode pkg qual = case decl of
+  TyClD _ (FamDecl _ d)          -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode pkg qual
+  TyClD _ d@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats splice unicode pkg qual
+  TyClD _ d@(SynDecl {})         -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode pkg qual
+  TyClD _ d@(ClassDecl {})       -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode pkg qual
   SigD _ (TypeSig _ lnames lty)  -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
-                                         (hsSigWcType lty) fixities splice unicode qual
+                                         (hsSigWcType lty) fixities splice unicode pkg qual
   SigD _ (PatSynSig _ lnames lty) -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lnames
-                                         (hsSigType lty) fixities splice unicode qual
-  ForD _ d                       -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
+                                         (hsSigType lty) fixities splice unicode pkg qual
+  ForD _ d                       -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode pkg qual
   InstD _ _                      -> noHtml
   DerivD _ _                     -> noHtml
-  _                              -> error "declaration not supported by ppDecl"
+  _                            -> error "declaration not supported by ppDecl"
 
 
 ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
              [Located DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->
-             Splice -> Unicode -> Qualification -> Html
-ppLFunSig summary links loc doc lnames lty fixities splice unicode qual =
+             Splice -> Unicode -> Maybe Package -> Qualification -> Html
+ppLFunSig summary links loc doc lnames lty fixities splice unicode pkg qual =
   ppFunSig summary links loc doc (map unLoc lnames) lty fixities
-           splice unicode qual
+           splice unicode pkg qual
 
 ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
             [DocName] -> LHsType DocNameI -> [(DocName, Fixity)] ->
-            Splice -> Unicode -> Qualification -> Html
-ppFunSig summary links loc doc docnames typ fixities splice unicode qual =
+            Splice -> Unicode -> Maybe Package -> Qualification -> Html
+ppFunSig summary links loc doc docnames typ fixities splice unicode pkg qual =
   ppSigLike summary links loc mempty doc docnames fixities (unLoc typ, pp_typ)
-            splice unicode qual HideEmptyContexts
+            splice unicode pkg qual HideEmptyContexts
   where
     pp_typ = ppLType unicode qual HideEmptyContexts typ
 
@@ -90,25 +91,25 @@ ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
           -> [Located DocName]     -- ^ names of patterns in declaration
           -> LHsType DocNameI      -- ^ type of patterns in declaration
           -> [(DocName, Fixity)]
-          -> Splice -> Unicode -> Qualification -> Html
-ppLPatSig summary links loc doc lnames typ fixities splice unicode qual =
+          -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
+ppLPatSig summary links loc doc lnames typ fixities splice unicode pkg qual =
   ppSigLike summary links loc (keyword "pattern") doc (map unLoc lnames) fixities
-            (unLoc typ, pp_typ) splice unicode qual (patSigContext typ)
+            (unLoc typ, pp_typ) splice unicode pkg qual (patSigContext typ)
   where
     pp_typ = ppPatSigType unicode qual typ
 
 
 ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
              [DocName] -> [(DocName, Fixity)] -> (HsType DocNameI, Html) ->
-             Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html
+             Splice -> Unicode -> Maybe Package -> Qualification -> HideEmptyContexts -> Html
 ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
-          splice unicode qual emptyCtxts =
+          splice unicode pkg qual emptyCtxts =
   ppTypeOrFunSig summary links loc docnames typ doc
     ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode
     , (leader <+>) . addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames
     , dcolon unicode
     )
-    splice unicode qual emptyCtxts
+    splice unicode pkg qual emptyCtxts
   where
     occnames = map (nameOccName . getName) docnames
     addFixities html
@@ -118,13 +119,15 @@ ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
 
 ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocNameI
                -> DocForDecl DocName -> (Html, Html, Html)
-               -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> Html
-ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep) splice unicode qual emptyCtxts
+               -> Splice -> Unicode -> Maybe Package -> Qualification
+               -> HideEmptyContexts -> Html
+ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
+               splice unicode pkg qual emptyCtxts
   | summary = pref1
-  | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName qual doc
+  | Map.null argDocs = topDeclElem links loc splice docnames pref1 +++ docSection curName pkg qual doc
   | otherwise = topDeclElem links loc splice docnames pref2
-                  +++ subArguments qual (ppSubSigLike unicode qual typ argDocs [] sep emptyCtxts)
-                  +++ docSection curName qual doc
+                  +++ subArguments pkg qual (ppSubSigLike unicode qual typ argDocs [] sep emptyCtxts)
+                  +++ docSection curName pkg qual doc
   where
     curName = getName <$> listToMaybe docnames
 
@@ -225,23 +228,23 @@ tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
 
 ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
       -> ForeignDecl DocNameI -> [(DocName, Fixity)]
-      -> Splice -> Unicode -> Qualification -> Html
+      -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppFor summary links loc doc (ForeignImport _ (L _ name) typ _) fixities
-      splice unicode qual
-  = ppFunSig summary links loc doc [name] (hsSigType typ) fixities splice unicode qual
-ppFor _ _ _ _ _ _ _ _ _ = error "ppFor"
+      splice unicode pkg qual
+  = ppFunSig summary links loc doc [name] (hsSigType typ) fixities splice unicode pkg qual
+ppFor _ _ _ _ _ _ _ _ _ _ = error "ppFor"
 
 
 -- we skip type patterns for now
 ppTySyn :: Bool -> LinksInfo -> [(DocName, Fixity)] -> SrcSpan
         -> DocForDecl DocName -> TyClDecl DocNameI
-        -> Splice -> Unicode -> Qualification -> Html
+        -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
                                                 , tcdRhs = ltype })
-        splice unicode qual
+        splice unicode pkg qual
   = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc
                    (full <+> fixs, hdr <+> fixs, spaceHtml +++ equals)
-                   splice unicode qual ShowEmptyToplevelContexts
+                   splice unicode pkg qual ShowEmptyToplevelContexts
   where
     hdr  = hsep ([keyword "type", ppBinder summary occ]
                  ++ ppTyVars unicode qual (hsQTvExplicit ltyvars))
@@ -250,7 +253,7 @@ ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars
     fixs
       | summary   = noHtml
       | otherwise = ppFixities fixities qual
-ppTySyn _ _ _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn"
+ppTySyn _ _ _ _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn"
 
 
 ppTypeSig :: Bool -> [OccName] -> Html -> Unicode -> Html
@@ -343,11 +346,13 @@ ppInjectivityAnn unicode qual (InjectivityAnn lhs rhs) =
 
 ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocNameI] ->
            [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->
-           FamilyDecl DocNameI -> Splice -> Unicode -> Qualification -> Html
-ppTyFam summary associated links instances fixities loc doc decl splice unicode qual
+           FamilyDecl DocNameI -> Splice -> Unicode -> Maybe Package ->
+           Qualification -> Html
+ppTyFam summary associated links instances fixities loc doc decl splice unicode
+        pkg qual
 
   | summary   = ppTyFamHeader True associated decl unicode qual
-  | otherwise = header_ +++ docSection Nothing qual doc +++ instancesBit
+  | otherwise = header_ +++ docSection Nothing pkg qual doc +++ instancesBit
 
   where
     docname = unLoc $ fdLName decl
@@ -358,10 +363,10 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
     instancesBit
       | FamilyDecl { fdInfo = ClosedTypeFamily mb_eqns } <- decl
       , not summary
-      = subEquations qual $ map (ppTyFamEqn . unLoc) $ fromMaybe [] mb_eqns
+      = subEquations pkg qual $ map (ppTyFamEqn . unLoc) $ fromMaybe [] mb_eqns
 
       | otherwise
-      = ppInstances links (OriginFamily docname) instances splice unicode qual
+      = ppInstances links (OriginFamily docname) instances splice unicode pkg qual
 
     -- Individual equation of a closed type family
     ppTyFamEqn :: TyFamInstEqn DocNameI -> SubDecl
@@ -391,9 +396,10 @@ ppPseudoFamilyDecl links splice unicode qual
 
 
 ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocNameI
-            -> [(DocName, Fixity)] -> Splice -> Unicode -> Qualification -> Html
-ppAssocType summ links doc (L loc decl) fixities splice unicode qual =
-   ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode qual
+            -> [(DocName, Fixity)] -> Splice -> Unicode -> Maybe Package
+            -> Qualification -> Html
+ppAssocType summ links doc (L loc decl) fixities splice unicode pkg qual =
+   ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode pkg qual
 
 
 --------------------------------------------------------------------------------
@@ -503,23 +509,23 @@ ppFds fds unicode qual =
 
 ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocNameI -> SrcSpan
                  -> [(DocName, DocForDecl DocName)]
-                 -> Splice -> Unicode -> Qualification -> Html
+                 -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = tvs
                                           , tcdFDs = fds, tcdSigs = sigs, tcdATs = ats }) loc
-    subdocs splice unicode qual =
+    subdocs splice unicode pkg qual =
   if not (any isUserLSig sigs) && null ats
     then (if summary then id else topDeclElem links loc splice [nm]) hdr
     else (if summary then id else topDeclElem links loc splice [nm]) (hdr <+> keyword "where")
       +++ shortSubDecls False
           (
-            [ ppAssocType summary links doc at [] splice unicode qual | at <- ats
+            [ ppAssocType summary links doc at [] splice unicode pkg qual | at <- ats
               , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ]  ++
 
                 -- ToDo: add associated type defaults
 
-            [ ppFunSig summary links loc doc names (hsSigWcType typ)
-                       [] splice unicode qual
-              | L _ (TypeSig _ lnames typ) <- sigs
+            [ ppFunSig summary links loc doc names (hsSigType typ)
+                       [] splice unicode pkg qual
+              | L _ (ClassOpSig _ False lnames typ) <- sigs
               , let doc = lookupAnySubdoc (head names) subdocs
                     names = map unLoc lnames ]
               -- FIXME: is taking just the first name ok? Is it possible that
@@ -529,20 +535,20 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
   where
     hdr = ppClassHdr summary lctxt (unLoc lname) tvs fds unicode qual
     nm  = unLoc lname
-ppShortClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
+ppShortClassDecl _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
 
 
 
 ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocNameI] -> [(DocName, Fixity)]
             -> SrcSpan -> Documentation DocName
             -> [(DocName, DocForDecl DocName)] -> TyClDecl DocNameI
-            -> Splice -> Unicode -> Qualification -> Html
+            -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppClassDecl summary links instances fixities loc d subdocs
         decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars
                         , tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats })
-            splice unicode qual
-  | summary = ppShortClassDecl summary links decl loc subdocs splice unicode qual
-  | otherwise = classheader +++ docSection Nothing qual d
+            splice unicode pkg qual
+  | summary = ppShortClassDecl summary links decl loc subdocs splice unicode pkg qual
+  | otherwise = classheader +++ docSection Nothing pkg qual d
                   +++ minimalBit +++ atBit +++ methodBit +++ instancesBit
   where
     sigs = map unLoc lsigs
@@ -559,32 +565,32 @@ ppClassDecl summary links instances fixities loc d subdocs
     hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
 
     -- ToDo: add assocatied typ defaults
-    atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs splice unicode qual
+    atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs splice unicode pkg qual
                       | at <- ats
                       , let n = unL . fdLName $ unL at
                             doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs
                             subfixs = [ f | f@(n',_) <- fixities, n == n' ] ]
 
-    methodBit = subMethods [ ppFunSig summary links loc doc names (hsSigType typ)
-                                      subfixs splice unicode qual
+    methodBit = subMethods [ ppFunSig summary links loc doc [name] (hsSigType typ)
+                                      subfixs splice unicode pkg qual
                            | L _ (ClassOpSig _ _ lnames typ) <- lsigs
-                           , let doc = lookupAnySubdoc (head names) subdocs
-                                 subfixs = [ f | n <- names
-                                               , f@(n',_) <- fixities
-                                               , n == n' ]
-                                 names = map unLoc lnames ]
+                           , name <- map unLoc lnames
+                           , let doc = lookupAnySubdoc name subdocs
+                                 subfixs = [ f | f@(n',_) <- fixities
+                                               , name == n' ]
+                           ]
                            -- N.B. taking just the first name is ok. Signatures with multiple names
                            -- are expanded so that each name gets its own signature.
 
     minimalBit = case [ s | MinimalSig _ _ (L _ s) <- sigs ] of
       -- Miminal complete definition = every shown method
       And xs : _ | sort [getName n | L _ (Var (L _ n)) <- xs] ==
-                   sort [getName n | TypeSig _ ns _ <- sigs, L _ n <- ns]
+                   sort [getName n | ClassOpSig _ _ ns _ <- sigs, L _ n <- ns]
         -> noHtml
 
       -- Minimal complete definition = the only shown method
       Var (L _ n) : _ | [getName n] ==
-                        [getName n' | L _ (TypeSig _ ns _) <- lsigs, L _ n' <- ns]
+                        [getName n' | L _ (ClassOpSig _ _ ns _) <- lsigs, L _ n' <- ns]
         -> noHtml
 
       -- Minimal complete definition = nothing
@@ -600,38 +606,38 @@ ppClassDecl summary links instances fixities loc d subdocs
     ppMinimal p (Parens x) = ppMinimal p (unLoc x)
 
     instancesBit = ppInstances links (OriginClass nm) instances
-        splice unicode qual
+        splice unicode pkg qual
 
-ppClassDecl _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
+ppClassDecl _ _ _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
 
 
 ppInstances :: LinksInfo
             -> InstOrigin DocName -> [DocInstance DocNameI]
-            -> Splice -> Unicode -> Qualification
+            -> Splice -> Unicode -> Maybe Package -> Qualification
             -> Html
-ppInstances links origin instances splice unicode qual
-  = subInstances qual instName links True (zipWith instDecl [1..] instances)
+ppInstances links origin instances splice unicode pkg qual
+  = subInstances pkg qual instName links True (zipWith instDecl [1..] instances)
   -- force Splice = True to use line URLs
   where
     instName = getOccString origin
     instDecl :: Int -> DocInstance DocNameI -> (SubDecl,Located DocName)
-    instDecl no (inst, mdoc, loc) =
-        ((ppInstHead links splice unicode qual mdoc origin False no inst), loc)
+    instDecl no (inst, mdoc, loc, mdl) =
+        ((ppInstHead links splice unicode qual mdoc origin False no inst mdl), loc)
 
 
 ppOrphanInstances :: LinksInfo
                   -> [DocInstance DocNameI]
-                  -> Splice -> Unicode -> Qualification
+                  -> Splice -> Unicode -> Maybe Package -> Qualification
                   -> Html
-ppOrphanInstances links instances splice unicode qual
-  = subOrphanInstances qual links True (zipWith instDecl [1..] instances)
+ppOrphanInstances links instances splice unicode pkg qual
+  = subOrphanInstances pkg qual links True (zipWith instDecl [1..] instances)
   where
     instOrigin :: InstHead name -> InstOrigin (IdP name)
     instOrigin inst = OriginClass (ihdClsName inst)
 
     instDecl :: Int -> DocInstance DocNameI -> (SubDecl,Located DocName)
-    instDecl no (inst, mdoc, loc) =
-        ((ppInstHead links splice unicode qual mdoc (instOrigin inst) True no inst), loc)
+    instDecl no (inst, mdoc, loc, mdl) =
+        ((ppInstHead links splice unicode qual mdoc (instOrigin inst) True no inst mdl), loc)
 
 
 ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
@@ -640,13 +646,14 @@ ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification
            -> Bool -- ^ Is instance orphan
            -> Int  -- ^ Normal
            -> InstHead DocNameI
+           -> Maybe Module
            -> SubDecl
-ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
+ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) mdl =
     case ihdInstType of
         ClassInst { .. } ->
             ( subInstHead iid $ ppContextNoLocs clsiCtx unicode qual HideEmptyContexts <+> typ
             , mdoc
-            , [subInstDetails iid ats sigs]
+            , [subInstDetails iid ats sigs mname]
             )
           where
             sigs = ppInstanceSigs links splice unicode qual clsiSigs
@@ -654,7 +661,7 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
         TypeInst rhs ->
             ( subInstHead iid ptype
             , mdoc
-            , [subFamInstDetails iid prhs]
+            , [subFamInstDetails iid prhs mname]
             )
           where
             ptype = keyword "type" <+> typ
@@ -663,11 +670,12 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) =
         DataInst dd ->
             ( subInstHead iid pdata
             , mdoc
-            , [subFamInstDetails iid pdecl])
+            , [subFamInstDetails iid pdecl mname])
           where
             pdata = keyword "data" <+> typ
             pdecl = pdata <+> ppShortDataDecl False True dd [] unicode qual
   where
+    mname = maybe noHtml (\m -> toHtml "Defined in" <+> ppModule m) mdl
     iid = instanceId origin no orphan ihd
     typ = ppAppNameTypes ihdClsName ihdTypes unicode qual
 
@@ -766,12 +774,12 @@ ppDataDecl :: Bool -> LinksInfo
            -> Documentation DocName                   -- ^ this decl's documentation
            -> TyClDecl DocNameI                       -- ^ this decl
            -> [(HsDecl DocNameI, DocForDecl DocName)] -- ^ relevant patterns
-           -> Splice -> Unicode -> Qualification -> Html
+           -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
 ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
-           splice unicode qual
+           splice unicode pkg qual
 
   | summary   = ppShortDataDecl summary False dataDecl pats unicode qual
-  | otherwise = header_ +++ docSection Nothing qual doc +++ constrBit +++ patternBit +++ instancesBit
+  | otherwise = header_ +++ docSection Nothing pkg qual doc +++ constrBit +++ patternBit +++ instancesBit
 
   where
     docname   = tcdName dataDecl
@@ -792,14 +800,14 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
       | null cons = keyword "where"
       | otherwise = if isH98 then noHtml else keyword "where"
 
-    constrBit = subConstructors qual
-      [ ppSideBySideConstr subdocs subfixs unicode qual c
+    constrBit = subConstructors pkg qual
+      [ ppSideBySideConstr subdocs subfixs unicode pkg qual c
       | c <- cons
       , let subfixs = filter (\(n,_) -> any (\cn -> cn == n)
                                             (map unLoc (getConNames (unLoc c)))) fixities
       ]
 
-    patternBit = subPatterns qual
+    patternBit = subPatterns pkg qual
       [ ppSideBySidePat subfixs unicode qual lnames typ d
       | (SigD _ (PatSynSig _ lnames typ), d) <- pats
       , let subfixs = filter (\(n,_) -> any (\cn -> cn == n)
@@ -807,7 +815,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl pats
       ]
 
     instancesBit = ppInstances links (OriginData docname) instances
-        splice unicode qual
+        splice unicode pkg qual
 
 
 ppShortConstr :: Bool -> ConDecl DocNameI -> Unicode -> Qualification -> Html
@@ -872,10 +880,10 @@ ppShortConstrParts summary dataInst con unicode qual
 
 -- | Pretty print an expanded constructor
 ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)]
-                   -> Unicode -> Qualification
+                   -> Unicode -> Maybe Package -> Qualification
                    -> LConDecl DocNameI -- ^ constructor declaration to print
                    -> SubDecl
-ppSideBySideConstr subdocs fixities unicode qual (L _ con)
+ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
  = ( decl       -- Constructor header (name, fixity)
    , mbDoc      -- Docs on the whole constructor
    , fieldPart  -- Information on the fields (or arguments, if they have docs)
@@ -949,10 +957,10 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
 
         _ -> []
 
-    doRecordFields fields = subFields qual
+    doRecordFields fields = subFields pkg qual
       (map (ppSideBySideField subdocs unicode qual) (map unLoc fields))
 
-    doConstrArgsWithDocs args = subFields qual $ case con of
+    doConstrArgsWithDocs args = subFields pkg qual $ case con of
       ConDeclH98{} ->
         [ (ppLParendType unicode qual HideEmptyContexts arg, mdoc, [])
         | (i, arg) <- zip [0..] args
@@ -1041,7 +1049,7 @@ ppSideBySidePat fixities unicode qual lnames typ (doc, argDocs) =
 
     fieldPart
       | not hasArgDocs = []
-      | otherwise = [ subFields qual (ppSubSigLike unicode qual (unLoc patTy)
+      | otherwise = [ subFields Nothing qual (ppSubSigLike unicode qual (unLoc patTy)
                                                         argDocs [] (dcolon unicode)
                                                         emptyCtxt) ]
 
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index e63667b0..ed323a90 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -73,7 +73,8 @@ parHtmlMarkup qual insertAnchors ppId = Markup {
   markupMathDisplay          = \mathjax -> toHtml ("\\[" ++ mathjax ++ "\\]"),
   markupProperty             = pre . toHtml,
   markupExample              = examplesToHtml,
-  markupHeader               = \(Header l t) -> makeHeader l t
+  markupHeader               = \(Header l t) -> makeHeader l t,
+  markupTable                = \(Table h r) -> makeTable h r
   }
   where
     makeHeader :: Int -> Html -> Html
@@ -85,6 +86,22 @@ parHtmlMarkup qual insertAnchors ppId = Markup {
     makeHeader 6 mkup = h6 mkup
     makeHeader l _ = error $ "Somehow got a header level `" ++ show l ++ "' in DocMarkup!"
 
+    makeTable :: [TableRow Html] -> [TableRow Html] -> Html
+    makeTable hs bs = table (concatHtml (hs' ++ bs'))
+      where
+        hs' | null hs   = []
+            | otherwise = [thead (concatHtml (map (makeTableRow th) hs))]
+
+        bs' = [tbody (concatHtml (map (makeTableRow td) bs))]
+
+    makeTableRow :: (Html -> Html) -> TableRow Html -> Html
+    makeTableRow thr (TableRow cs) = tr (concatHtml (map (makeTableCell thr) cs))
+
+    makeTableCell :: (Html -> Html) -> TableCell Html -> Html
+    makeTableCell thr (TableCell i j c) = thr c ! (i' ++ j')
+      where
+        i' = if i == 1 then [] else [ colspan i ]
+        j' = if j == 1 then [] else [ rowspan j ]
 
     examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"]
 
@@ -154,10 +171,10 @@ flatten x = [x]
 -- extract/append the underlying 'Doc' and convert it to 'Html'. For
 -- 'CollapsingHeader', we attach extra info to the generated 'Html'
 -- that allows us to expand/collapse the content.
-hackMarkup :: DocMarkup id Html -> Hack (ModuleName, OccName) id -> Html
-hackMarkup fmt' h' =
+hackMarkup :: DocMarkup id Html -> Maybe Package -> Hack (ModuleName, OccName) id -> Html
+hackMarkup fmt' currPkg h' =
   let (html, ms) = hackMarkup' fmt' h'
-  in html +++ renderMeta fmt' (metaConcat ms)
+  in html +++ renderMeta fmt' currPkg (metaConcat ms)
   where
     hackMarkup' :: DocMarkup id Html -> Hack (ModuleName, OccName) id
                 -> (Html, [Meta])
@@ -176,45 +193,50 @@ hackMarkup fmt' h' =
                              (y, m') = hackMarkup' fmt d'
                          in (markupAppend fmt x y, m ++ m')
 
-renderMeta :: DocMarkup id Html -> Meta -> Html
-renderMeta fmt (Meta { _version = Just x }) =
+renderMeta :: DocMarkup id Html -> Maybe Package -> Meta -> Html
+renderMeta fmt currPkg (Meta { _version = Just x, _package = pkg }) =
   markupParagraph fmt . markupEmphasis fmt . toHtml $
-    "Since: " ++ formatVersion x
+    "Since: " ++ formatPkgMaybe pkg ++ formatVersion x
   where
     formatVersion v = concat . intersperse "." $ map show v
-renderMeta _ _ = noHtml
+    formatPkgMaybe (Just p) | Just p /= currPkg = p ++ "-"
+    formatPkgMaybe _ = ""
+renderMeta _ _ _ = noHtml
 
 -- | Goes through 'hackMarkup' to generate the 'Html' rather than
 -- skipping straight to 'markup': this allows us to employ XHtml
 -- specific hacks to the tree first.
 markupHacked :: DocMarkup id Html
+             -> Maybe Package      -- this package
              -> Maybe String
              -> MDoc id
              -> Html
-markupHacked fmt n = hackMarkup fmt . toHack 0 n . flatten
+markupHacked fmt currPkg n = hackMarkup fmt currPkg . toHack 0 n . flatten
 
 -- If the doc is a single paragraph, don't surround it with <P> (this causes
 -- ugly extra whitespace with some browsers).  FIXME: Does this still apply?
-docToHtml :: Maybe String -- ^ Name of the thing this doc is for. See
-                          -- comments on 'toHack' for details.
+docToHtml :: Maybe String  -- ^ Name of the thing this doc is for. See
+                           -- comments on 'toHack' for details.
+          -> Maybe Package -- ^ Current package
           -> Qualification -> MDoc DocName -> Html
-docToHtml n qual = markupHacked fmt n . cleanup
+docToHtml n pkg qual = markupHacked fmt pkg n . cleanup
   where fmt = parHtmlMarkup qual True (ppDocName qual Raw)
 
 -- | Same as 'docToHtml' but it doesn't insert the 'anchor' element
 -- in links. This is used to generate the Contents box elements.
-docToHtmlNoAnchors :: Maybe String -- ^ See 'toHack'
+docToHtmlNoAnchors :: Maybe String  -- ^ See 'toHack'
+                   -> Maybe Package -- ^ Current package
                    -> Qualification -> MDoc DocName -> Html
-docToHtmlNoAnchors n qual = markupHacked fmt n . cleanup
+docToHtmlNoAnchors n pkg qual = markupHacked fmt pkg n . cleanup
   where fmt = parHtmlMarkup qual False (ppDocName qual Raw)
 
-origDocToHtml :: Qualification -> MDoc Name -> Html
-origDocToHtml qual = markupHacked fmt Nothing . cleanup
+origDocToHtml :: Maybe Package -> Qualification -> MDoc Name -> Html
+origDocToHtml pkg qual = markupHacked fmt pkg Nothing . cleanup
   where fmt = parHtmlMarkup qual True (const $ ppName Raw)
 
 
-rdrDocToHtml :: Qualification -> MDoc RdrName -> Html
-rdrDocToHtml qual = markupHacked fmt Nothing . cleanup
+rdrDocToHtml :: Maybe Package -> Qualification -> MDoc RdrName -> Html
+rdrDocToHtml pkg qual = markupHacked fmt pkg Nothing . cleanup
   where fmt = parHtmlMarkup qual True (const ppRdrName)
 
 
@@ -226,14 +248,17 @@ docElement el content_ =
 
 
 docSection :: Maybe Name -- ^ Name of the thing this doc is for
+           -> Maybe Package -- ^ Current package
            -> Qualification -> Documentation DocName -> Html
-docSection n qual = maybe noHtml (docSection_ n qual) . combineDocumentation
+docSection n pkg qual =
+  maybe noHtml (docSection_ n pkg qual) . combineDocumentation
 
 
-docSection_ :: Maybe Name -- ^ Name of the thing this doc is for
+docSection_ :: Maybe Name    -- ^ Name of the thing this doc is for
+            -> Maybe Package -- ^ Current package
             -> Qualification -> MDoc DocName -> Html
-docSection_ n qual =
-  (docElement thediv <<) . docToHtml (getOccString <$> n) qual
+docSection_ n pkg qual =
+  (docElement thediv <<) . docToHtml (getOccString <$> n) pkg qual
 
 
 cleanup :: MDoc a -> MDoc a
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index e020b909..501caa4b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -47,7 +47,7 @@ import Haddock.Backends.Xhtml.Utils
 import Haddock.Types
 import Haddock.Utils (makeAnchorId, nameAnchorId)
 import qualified Data.Map as Map
-import Text.XHtml hiding ( name, title, p, quote )
+import Text.XHtml hiding ( name, title, quote )
 
 import FastString            ( unpackFS )
 import GHC
@@ -128,38 +128,39 @@ divSubDecls cssClass captionName = maybe noHtml wrap
     subCaption = paragraph ! [theclass "caption"] << captionName
 
 
-subDlist :: Qualification -> [SubDecl] -> Maybe Html
-subDlist _ [] = Nothing
-subDlist qual decls = Just $ ulist << map subEntry decls
+subDlist :: Maybe Package -> Qualification -> [SubDecl] -> Maybe Html
+subDlist _ _ [] = Nothing
+subDlist pkg qual decls = Just $ ulist << map subEntry decls
   where
     subEntry (decl, mdoc, subs) =
       li <<
         (define ! [theclass "src"] << decl +++
-         docElement thediv << (fmap (docToHtml Nothing qual) mdoc +++ subs))
+         docElement thediv << (fmap (docToHtml Nothing pkg qual) mdoc +++ subs))
 
 
-subTable :: Qualification -> [SubDecl] -> Maybe Html
-subTable _ [] = Nothing
-subTable qual decls = Just $ table << aboves (concatMap subRow decls)
+subTable :: Maybe Package -> Qualification -> [SubDecl] -> Maybe Html
+subTable _ _ [] = Nothing
+subTable pkg qual decls = Just $ table << aboves (concatMap subRow decls)
   where
     subRow (decl, mdoc, subs) =
       (td ! [theclass "src"] << decl
        <->
-       docElement td << fmap (docToHtml Nothing qual) mdoc)
+       docElement td << fmap (docToHtml Nothing pkg qual) mdoc)
       : map (cell . (td <<)) subs
 
 
 -- | Sub table with source information (optional).
-subTableSrc :: Qualification -> LinksInfo -> Bool -> [(SubDecl,Located DocName)] -> Maybe Html
-subTableSrc _ _  _ [] = Nothing
-subTableSrc qual lnks splice decls = Just $ table << aboves (concatMap subRow decls)
+subTableSrc :: Maybe Package -> Qualification -> LinksInfo -> Bool
+            -> [(SubDecl,Located DocName)] -> Maybe Html
+subTableSrc _ _ _ _ [] = Nothing
+subTableSrc pkg qual lnks splice decls = Just $ table << aboves (concatMap subRow decls)
   where
     subRow ((decl, mdoc, subs),L loc dn) =
       (td ! [theclass "src clearfix"] <<
         (thespan ! [theclass "inst-left"] << decl)
         <+> linkHtml loc dn
       <->
-      docElement td << fmap (docToHtml Nothing qual) mdoc
+      docElement td << fmap (docToHtml Nothing pkg qual) mdoc
       )
       : map (cell . (td <<)) subs
     linkHtml loc@(RealSrcSpan _) dn = links lnks loc splice dn
@@ -170,49 +171,49 @@ subBlock [] = Nothing
 subBlock hs = Just $ toHtml hs
 
 
-subArguments :: Qualification -> [SubDecl] -> Html
-subArguments qual = divSubDecls "arguments" "Arguments" . subTable qual
+subArguments :: Maybe Package -> Qualification -> [SubDecl] -> Html
+subArguments pkg qual = divSubDecls "arguments" "Arguments" . subTable pkg qual
 
 
 subAssociatedTypes :: [Html] -> Html
 subAssociatedTypes = divSubDecls "associated-types" "Associated Types" . subBlock
 
 
-subConstructors :: Qualification -> [SubDecl] -> Html
-subConstructors qual = divSubDecls "constructors" "Constructors" . subTable qual
+subConstructors :: Maybe Package -> Qualification -> [SubDecl] -> Html
+subConstructors pkg qual = divSubDecls "constructors" "Constructors" . subTable pkg qual
 
-subPatterns :: Qualification -> [SubDecl] -> Html
-subPatterns qual = divSubDecls "bundled-patterns" "Bundled Patterns" . subTable qual
+subPatterns :: Maybe Package -> Qualification -> [SubDecl] -> Html
+subPatterns pkg qual = divSubDecls "bundled-patterns" "Bundled Patterns" . subTable pkg qual
 
-subFields :: Qualification -> [SubDecl] -> Html
-subFields qual = divSubDecls "fields" "Fields" . subDlist qual
+subFields :: Maybe Package -> Qualification -> [SubDecl] -> Html
+subFields pkg qual = divSubDecls "fields" "Fields" . subDlist pkg qual
 
 
-subEquations :: Qualification -> [SubDecl] -> Html
-subEquations qual = divSubDecls "equations" "Equations" . subTable qual
+subEquations :: Maybe Package -> Qualification -> [SubDecl] -> Html
+subEquations pkg qual = divSubDecls "equations" "Equations" . subTable pkg qual
 
 
 -- | Generate sub table for instance declarations, with source
-subInstances :: Qualification
+subInstances :: Maybe Package -> Qualification
              -> String -- ^ Class name, used for anchor generation
              -> LinksInfo -> Bool
              -> [(SubDecl,Located DocName)] -> Html
-subInstances qual nm lnks splice = maybe noHtml wrap . instTable
+subInstances pkg qual nm lnks splice = maybe noHtml wrap . instTable
   where
     wrap contents = subSection (collapseDetails id_ DetailsOpen (summary +++ contents))
-    instTable = subTableSrc qual lnks splice
+    instTable = subTableSrc pkg qual lnks splice
     subSection = thediv ! [theclass "subs instances"]
     summary = thesummary << "Instances"
     id_ = makeAnchorId $ "i:" ++ nm
 
 
-subOrphanInstances :: Qualification
+subOrphanInstances :: Maybe Package -> Qualification
                    -> LinksInfo -> Bool
                    -> [(SubDecl,Located DocName)] -> Html
-subOrphanInstances qual lnks splice  = maybe noHtml wrap . instTable
+subOrphanInstances pkg qual lnks splice  = maybe noHtml wrap . instTable
   where
     wrap = ((h1 << "Orphan instances") +++)
-    instTable = fmap (thediv ! [ identifier ("section." ++ id_) ] <<) . subTableSrc qual lnks splice
+    instTable = fmap (thediv ! [ identifier ("section." ++ id_) ] <<) . subTableSrc pkg qual lnks splice
     id_ = makeAnchorId $ "orphans"
 
 
@@ -228,15 +229,17 @@ subInstHead iid hdr =
 subInstDetails :: String -- ^ Instance unique id (for anchor generation)
                -> [Html] -- ^ Associated type contents
                -> [Html] -- ^ Method contents (pretty-printed signatures)
+               -> Html   -- ^ Source module
                -> Html
-subInstDetails iid ats mets =
-    subInstSection iid << (subAssociatedTypes ats <+> subMethods mets)
+subInstDetails iid ats mets mdl =
+    subInstSection iid << (p mdl <+> subAssociatedTypes ats <+> subMethods mets)
 
 subFamInstDetails :: String -- ^ Instance unique id (for anchor generation)
                   -> Html   -- ^ Type or data family instance
+                  -> Html   -- ^ Source module TODO: use this
                   -> Html
-subFamInstDetails iid fi =
-    subInstSection iid << thediv ! [theclass "src"] << fi
+subFamInstDetails iid fi mdl =
+    subInstSection iid << (p mdl <+> (thediv ! [theclass "src"] << fi))
 
 subInstSection :: String -- ^ Instance unique id (for anchor generation)
                -> Html
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
index a84a55e8..574045e0 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
@@ -22,7 +22,7 @@ import Haddock.GhcUtils
 import Haddock.Types
 import Haddock.Utils
 
-import Text.XHtml hiding ( name, title, p, quote )
+import Text.XHtml hiding ( name, p, quote )
 import qualified Data.Map as M
 import qualified Data.List as List
 
@@ -147,17 +147,19 @@ linkId mdl mbName = linkIdOcc mdl (fmap nameOccName mbName) True
 linkIdOcc :: Module -> Maybe OccName -> Bool -> Html -> Html
 linkIdOcc mdl mbName insertAnchors =
   if insertAnchors
-  then anchor ! [href url]
+  then anchor ! [href url, title ttl]
   else id
   where
+    ttl = moduleNameString (moduleName mdl)
     url = case mbName of
       Nothing   -> moduleUrl mdl
       Just name -> moduleNameUrl mdl name
 
 
 linkIdOcc' :: ModuleName -> Maybe OccName -> Html -> Html
-linkIdOcc' mdl mbName = anchor ! [href url]
+linkIdOcc' mdl mbName = anchor ! [href url, title ttl]
   where
+    ttl = moduleNameString mdl
     url = case mbName of
       Nothing   -> moduleHtmlFile' mdl
       Just name -> moduleNameUrl' mdl name