[commit: haddock] master: Revision to reflect new role annotation syntax in GHC. (61335db)
git at git.haskell.org
git at git.haskell.org
Wed Sep 18 03:40:12 CEST 2013
Repository : ssh://git@git.haskell.org/haddock
On branch : master
Link : http://git.haskell.org/?p=haddock.git;a=commit;h=61335db90219eba267de90da1742a5b38f856e52
>---------------------------------------------------------------
commit 61335db90219eba267de90da1742a5b38f856e52
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date: Tue Sep 17 09:34:05 2013 -0400
Revision to reflect new role annotation syntax in GHC.
>---------------------------------------------------------------
61335db90219eba267de90da1742a5b38f856e52
src/Haddock/Backends/Hoogle.hs | 2 +-
src/Haddock/Backends/LaTeX.hs | 1 -
src/Haddock/Backends/Xhtml/Decl.hs | 1 -
src/Haddock/Convert.hs | 9 ++++-----
src/Haddock/Interface/Create.hs | 2 +-
src/Haddock/Interface/Rename.hs | 11 ++++++-----
6 files changed, 12 insertions(+), 14 deletions(-)
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 58c0253..6afc793 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -195,7 +195,7 @@ ppCtor dflags dat subdocs con = lookupCon dflags subdocs (con_name con)
resType = case con_res con of
ResTyH98 -> apps $ map (reL . HsTyVar) $
- (tcdName dat) : [hsTyVarName v | L _ v@(HsTyVarBndr _ Nothing Nothing) <- hsQTvBndrs $ tyClDeclTyVars dat]
+ (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvBndrs $ tyClDeclTyVars dat]
ResTyGADT x -> x
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 4f94724..c69f1e1 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -851,7 +851,6 @@ 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 <+> ppLKind u kind)
-ppr_mono_ty _ (HsRoleAnnot {}) _ = error "ppr_mono_ty HsRoleAnnot"
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 _ (HsIParamTy n ty) u = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 54c202b..2ecc646 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -676,7 +676,6 @@ 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 <+> ppLKind u q kind)
-ppr_mono_ty _ (HsRoleAnnot {}) _ _ = error "ppr_mono_ty HsRoleAnnot"
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 _ (HsIParamTy n ty) u q = brackets (ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q)
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 04acbc9..0f7e5b9 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -120,9 +120,8 @@ synifyTyCon tc
= DataDecl { tcdLName = synifyName tc
, tcdTyVars = -- tyConTyVars doesn't work on fun/prim, but we can make them up:
let mk_hs_tv realKind fakeTyVar
- = noLoc $ HsTyVarBndr (getName fakeTyVar)
- (Just $ synifyKindSig realKind)
- Nothing
+ = noLoc $ KindedTyVar (getName fakeTyVar)
+ (synifyKindSig realKind)
in HsQTvs { hsq_kvs = [] -- No kind polymorphism
, hsq_tvs = zipWith mk_hs_tv (fst (splitKindFunTys (tyConKind tc)))
alphaTyVars --a, b, c... which are unfortunately all kind *
@@ -276,8 +275,8 @@ synifyTyVars ktvs = HsQTvs { hsq_kvs = map tyVarName kvs
where
(kvs, tvs) = partition isKindVar ktvs
synifyTyVar tv
- | isLiftedTypeKind kind = noLoc (HsTyVarBndr name Nothing Nothing)
- | otherwise = noLoc (HsTyVarBndr name (Just $ synifyKindSig kind) Nothing)
+ | isLiftedTypeKind kind = noLoc (UserTyVar name)
+ | otherwise = noLoc (KindedTyVar name (synifyKindSig kind))
where
kind = tyVarKind tv
name = getName tv
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index d4adbe1..825e962 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -354,7 +354,7 @@ topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . ungroup
-- | Take all declarations except pragmas, infix decls, rules from an 'HsGroup'.
ungroup :: HsGroup Name -> [LHsDecl Name]
ungroup group_ =
- mkDecls (concat . hs_tyclds) TyClD group_ ++
+ mkDecls (tyClGroupConcat . hs_tyclds) TyClD group_ ++
mkDecls hs_derivds DerivD group_ ++
mkDecls hs_defds DefD group_ ++
mkDecls hs_fords ForD group_ ++
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index a6f4852..a5ed47e 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -263,8 +263,6 @@ renameType t = case t of
k' <- renameLKind k
return (HsKindSig ty' k')
- HsRoleAnnot _ _ -> error "renameType: HsRoleAnnot"
-
HsDocTy ty doc -> do
ty' <- renameLType ty
doc' <- renameLDocHsSyn doc
@@ -290,10 +288,13 @@ renameLTyVarBndrs (HsQTvs { hsq_kvs = _, hsq_tvs = tvs })
-- This is rather bogus, but I'm not sure what else to do
renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
-renameLTyVarBndr (L loc (HsTyVarBndr n mkind mrole))
+renameLTyVarBndr (L loc (UserTyVar n))
+ = do { n' <- rename n
+ ; return (L loc (UserTyVar n')) }
+renameLTyVarBndr (L loc (KindedTyVar n kind))
= do { n' <- rename n
- ; mkind' <- mapM renameLKind mkind
- ; return (L loc (HsTyVarBndr n' mkind' mrole)) }
+ ; kind' <- renameLKind kind
+ ; return (L loc (KindedTyVar n' kind')) }
renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])
renameLContext (L loc context) = do
More information about the ghc-commits
mailing list