Repository : ssh://darcs.haskell.org//srv/darcs/haddock2 On branch : master
http://hackage.haskell.org/trac/ghc/changeset/1d8143659a81cf9611668348e33fd0775c7ab1d2 >--------------------------------------------------------------- commit 1d8143659a81cf9611668348e33fd0775c7ab1d2 Author: Simon Peyton Jones <simo...@microsoft.com> Date: Mon May 2 12:03:46 2011 +0100 Wibbles for ghc-new-co branch >--------------------------------------------------------------- src/Haddock/Convert.hs | 40 ++++++++++++++++++++++------- src/Haddock/Interface/AttachInstances.hs | 3 +- 2 files changed, 32 insertions(+), 11 deletions(-) diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index 9613318..bbd0f82 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -18,7 +18,7 @@ module Haddock.Convert where import HsSyn -import TcType ( tcSplitSigmaTy ) +import TcType ( tcSplitTyConApp_maybe, tcSplitSigmaTy ) import TypeRep #if __GLASGOW_HASKELL__ == 612 import Type ( splitKindFunTys ) @@ -49,9 +49,15 @@ tyThingToLHsDecl t = noLoc $ case t of -- into a ForD instead of a SigD if we wanted. Haddock doesn't -- need to care. AnId i -> SigD (synifyIdSig ImplicitizeForAll i) + -- 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) + + -- type-constructors (e.g. Maybe) are complicated, put the definition + -- later in the file (also it's used for class associated-types too.) + ACoAxiom ax -> TyClD (synifyAxiom ax) + -- a data-constructor alone just gets rendered as a function: ADataCon dc -> SigD (TypeSig (synifyName dc) (synifyType ImplicitizeForAll (dataConUserType dc))) @@ -76,6 +82,16 @@ tyThingToLHsDecl t = noLoc $ case t of synifyClassAT :: TyCon -> LTyClDecl Name synifyClassAT = noLoc . synifyTyCon +synifyAxiom :: CoAxiom -> TyClDecl Name +synifyAxiom (CoAxiom { co_ax_tvs = tvs, co_ax_lhs = lhs, co_ax_rhs = rhs }) + | Just (tc, args) <- tcSplitTyConApp_maybe lhs + = let name = synifyName tc + tyvars = synifyTyVars tvs + typats = map (synifyType WithinType) args + hs_rhs_ty = synifyType WithinType rhs + in TySynonym name tyvars (Just typats) hs_rhs_ty + | otherwise + = error "synifyAxiom" synifyTyCon :: TyCon -> TyClDecl Name synifyTyCon tc @@ -167,11 +183,15 @@ synifyDataCon use_gadt_syntax dc = noLoc $ use_named_field_syntax = not (null field_tys) name = synifyName dc -- con_qvars means a different thing depending on gadt-syntax + (univ_tvs, ex_tvs, _eq_spec, theta, arg_tys, res_ty) = dataConFullSig dc + qvars = if use_gadt_syntax - then synifyTyVars (dataConAllTyVars dc) - else synifyTyVars (dataConExTyVars dc) + then synifyTyVars (univ_tvs ++ ex_tvs) + else synifyTyVars ex_tvs + -- skip any EqTheta, use 'orig'inal syntax - ctx = synifyCtx (dataConDictTheta dc) + ctx = synifyCtx theta + linear_tys = zipWith (\ty bang -> let tySyn = synifyType WithinType ty in case bang of @@ -188,23 +208,23 @@ synifyDataCon use_gadt_syntax dc = noLoc $ #endif ) - (dataConOrigArgTys dc) (dataConStrictMarks dc) + arg_tys (dataConStrictMarks dc) field_tys = zipWith (\field synTy -> ConDeclField (synifyName field) synTy Nothing) (dataConFieldLabels dc) linear_tys - tys = case (use_named_field_syntax, use_infix_syntax) of + hs_arg_tys = case (use_named_field_syntax, use_infix_syntax) of (True,True) -> error "synifyDataCon: contradiction!" (True,False) -> RecCon field_tys (False,False) -> PrefixCon linear_tys (False,True) -> case linear_tys of [a,b] -> InfixCon a b _ -> error "synifyDataCon: infix with non-2 args?" - res_ty = if use_gadt_syntax - then ResTyGADT (synifyType WithinType (dataConOrigResTy dc)) - else ResTyH98 + hs_res_ty = if use_gadt_syntax + then ResTyGADT (synifyType WithinType res_ty) + else ResTyH98 -- finally we get synifyDataCon's result! in ConDecl name Implicit{-we don't know nor care-} - qvars ctx tys res_ty Nothing + qvars ctx hs_arg_tys hs_res_ty Nothing False --we don't want any "deprecated GADT syntax" warnings! diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs index cc2dfa1..e4da323 100644 --- a/src/Haddock/Interface/AttachInstances.hs +++ b/src/Haddock/Interface/AttachInstances.hs @@ -30,9 +30,10 @@ import GhcMonad (withSession) #else import HscTypes (withSession) #endif +import TysPrim( funTyCon ) import MonadUtils (liftIO) import TcRnDriver (tcRnGetInfo) -import TypeRep hiding (funTyConName) +import TypeRep import Var hiding (varName) import TyCon import PrelNames _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
