Merge branch 'master' of http://darcs.haskell.org/haddock

11 files changed, 132 insertions, 149 deletions

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 44e83d64..45399963 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -114,8 +114,8 @@ ppExport (ExportDecl decl dc subdocs _) = doc (fst dc) ++ f (unL decl)
         f (TyClD d@TyData{}) = ppData d subdocs
         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 (ForD (ForeignImport name typ _ _)) = ppSig $ TypeSig [name] typ
+        f (ForD (ForeignExport name typ _ _)) = ppSig $ TypeSig [name] typ
         f (SigD sig) = ppSig sig
         f _ = []
 ppExport _ = []
@@ -143,10 +143,10 @@ ppClass x = out x{tcdSigs=[]} :
         addContext (TypeSig name (L l sig)) = TypeSig name (L l $ f sig)
         addContext _ = error "expected TypeSig"
 
-        f (HsForAllTy a b con d) = HsForAllTy a b (reL $ context : unL con) d
+        f (HsForAllTy a b con d) = HsForAllTy a b (reL (context : unLoc con)) d
         f t = HsForAllTy Implicit [] (reL [context]) (reL t)
 
-        context = reL $ HsClassP (unL $ tcdLName x)
+        context = nlHsTyConApp (unL $ tcdLName x)
             (map (reL . HsTyVar . hsTyVarName . unL) (tcdTyVars x))
 
 
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 27f6bd5e..d6a71f27 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -24,7 +24,7 @@ import GHC
 import OccName
 import Name                 ( isTyConName, nameOccName )
 import RdrName              ( rdrNameOcc, isRdrTc )
-import BasicTypes           ( IPName(..), Boxity(..) )
+import BasicTypes           ( ipNameName )
 import Outputable           ( Outputable, ppr, showSDoc )
 import FastString           ( unpackFS, unpackLitString )
 
@@ -450,7 +450,7 @@ rDoc = maybeDoc . fmap latexStripTrailingWhitespace
 -------------------------------------------------------------------------------
 
 
-ppClassHdr :: Bool -> Located [LHsPred DocName] -> DocName
+ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
            -> [Located (HsTyVarBndr DocName)] -> [Located ([DocName], [DocName])]
            -> Bool -> LaTeX
 ppClassHdr summ lctxt n tvs fds unicode =
@@ -473,7 +473,7 @@ ppClassDecl :: [DocInstance DocName] -> SrcSpan
             -> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]
             -> TyClDecl DocName -> Bool -> LaTeX
 ppClassDecl instances loc mbDoc subdocs
-  (ClassDecl lctxt lname ltyvars lfds lsigs _ ats _) unicode
+  (ClassDecl lctxt lname ltyvars lfds lsigs _ ats at_defs _) unicode
   = declWithDoc classheader (if null body then Nothing else Just (vcat body)) $$
     instancesBit
   where
@@ -486,8 +486,8 @@ ppClassDecl instances loc mbDoc subdocs
     body = catMaybes [fmap docToLaTeX mbDoc, body_]
 
     body_
-      | null lsigs, null ats = Nothing
-      | null ats  = Just methodTable
+      | null lsigs, null ats, null at_defs = Nothing
+      | null ats, null at_defs = Just methodTable
 ---     | otherwise = atTable $$ methodTable
       | otherwise = error "LaTeX.ppClassDecl"
 
@@ -771,7 +771,7 @@ ppContextNoArrow []  _ = empty
 ppContextNoArrow cxt unicode = pp_hs_context (map unLoc cxt) unicode
 
 
-ppContextNoLocs :: [HsPred DocName] -> Bool -> LaTeX
+ppContextNoLocs :: [HsType DocName] -> Bool -> LaTeX
 ppContextNoLocs []  _ = empty
 ppContextNoLocs cxt unicode = pp_hs_context cxt unicode <+> darrow unicode
 
@@ -780,17 +780,10 @@ ppContext :: HsContext DocName -> Bool -> LaTeX
 ppContext cxt unicode = ppContextNoLocs (map unLoc cxt) unicode
 
 
-pp_hs_context :: [HsPred DocName] -> Bool -> LaTeX
+pp_hs_context :: [HsType DocName] -> Bool -> LaTeX
 pp_hs_context []  _       = empty
-pp_hs_context [p] unicode = ppPred unicode p
-pp_hs_context cxt unicode = parenList (map (ppPred unicode) cxt)
-
-
-ppPred :: Bool -> HsPred DocName -> LaTeX
-ppPred unicode (HsClassP n ts) = ppAppNameTypes n (map unLoc ts) unicode
-ppPred unicode (HsEqualP t1 t2) = ppLType unicode t1 <> text "~" <> ppLType unicode t2
-ppPred unicode (HsIParam (IPName n) t)
-  = char '?' <> ppDocName n <> dcolon unicode <> ppLType unicode t
+pp_hs_context [p] unicode = ppType unicode p
+pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt)
 
 
 -------------------------------------------------------------------------------
@@ -807,9 +800,9 @@ ppBang HsNoBang = empty
 ppBang _        = char '!' -- Unpacked args is an implementation detail,
 
 
-tupleParens :: Boxity -> [LaTeX] -> LaTeX
-tupleParens Boxed   = parenList
-tupleParens Unboxed = ubxParenList
+tupleParens :: HsTupleSort -> [LaTeX] -> LaTeX
+tupleParens (HsBoxyTuple _) = parenList
+tupleParens HsUnboxedTuple  = ubxParenList
 
 
 -------------------------------------------------------------------------------
@@ -878,12 +871,16 @@ ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) t
 ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppKind kind)
 ppr_mono_ty _         (HsListTy ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u)
-ppr_mono_ty _         (HsPredTy p)        u = parens (ppPred u p)
+ppr_mono_ty _         (HsIParamTy n ty)   u = brackets (ppDocName (ipNameName n) <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
 ppr_mono_ty _         (HsSpliceTy {})     _ = error "ppr_mono_ty HsSpliceTy"
 ppr_mono_ty _         (HsQuasiQuoteTy {}) _ = error "ppr_mono_ty HsQuasiQuoteTy"
 ppr_mono_ty _         (HsRecTy {})        _ = error "ppr_mono_ty HsRecTy"
 ppr_mono_ty _         (HsCoreTy {})       _ = error "ppr_mono_ty HsCoreTy"
 
+ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode
+  = maybeParen ctxt_prec pREC_OP $
+    ppr_mono_lty pREC_OP ty1 unicode <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode
+
 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode
   = maybeParen ctxt_prec pREC_CON $
     hsep [ppr_mono_lty pREC_FUN fun_ty unicode, ppr_mono_lty pREC_CON arg_ty unicode]
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index add926ab..c1f3a89a 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -32,9 +32,9 @@ import qualified Data.Map as Map
 import           Data.Maybe
 import           Text.XHtml hiding     ( name, title, p, quote )
 
-import BasicTypes            ( IPName(..), Boxity(..) )
 import GHC
 import Name
+import BasicTypes            ( ipNameName )
 import Outputable            ( ppr, showSDoc, Outputable )
 
 
@@ -114,7 +114,7 @@ tyvarNames = map (getName . hsTyVarName . unLoc)
 
 ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
       -> ForeignDecl DocName -> Bool -> Qualification -> Html
-ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _) unicode qual
+ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _ _) unicode qual
   = ppFunSig summary links loc doc [name] typ unicode qual
 ppFor _ _ _ _ _ _ _ = error "ppFor"
 
@@ -301,7 +301,7 @@ ppContextNoArrow []  _       _     = noHtml
 ppContextNoArrow cxt unicode qual = pp_hs_context (map unLoc cxt) unicode qual
 
 
-ppContextNoLocs :: [HsPred DocName] -> Bool -> Qualification -> Html
+ppContextNoLocs :: [HsType DocName] -> Bool -> Qualification -> Html
 ppContextNoLocs []  _       _     = noHtml
 ppContextNoLocs cxt unicode qual = pp_hs_context cxt unicode qual 
     <+> darrow unicode
@@ -311,18 +311,10 @@ ppContext :: HsContext DocName -> Bool -> Qualification -> Html
 ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual
 
 
-pp_hs_context :: [HsPred DocName] -> Bool -> Qualification-> Html
+pp_hs_context :: [HsType DocName] -> Bool -> Qualification-> Html
 pp_hs_context []  _       _     = noHtml
-pp_hs_context [p] unicode qual = ppPred unicode qual p
-pp_hs_context cxt unicode qual = parenList (map (ppPred unicode qual) cxt)
-
-
-ppPred :: Bool -> Qualification -> HsPred DocName -> Html
-ppPred unicode qual (HsClassP n ts) = ppAppNameTypes n (map unLoc ts) unicode qual
-ppPred unicode qual (HsEqualP t1 t2) = ppLType unicode qual t1 <+> toHtml "~"
-    <+> ppLType unicode qual t2
-ppPred unicode qual (HsIParam (IPName n) t)
-  = toHtml "?" +++ ppDocName qual n <+> dcolon unicode <+> ppLType unicode qual t
+pp_hs_context [p] unicode qual = ppType unicode qual p
+pp_hs_context cxt unicode qual = parenList (map (ppType unicode qual) cxt)
 
 
 -------------------------------------------------------------------------------
@@ -330,7 +322,7 @@ ppPred unicode qual (HsIParam (IPName n) t)
 -------------------------------------------------------------------------------
 
 
-ppClassHdr :: Bool -> Located [LHsPred DocName] -> DocName
+ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
            -> [Located (HsTyVarBndr DocName)] -> [Located ([DocName], [DocName])]
            -> Bool -> Qualification -> Html
 ppClassHdr summ lctxt n tvs fds unicode qual =
@@ -352,7 +344,7 @@ ppFds fds unicode qual =
 ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
                  -> [(DocName, DocForDecl DocName)] -> Bool -> Qualification
                  -> Html
-ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc
+ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _ _) loc
     subdocs unicode qual = 
   if null sigs && null ats
     then (if summary then id else topDeclElem links loc [nm]) hdr
@@ -381,7 +373,7 @@ ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan
             -> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]
             -> TyClDecl DocName -> Bool -> Qualification -> Html
 ppClassDecl summary links instances loc mbDoc subdocs
-        decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _) unicode qual
+        decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _ _) unicode qual
   | summary = ppShortClassDecl summary links decl loc subdocs unicode qual
   | otherwise = classheader +++ maybeDocSection qual mbDoc
                   +++ atBit +++ methodBit  +++ instancesBit
@@ -653,9 +645,9 @@ ppBang _        = toHtml "!" -- Unpacked args is an implementation detail,
                              -- so we just show the strictness annotation
 
 
-tupleParens :: Boxity -> [Html] -> Html
-tupleParens Boxed   = parenList
-tupleParens Unboxed = ubxParenList
+tupleParens :: HsTupleSort -> [Html] -> Html
+tupleParens (HsBoxyTuple _) = parenList
+tupleParens HsUnboxedTuple  = ubxParenList
 
 
 --------------------------------------------------------------------------------
@@ -724,7 +716,7 @@ ppr_mono_ty _         (HsKindSig ty kind) u q =
     parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppKind kind)
 ppr_mono_ty _         (HsListTy ty)       u q = brackets (ppr_mono_lty pREC_TOP ty u q)
 ppr_mono_ty _         (HsPArrTy ty)       u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)
-ppr_mono_ty _         (HsPredTy p)        u q = parens (ppPred u q p)
+ppr_mono_ty _         (HsIParamTy n ty)   u q = brackets (ppDocName q (ipNameName n) <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q)
 ppr_mono_ty _         (HsSpliceTy {})     _ _ = error "ppr_mono_ty HsSpliceTy"
 #if __GLASGOW_HASKELL__ == 612
 ppr_mono_ty _         (HsSpliceTyOut {})  _ _ = error "ppr_mono_ty HsQuasiQuoteTy"
@@ -734,6 +726,10 @@ ppr_mono_ty _         (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteT
 ppr_mono_ty _         (HsRecTy {})        _ _ = error "ppr_mono_ty HsRecTy"
 ppr_mono_ty _         (HsCoreTy {})       _ _ = error "ppr_mono_ty HsCoreTy"
 
+ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual
+  = maybeParen ctxt_prec pREC_OP $
+    ppr_mono_lty pREC_OP ty1 unicode qual <+> char '~' <+> ppr_mono_lty pREC_OP ty2 unicode qual
+
 ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual
   = maybeParen ctxt_prec pREC_CON $
     hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual]
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 34de6775..e46a37a4 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -20,14 +20,16 @@ module Haddock.Convert where
 import HsSyn
 import TcType ( tcSplitTyConApp_maybe, tcSplitSigmaTy )
 import TypeRep
+import Kind ( liftedTypeKind, constraintKind )
 import Coercion ( splitKindFunTys, synTyConResKind )
 import Name
 import Var
 import Class
 import TyCon
 import DataCon
+import BasicTypes ( TupleSort(..) )
 import TysPrim ( alphaTyVars )
-import TysWiredIn ( listTyConName )
+import TysWiredIn ( listTyConName, eqTyCon )
 import Bag ( emptyBag )
 import SrcLoc ( Located, noLoc, unLoc )
 
@@ -47,7 +49,24 @@ tyThingToLHsDecl t = noLoc $ case t of
 
   -- type-constructors (e.g. Maybe) are complicated, put the definition
   -- later in the file (also it's used for class associated-types too.)
-  ATyCon tc -> TyClD (synifyTyCon tc)
+  ATyCon tc
+    | Just cl <- tyConClass_maybe tc -- classes are just a little tedious
+    -> TyClD $ ClassDecl
+         (synifyCtx (classSCTheta cl))
+         (synifyName cl)
+         (synifyTyVars (classTyVars cl))
+         (map (\ (l,r) -> noLoc
+                    (map getName l, map getName r) ) $
+            snd $ classTvsFds cl)
+         (map (noLoc . synifyIdSig DeleteTopLevelQuantification)
+              (classMethods cl))
+         emptyBag --ignore default method definitions, they don't affect signature
+         -- class associated-types are a subset of TyCon:
+         [noLoc (synifyTyCon at_tc) | (at_tc, _) <- classATItems cl]
+         [] --ignore associated type defaults
+         [] --we don't have any docs at this point
+    | otherwise
+    -> TyClD (synifyTyCon tc)
 
   -- type-constructors (e.g. Maybe) are complicated, put the definition
   -- later in the file (also it's used for class associated-types too.)
@@ -56,26 +75,10 @@ tyThingToLHsDecl t = noLoc $ case t of
   -- a data-constructor alone just gets rendered as a function:
   ADataCon dc -> SigD (TypeSig [synifyName dc]
     (synifyType ImplicitizeForAll (dataConUserType dc)))
-  -- classes are just a little tedious
-  AClass cl ->
-    TyClD $ ClassDecl
-      (synifyCtx (classSCTheta cl))
-      (synifyName cl)
-      (synifyTyVars (classTyVars cl))
-      (map (\ (l,r) -> noLoc
-                 (map getName l, map getName r) ) $
-         snd $ classTvsFds cl)
-      (map (noLoc . synifyIdSig DeleteTopLevelQuantification)
-           (classMethods cl))
-      emptyBag --ignore default method definitions, they don't affect signature
-      (map synifyClassAT (classATs cl))
-      [] --we don't have any docs at this point
 
-
--- class associated-types are a subset of TyCon
--- (mainly only type/data-families)
-synifyClassAT :: TyCon -> LTyClDecl Name
-synifyClassAT = noLoc . synifyTyCon
+synifyATDefault :: TyCon -> LTyClDecl Name
+synifyATDefault tc = noLoc (synifyAxiom ax)
+  where Just ax = tyConFamilyCoercion_maybe tc
 
 synifyAxiom :: CoAxiom -> TyClDecl Name
 synifyAxiom (CoAxiom { co_ax_tvs = tvs, co_ax_lhs = lhs, co_ax_rhs = rhs })
@@ -224,25 +227,7 @@ synifyIdSig s i = TypeSig [synifyName i] (synifyType s (varType i))
 
 
 synifyCtx :: [PredType] -> LHsContext Name
-synifyCtx = noLoc . map synifyPred
-
-
-synifyPred :: PredType -> LHsPred Name
-synifyPred (ClassP cls tys) =
-    let sTys = map (synifyType WithinType) tys
-    in noLoc $
-        HsClassP (getName cls) sTys
-synifyPred (IParam ip ty) =
-    let sTy = synifyType WithinType ty
-    -- IPName should be in class NamedThing...
-    in noLoc $
-      HsIParam ip sTy
-synifyPred (EqPred ty1 ty2) =
-    let
-     s1 = synifyType WithinType ty1
-     s2 = synifyType WithinType ty2
-    in noLoc $
-      HsEqualP s1 s2
+synifyCtx = noLoc . map (synifyType WithinType)
 
 
 synifyTyVars :: [TyVar] -> [LHsTyVarBndr Name]
@@ -273,16 +258,26 @@ data SynifyTypeState
 
 
 synifyType :: SynifyTypeState -> Type -> LHsType Name
-synifyType _ (PredTy{}) = --should never happen.
-  error "synifyType: PredTys are not, in themselves, source-level types."
 synifyType _ (TyVarTy tv) = noLoc $ HsTyVar (getName tv)
 synifyType _ (TyConApp tc tys)
   -- Use non-prefix tuple syntax where possible, because it looks nicer.
   | isTupleTyCon tc, tyConArity tc == length tys =
-     noLoc $ HsTupleTy (tupleTyConBoxity tc) (map (synifyType WithinType) tys)
+     noLoc $ HsTupleTy (case tupleTyConSort tc of
+                          BoxedTuple      -> HsBoxyTuple liftedTypeKind
+                          ConstraintTuple -> HsBoxyTuple constraintKind
+                          UnboxedTuple    -> HsUnboxedTuple)
+                       (map (synifyType WithinType) tys)
   -- ditto for lists
   | getName tc == listTyConName, [ty] <- tys =
      noLoc $ HsListTy (synifyType WithinType ty)
+  -- ditto for implicit parameter tycons
+  | Just ip <- tyConIP_maybe tc
+  , [ty] <- tys
+  = noLoc $ HsIParamTy ip (synifyType WithinType ty)
+  -- and equalities
+  | tc == eqTyCon
+  , [ty1, ty2] <- tys
+  = noLoc $ HsEqTy (synifyType WithinType ty1) (synifyType WithinType ty2)
   -- Most TyCons:
   | otherwise =
     foldl (\t1 t2 -> noLoc (HsAppTy t1 t2))
@@ -313,9 +308,9 @@ synifyType s forallty@(ForAllTy _tv _ty) =
 
 
 synifyInstHead :: ([TyVar], [PredType], Class, [Type]) ->
-                  ([HsPred Name], Name, [HsType Name])
+                  ([HsType Name], Name, [HsType Name])
 synifyInstHead (_, preds, cls, ts) =
-  ( map (unLoc . synifyPred) preds
+  ( map (unLoc . synifyType WithinType) preds
   , getName cls
   , map (unLoc . synifyType WithinType) ts
   )
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index f79acd94..33ae1b6d 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -96,8 +96,8 @@ getMainDeclBinder (ValD d) =
 #endif
 
 getMainDeclBinder (SigD d) = sigNameNoLoc d
-getMainDeclBinder (ForD (ForeignImport name _ _)) = [unLoc name]
-getMainDeclBinder (ForD (ForeignExport _ _ _)) = []
+getMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name]
+getMainDeclBinder (ForD (ForeignExport _ _ _ _)) = []
 getMainDeclBinder _ = []
 
 -- Useful when there is a signature with multiple names, e.g.
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index e4da3233..01d5b0f4 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -116,7 +116,6 @@ getAllInfo name = withSession $ \hsc_env -> do
 data SimpleType = SimpleType Name [SimpleType] deriving (Eq,Ord)
 
 
--- 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)
@@ -134,7 +133,6 @@ instHead (_, _, cls, args)
       where (SimpleType s ts) = simplify t1
     simplify (TyVarTy v) = SimpleType (tyVarName v) []
     simplify (TyConApp tc ts) = SimpleType (tyConName tc) (map simplify ts)
-    simplify _ = error "simplify"
 
 
 -- sortImage f = sortBy (\x y -> compare (f x) (f y))
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index f9d72bd0..057fceb7 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -263,7 +263,7 @@ declsFromClass class_ = docs ++ defs ++ sigs ++ ats
 
 declNames :: HsDecl a -> [a]
 declNames (TyClD d) = [tcdName d]
-declNames (ForD (ForeignImport n _ _)) = [unLoc n]
+declNames (ForD (ForeignImport n _ _ _)) = [unLoc n]
 -- we have normal sigs only (since they are taken from ValBindsOut)
 declNames (SigD sig) = sigNameNoLoc sig
 declNames _ = error "unexpected argument to declNames"
@@ -770,7 +770,7 @@ extractClassDecl c tvs0 (L pos (TypeSig lname ltype)) = case ltype of
   _ -> L pos (TypeSig lname (noLoc (mkImplicitHsForAllTy (lctxt []) ltype)))
   where
     lctxt = noLoc . ctxt
-    ctxt preds = noLoc (HsClassP c (map toTypeNoLoc tvs0)) : preds
+    ctxt preds = nlHsTyConApp c (map toTypeNoLoc tvs0) : preds
 extractClassDecl _ _ _ = error "extractClassDecl: unexpected decl"
 
 
diff --git a/src/Haddock/Interface/ExtractFnArgDocs.hs b/src/Haddock/Interface/ExtractFnArgDocs.hs
index 8889c3ab..a9f8a807 100644
--- a/src/Haddock/Interface/ExtractFnArgDocs.hs
+++ b/src/Haddock/Interface/ExtractFnArgDocs.hs
@@ -24,7 +24,7 @@ import GHC
 
 getDeclFnArgDocs :: HsDecl Name -> Map Int HsDocString
 getDeclFnArgDocs (SigD (TypeSig _ ty)) = getTypeFnArgDocs ty
-getDeclFnArgDocs (ForD (ForeignImport _ ty _)) = getTypeFnArgDocs ty
+getDeclFnArgDocs (ForD (ForeignImport _ ty _ _)) = getTypeFnArgDocs ty
 getDeclFnArgDocs (TyClD (TySynonym {tcdSynRhs = ty})) = getTypeFnArgDocs ty
 getDeclFnArgDocs _ = Map.empty
 
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 2d5c899a..546ba62b 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -17,8 +17,8 @@ import Haddock.GhcUtils
 
 import GHC hiding (NoLink)
 import Name
-import BasicTypes
 import Bag (emptyBag)
+import BasicTypes ( IPName(..), ipNameName )
 
 import Data.List
 import qualified Data.Map as Map hiding ( Map )
@@ -208,25 +208,6 @@ renameFnArgsDoc :: FnArgsDoc Name -> RnM (FnArgsDoc DocName)
 renameFnArgsDoc = mapM renameDoc
 
 
-renameLPred :: LHsPred Name -> RnM (LHsPred DocName)
-renameLPred = mapM renamePred
-
-
-renamePred :: HsPred Name -> RnM (HsPred DocName)
-renamePred (HsClassP name types) = do
-  name'  <- rename name
-  types' <- mapM renameLType types
-  return (HsClassP name' types')
-renamePred (HsEqualP type1 type2) = do
-  type1' <- renameLType type1
-  type2' <- renameLType type2
-  return (HsEqualP type1' type2')
-renamePred (HsIParam (IPName name) t) = do
-  name' <- rename name
-  t'    <- renameLType t
-  return (HsIParam (IPName name') t')
-
-
 renameLType :: LHsType Name -> RnM (LHsType DocName)
 renameLType = mapM renameType
 
@@ -254,6 +235,8 @@ renameType t = case t of
 
   HsListTy ty -> return . HsListTy =<< renameLType ty
   HsPArrTy ty -> return . HsPArrTy =<< renameLType ty
+  HsIParamTy n ty -> liftM2 HsIParamTy (liftM IPName (rename (ipNameName n))) (renameLType ty)
+  HsEqTy ty1 ty2 -> liftM2 HsEqTy (renameLType ty1) (renameLType ty2)
 
   HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts
 
@@ -265,8 +248,6 @@ renameType t = case t of
 
   HsParTy ty -> return . HsParTy =<< renameLType ty
 
-  HsPredTy p -> return . HsPredTy =<< renamePred p
-
   HsKindSig ty k -> do
     ty' <- renameLType ty
     return (HsKindSig ty' k)
@@ -285,15 +266,15 @@ renameLTyVarBndr (L loc tv) = do
   return $ L loc (replaceTyVarName tv name')
 
 
-renameLContext :: Located [LHsPred Name] -> RnM (Located [LHsPred DocName])
+renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])
 renameLContext (L loc context) = do
-  context' <- mapM renameLPred context
+  context' <- mapM renameLType context
   return (L loc context')
 
 
 renameInstHead :: InstHead Name -> RnM (InstHead DocName)
 renameInstHead (preds, className, types) = do
-  preds' <- mapM renamePred preds
+  preds' <- mapM renameType preds
   className' <- rename className
   types' <- mapM renameType types
   return (preds', className', types')
@@ -351,15 +332,16 @@ renameTyClD d = case d of
     typats'  <- mapM (mapM renameLType) typats
     return (TySynonym lname' ltyvars' typats' ltype')
 
-  ClassDecl lcontext lname ltyvars lfundeps lsigs _ ats _ -> do
+  ClassDecl lcontext lname ltyvars lfundeps lsigs _ ats at_defs _ -> do
     lcontext' <- renameLContext lcontext
     lname'    <- renameL lname
     ltyvars'  <- mapM renameLTyVarBndr ltyvars
     lfundeps' <- mapM renameLFunDep lfundeps
     lsigs'    <- mapM renameLSig lsigs
     ats'      <- mapM renameLTyClD ats
+    at_defs'  <- mapM renameLTyClD at_defs
     -- we don't need the default methods or the already collected doc entities
-    return (ClassDecl lcontext' lname' ltyvars' lfundeps' lsigs' emptyBag ats' [])
+    return (ClassDecl lcontext' lname' ltyvars' lfundeps' lsigs' emptyBag ats' at_defs' [])
 
   where
     renameLCon (L loc con) = return . L loc =<< renameCon con
@@ -410,14 +392,14 @@ renameSig sig = case sig of
 
 
 renameForD :: ForeignDecl Name -> RnM (ForeignDecl DocName)
-renameForD (ForeignImport lname ltype x) = do
+renameForD (ForeignImport lname ltype co x) = do
   lname' <- renameL lname
   ltype' <- renameLType ltype
-  return (ForeignImport lname' ltype' x)
-renameForD (ForeignExport lname ltype x) = do
+  return (ForeignImport lname' ltype' co x)
+renameForD (ForeignExport lname ltype co x) = do
   lname' <- renameL lname
   ltype' <- renameLType ltype
-  return (ForeignExport lname' ltype' x)
+  return (ForeignExport lname' ltype' co x)
 
 
 renameInstD :: InstDecl Name -> RnM (InstDecl DocName)
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index 1c2aa360..24c1bc92 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RankNTypes #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
@@ -30,6 +31,7 @@ import Data.Map (Map)
 
 import GHC hiding (NoLink)
 import Binary
+import BinIface (getSymtabName, getDictFastString)
 import Name
 import UniqSupply
 import UniqFM
@@ -104,10 +106,10 @@ writeInterfaceFile filename iface = do
   let bin_dict = BinDictionary {
                       bin_dict_next = dict_next_ref,
                       bin_dict_map  = dict_map_ref }
-  ud <- newWriteState (putName bin_symtab) (putFastString bin_dict)
 
   -- put the main thing
-  bh <- return $ setUserData bh0 ud
+  bh <- return $ setUserData bh0 $ newWriteState (putName bin_symtab)
+                                                 (putFastString bin_dict)
   put_ bh iface
 
   -- write the symtab pointer at the front of the file
@@ -166,9 +168,11 @@ freshNameCache = ( create_fresh_nc , \_ -> return () )
 -- 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 :: forall m.
+                     MonadIO m
+                  => NameCacheAccessor m
+                  -> FilePath
+                  -> m (Either String InterfaceFile)
 readInterfaceFile (get_name_cache, set_name_cache) filename = do
   bh0 <- liftIO $ readBinMem filename
 
@@ -180,23 +184,38 @@ readInterfaceFile (get_name_cache, set_name_cache) filename = do
       "Magic number mismatch: couldn't load interface file: " ++ filename
       | version /= binaryInterfaceVersion -> return . Left $
       "Interface file is of wrong version: " ++ filename
-      | otherwise -> do
+      | otherwise -> with_name_cache $ \update_nc -> do
 
       dict  <- get_dictionary bh0
-      bh1   <- init_handle_user_data bh0 dict
-
-      theNC <- get_name_cache
-      (nc', symtab) <- get_symbol_table bh1 theNC
-      set_name_cache nc'
-
-      -- set the symbol table
-      let ud' = getUserData bh1
-      bh2 <- return $! setUserData bh1 ud'{ud_symtab = symtab}
+  
+      -- read the symbol table so we are capable of reading the actual data
+      bh1 <- do
+          let bh1 = setUserData bh0 $ newReadState (error "getSymtabName")
+                                                   (getDictFastString dict)
+          symtab <- update_nc (get_symbol_table bh1)
+          return $ setUserData bh1 $ newReadState (getSymtabName (NCU (\f -> update_nc (return . f))) dict symtab)
+                                                  (getDictFastString dict)
 
       -- load the actual data
-      iface <- liftIO $ get bh2
+      iface <- liftIO $ get bh1
       return (Right iface)
  where
+   with_name_cache :: forall a.
+                      ((forall n b. MonadIO n
+                                => (NameCache -> n (NameCache, b))
+                                -> n b)
+                       -> m a)
+                   -> m a
+   with_name_cache act = do
+      nc_var <-  get_name_cache >>= (liftIO . newIORef)
+      x <- act $ \f -> do
+              nc <- liftIO $ readIORef nc_var
+              (nc', x) <- f nc
+              liftIO $ writeIORef nc_var nc'
+              return x
+      liftIO (readIORef nc_var) >>= set_name_cache
+      return x
+
    get_dictionary bin_handle = liftIO $ do
       dict_p <- get bin_handle
       data_p <- tellBin bin_handle
@@ -205,10 +224,6 @@ readInterfaceFile (get_name_cache, set_name_cache) filename = do
       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
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index c0bf4ad7..c9b29bd0 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -259,7 +259,7 @@ type DocInstance name = (InstHead name, Maybe (Doc name))
 
 -- | The head of an instance. Consists of a context, a class name and a list
 -- of instance types.
-type InstHead name = ([HsPred name], name, [HsType name])
+type InstHead name = ([HsType name], name, [HsType name])
 
 
 -----------------------------------------------------------------------------