Repository : ssh://darcs.haskell.org//srv/darcs/haddock On branch : master
http://hackage.haskell.org/trac/ghc/changeset/a3c3c6945f16527f6627f13a7864c708d043022f >--------------------------------------------------------------- commit a3c3c6945f16527f6627f13a7864c708d043022f Author: Simon Peyton Jones <[email protected]> Date: Wed Jun 13 17:25:29 2012 +0100 Follow changes for the implementation of implicit parameters >--------------------------------------------------------------- src/Haddock/Backends/LaTeX.hs | 5 +++-- src/Haddock/Backends/Xhtml/Decl.hs | 3 +-- src/Haddock/Backends/Xhtml/Names.hs | 5 +++++ src/Haddock/Convert.hs | 9 ++++++--- src/Haddock/Interface/Rename.hs | 3 +-- 5 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs index fc07a07..f03801b 100644 --- a/src/Haddock/Backends/LaTeX.hs +++ b/src/Haddock/Backends/LaTeX.hs @@ -24,7 +24,6 @@ import GHC import OccName import Name ( nameOccName ) import RdrName ( rdrNameOcc ) -import BasicTypes ( ipNameName ) import FastString ( unpackFS, unpackLitString ) import qualified Data.Map as Map @@ -853,7 +852,7 @@ 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 <+> 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 _ (HsIParamTy n ty) u = brackets (ppDocName (ipNameName n) <+> dcolon u <+> 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) 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" @@ -923,6 +922,8 @@ ppSymName name ppVerbOccName :: OccName -> LaTeX ppVerbOccName = text . latexFilter . occNameString +ppIPName :: HsIPName -> LaTeX +ppIPName ip = text $ unpackFS $ hsIPNameFS ip ppOccName :: OccName -> LaTeX ppOccName = text . occNameString diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index b4afee3..b5ad1a8 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -33,7 +33,6 @@ import Text.XHtml hiding ( name, title, p, quote ) import GHC import Name -import BasicTypes ( ipNameName ) -- TODO: use DeclInfo DocName or something @@ -674,7 +673,7 @@ 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 _ (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 (ppDocName q (ipNameName n) <+> dcolon u <+> 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) ppr_mono_ty _ (HsSpliceTy {}) _ _ = error "ppr_mono_ty HsSpliceTy" #if __GLASGOW_HASKELL__ == 612 ppr_mono_ty _ (HsSpliceTyOut {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy" diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs index 7c2375c..f07f42e 100644 --- a/src/Haddock/Backends/Xhtml/Names.hs +++ b/src/Haddock/Backends/Xhtml/Names.hs @@ -14,6 +14,7 @@ module Haddock.Backends.Xhtml.Names ( ppName, ppDocName, ppLDocName, ppRdrName, ppUncheckedLink, ppBinder, ppBinder', ppModule, ppModuleRef, + ppIPName, linkId ) where @@ -29,6 +30,7 @@ import qualified Data.List as List import GHC import Name import RdrName +import FastString (unpackFS) ppOccName :: OccName -> Html @@ -38,6 +40,9 @@ ppOccName = toHtml . occNameString ppRdrName :: RdrName -> Html ppRdrName = ppOccName . rdrNameOcc +ppIPName :: HsIPName -> Html +ppIPName = toHtml . unpackFS . hsIPNameFS + ppUncheckedLink :: Qualification -> (ModuleName, OccName) -> Html ppUncheckedLink _ (mdl, occ) = linkIdOcc' mdl (Just occ) << ppOccName occ -- TODO: apply ppQualifyName diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index b5b905e..7c9a2ee 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -20,6 +20,7 @@ module Haddock.Convert where import HsSyn import TcType ( tcSplitTyConApp_maybe, tcSplitSigmaTy ) import TypeRep +import Type(isStrLitTy) import Kind ( splitKindFunTys, synTyConResKind ) import Name import Var @@ -29,6 +30,7 @@ import DataCon import BasicTypes ( TupleSort(..) ) import TysPrim ( alphaTyVars ) import TysWiredIn ( listTyConName, eqTyCon ) +import PrelNames (ipClassName) import Bag ( emptyBag ) import SrcLoc ( Located, noLoc, unLoc ) import Data.List( partition ) @@ -275,9 +277,10 @@ synifyType _ (TyConApp tc tys) | 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) + | tyConName tc == ipClassName + , [name, ty] <- tys + , Just x <- isStrLitTy name + = noLoc $ HsIParamTy (HsIPName x) (synifyType WithinType ty) -- and equalities | tc == eqTyCon , [ty1, ty2] <- tys diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index b762bcb..380147b 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -18,7 +18,6 @@ import Haddock.GhcUtils import GHC hiding (NoLink) import Name import Bag (emptyBag) -import BasicTypes ( IPName(..), ipNameName ) import Data.List import qualified Data.Map as Map hiding ( Map ) @@ -236,7 +235,7 @@ 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) + HsIParamTy n ty -> liftM (HsIParamTy n) (renameLType ty) HsEqTy ty1 ty2 -> liftM2 HsEqTy (renameLType ty1) (renameLType ty2) HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
