diff options
author | David Waern <david.waern@gmail.com> | 2011-06-10 01:35:31 +0000 |
---|---|---|
committer | David Waern <david.waern@gmail.com> | 2011-06-10 01:35:31 +0000 |
commit | ae5ed291f3c1550b0eda7bb0585ead327b5d967e (patch) | |
tree | 62cec94c894c7bc01221c007716aca2e2541dcce /src/Haddock/Convert.hs | |
parent | f5782ed0e979119a5ee3b48643b2161f06259774 (diff) |
Add git commits since switchover:
darcs format (followed by a conflict resolution):
commit 6f92cdd12d1354dfbd80f8323ca333bea700896a
Merge: f420cc4 28df3a1
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date: Thu May 19 17:54:34 2011 +0100
Merge remote branch 'origin/master' into ghc-generics
commit 28df3a119f770fdfe85c687dd73d5f6712b8e7d0
Author: Max Bolingbroke <batterseapower@hotmail.com>
Date: Sat May 14 22:37:02 2011 +0100
Unicode fix for getExecDir on Windows
commit 89813e729be8bce26765b95419a171a7826f6d70
Merge: 6df3a04 797ab27
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date: Mon May 9 11:55:17 2011 +0100
Merge branch 'ghc-new-co'
commit 6df3a040da3dbddee67c6e30a892f87e6b164383
Author: Ian Lynagh <igloo@earth.li>
Date: Sun May 8 17:05:50 2011 +0100
Follow changes in SDoc
commit f420cc48b9259f0b1afd2438b12f9a2bde57053d
Author: Jose Pedro Magalhaes <jpm@cs.uu.nl>
Date: Wed May 4 17:31:52 2011 +0200
Adapt haddock to the removal of HsNumTy and TypePat.
commit 797ab27bdccf39c73ccad374fea265f124cb52ea
Merge: 1d81436 5a91450
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date: Mon May 2 12:05:03 2011 +0100
Merge remote branch 'origin/master' into ghc-new-co
commit 1d8143659a81cf9611668348e33fd0775c7ab1d2
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date: Mon May 2 12:03:46 2011 +0100
Wibbles for ghc-new-co branch
commit 5a91450e2ea5a93c70bd3904b022445c9cc82488
Author: Ian Lynagh <igloo@earth.li>
Date: Fri Apr 22 00:51:56 2011 +0100
Follow defaultDynFlags change in GHC
Diffstat (limited to 'src/Haddock/Convert.hs')
-rw-r--r-- | src/Haddock/Convert.hs | 40 |
1 files changed, 30 insertions, 10 deletions
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index dde8c1b6..9892ff47 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 import Coercion ( splitKindFunTys, synTyConResKind ) import Name @@ -44,9 +44,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))) @@ -71,6 +77,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 @@ -162,11 +178,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 @@ -175,23 +195,23 @@ synifyDataCon use_gadt_syntax dc = noLoc $ -- HsNoBang never appears, it's implied instead. _ -> noLoc $ HsBangTy bang tySyn ) - (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! |