Repository : ssh://darcs.haskell.org//srv/darcs/haddock On branch : master
http://hackage.haskell.org/trac/ghc/changeset/833e6de190eab5c1b2cc856ccc3c7edbbdbe4b0f >--------------------------------------------------------------- commit 833e6de190eab5c1b2cc856ccc3c7edbbdbe4b0f Author: Simon Peyton Jones <[email protected]> Date: Fri Mar 2 16:36:41 2012 +0000 Follow changes in data representation from the big PolyKinds commit >--------------------------------------------------------------- src/Haddock/Backends/LaTeX.hs | 2 +- src/Haddock/Backends/Xhtml/Decl.hs | 4 ++-- src/Haddock/Convert.hs | 10 ++++++---- src/Haddock/Interface/Create.hs | 1 - src/Haddock/Interface/Rename.hs | 16 +++++++++------- 5 files changed, 18 insertions(+), 15 deletions(-) diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs index e0a530b..deb224a 100644 --- a/src/Haddock/Backends/LaTeX.hs +++ b/src/Haddock/Backends/LaTeX.hs @@ -323,7 +323,7 @@ ppFor _ _ _ _ = -- we skip type patterns for now ppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> LaTeX -ppTySyn loc doc (TySynonym (L _ name) ltyvars _ ltype) unicode +ppTySyn loc doc (TySynonym (L _ name) ltyvars _ ltype _) unicode = ppTypeOrFunSig loc [name] (unLoc ltype) doc (full, hdr, char '=') unicode where hdr = hsep (keyword "type" : ppDocBinder name : ppTyVars ltyvars) diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 686e9a3..71bcd58 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -121,7 +121,7 @@ ppFor _ _ _ _ _ _ _ = error "ppFor" -- we skip type patterns for now ppTySyn :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> Qualification -> Html -ppTySyn summary links loc doc (TySynonym (L _ name) ltyvars _ ltype) unicode qual +ppTySyn summary links loc doc (TySynonym (L _ name) ltyvars _ ltype _) unicode qual = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc (full, hdr, spaceHtml +++ equals) unicode qual where @@ -163,7 +163,7 @@ ppTyFamHeader summary associated decl unicode qual = ppTyClBinderWithVars summary decl <+> - case tcdKind decl of + case tcdKindSig decl of Just kind -> dcolon unicode <+> ppLKind unicode qual kind Nothing -> noHtml diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index dbd8390..480e572 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -86,7 +86,7 @@ synifyAxiom (CoAxiom { co_ax_tvs = tvs, co_ax_lhs = lhs, co_ax_rhs = rhs }) tyvars = synifyTyVars tvs typats = map (synifyType WithinType) args hs_rhs_ty = synifyType WithinType rhs - in TySynonym name tyvars (Just typats) hs_rhs_ty + in TySynonym name tyvars (Just typats) hs_rhs_ty placeHolderNames | otherwise = error "synifyAxiom" @@ -103,7 +103,9 @@ synifyTyCon tc -- tyConTyVars doesn't work on fun/prim, but we can make them up: (zipWith (\fakeTyVar realKind -> noLoc $ - KindedTyVar (getName fakeTyVar) (synifyKind realKind) placeHolderKind) + KindedTyVar (getName fakeTyVar) + (HsBSig (synifyKind realKind) placeHolderBndrs) + placeHolderKind) alphaTyVars --a, b, c... which are unfortunately all kind * (fst . splitKindFunTys $ tyConKind tc) ) @@ -164,7 +166,7 @@ synifyTyCon tc alg_deriv = Nothing syn_type = synifyType WithinType (synTyConType tc) in if isSynTyCon tc - then TySynonym name tyvars typats syn_type + then TySynonym name tyvars typats syn_type placeHolderNames else TyData alg_nd alg_ctx name Nothing tyvars typats (fmap synifyKind alg_kindSig) alg_cons alg_deriv @@ -239,7 +241,7 @@ synifyTyVars = map synifyTyVar name = getName tv in if isLiftedTypeKind kind then UserTyVar name placeHolderKind - else KindedTyVar name (synifyKind kind) placeHolderKind + else KindedTyVar name (HsBSig (synifyKind kind) placeHolderBndrs) placeHolderKind --states of what to do with foralls: diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 7e9b6a2..00f1319 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -159,7 +159,6 @@ parseOption other = tell ["Unrecognised option: " ++ other] >> return Nothing type Maps = (DocMap Name, ArgMap Name, SubMap, DeclMap) - mkMaps :: DynFlags -> GlobalRdrEnv -> [ClsInst] -> [Name] -> [(LHsDecl Name, [HsDocString])] -> ErrMsgM Maps mkMaps dflags gre instances exports decls = do maps <- mapM f decls diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index 670fa9c..a295fe2 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -260,11 +260,13 @@ renameType t = case t of renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName) -renameLTyVarBndr (L loc tv) = do - name' <- rename (hsTyVarName tv) - tyvar' <- replaceTyVarName tv name' renameLKind - return $ L loc tyvar' - +renameLTyVarBndr (L loc (UserTyVar n tck)) + = do { n' <- rename n + ; return (L loc (UserTyVar n' tck)) } +renameLTyVarBndr (L loc (KindedTyVar n (HsBSig k fvs) tck)) + = do { n' <- rename n + ; k' <- renameLKind k + ; return (L loc (KindedTyVar n' (HsBSig k' fvs) tck)) } renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName]) renameLContext (L loc context) = do @@ -330,12 +332,12 @@ renameTyClD d = case d of -- I don't think we need the derivings, so we return Nothing return (TyData x lcontext' lname' cType ltyvars' typats' k' cons' Nothing) - TySynonym lname ltyvars typats ltype -> do + TySynonym lname ltyvars typats ltype fvs -> do lname' <- renameL lname ltyvars' <- mapM renameLTyVarBndr ltyvars ltype' <- renameLType ltype typats' <- mapM (mapM renameLType) typats - return (TySynonym lname' ltyvars' typats' ltype') + return (TySynonym lname' ltyvars' typats' ltype' fvs) ClassDecl lcontext lname ltyvars lfundeps lsigs _ ats at_defs _ -> do lcontext' <- renameLContext lcontext _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
