[commit: haddock] ghc-kinds: Merge branch 'master' into step2 (3358945)
Julien Cretin
julien at galois.com
Mon Sep 12 15:13:05 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/haddock
On branch : ghc-kinds
http://hackage.haskell.org/trac/ghc/changeset/33589458d7258a60834ebe0bf96b34d1ebb8c0d3
>---------------------------------------------------------------
commit 33589458d7258a60834ebe0bf96b34d1ebb8c0d3
Merge: ced9c6d... ebb0717...
Author: Julien Cretin <ghc at ia0.eu>
Date: Fri Sep 9 17:37:20 2011 +0200
Merge branch 'master' into step2
Conflicts:
src/Haddock/Backends/LaTeX.hs
src/Haddock/Backends/Xhtml/Decl.hs
src/Haddock/Backends/Hoogle.hs | 4 +-
src/Haddock/Backends/LaTeX.hs | 31 +++++------
src/Haddock/Backends/Xhtml/Decl.hs | 32 +++++------
src/Haddock/Convert.hs | 86 +++++++++++++-----------------
src/Haddock/Interface/AttachInstances.hs | 2 -
src/Haddock/Interface/Create.hs | 2 +-
src/Haddock/Interface/Rename.hs | 31 ++---------
src/Haddock/Types.hs | 2 +-
8 files changed, 75 insertions(+), 115 deletions(-)
diff --cc src/Haddock/Backends/LaTeX.hs
index 9114b13,d6a71f2..c6ac2b0
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@@ -24,7 -24,8 +24,7 @@@ import GH
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 )
import qualified Data.Map as Map
@@@ -876,18 -868,19 +869,22 @@@ ppr_mono_ty _ (HsBangTy b ty
ppr_mono_ty _ (HsTyVar name) _ = ppDocName name
ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u = ppr_fun_ty ctxt_prec ty1 ty2 u
ppr_mono_ty _ (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)
-ppr_mono_ty _ (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppKind kind)
+ppr_mono_ty _ (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u 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 _ (HsExplicitListTy _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _ (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
+ppr_mono_ty _ (HsWrapTy {}) _ = error "ppr_mono_ty HsWrapTy"
+ 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 --cc src/Haddock/Backends/Xhtml/Decl.hs
index f2bc5b2,2813204..e64e352
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@@ -32,9 -32,10 +32,9 @@@ import qualified Data.Map as Ma
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 )
-- TODO: use DeclInfo DocName or something
@@@ -721,10 -713,10 +713,10 @@@ ppr_mono_ty _ (HsTyVar name
ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u q = ppr_fun_ty ctxt_prec ty1 ty2 u q
ppr_mono_ty _ (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)
ppr_mono_ty _ (HsKindSig ty kind) u q =
- parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppKind kind)
+ parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q 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"
@@@ -733,10 -725,11 +725,14 @@@ ppr_mono_ty _ (HsQuasiQuoteTy {
#endif
ppr_mono_ty _ (HsRecTy {}) _ _ = error "ppr_mono_ty HsRecTy"
ppr_mono_ty _ (HsCoreTy {}) _ _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _ (HsExplicitListTy _ tys) u q = quote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
+ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q = quote $ parenList $ map (ppLType u q) tys
+ppr_mono_ty _ (HsWrapTy {}) _ _ = error "ppr_mono_ty HsWrapTy"
+ 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 --cc src/Haddock/Convert.hs
index e63562b,e46a37a..debd65e
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@@ -319,13 -306,11 +307,13 @@@ synifyType s forallty@(ForAllTy _tv _ty
in noLoc $
HsForAllTy forallPlicitness sTvs sCtx sTau
+synifyKind :: Kind -> LHsKind Name
+synifyKind = synifyType (error "synifyKind")
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 --cc src/Haddock/Interface/Rename.hs
index b39890b,4ea22a2..1b8da93
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@@ -271,12 -248,9 +254,10 @@@ renameType t = case t o
HsParTy ty -> return . HsParTy =<< renameLType ty
- HsPredTy p -> return . HsPredTy =<< renamePred p
-
HsKindSig ty k -> do
ty' <- renameLType ty
- return (HsKindSig ty' k)
+ k' <- renameLKind k
+ return (HsKindSig ty' k')
HsDocTy ty doc -> do
ty' <- renameLType ty
@@@ -289,13 -263,12 +270,13 @@@
renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
renameLTyVarBndr (L loc tv) = do
name' <- rename (hsTyVarName tv)
- return $ L loc (replaceTyVarName tv name')
+ tyvar' <- replaceTyVarName tv name' renameLKind
+ return $ L loc tyvar'
- 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')
More information about the Cvs-ghc
mailing list