aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Convert.hs
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2011-06-10 01:35:31 +0000
committerDavid Waern <david.waern@gmail.com>2011-06-10 01:35:31 +0000
commitae5ed291f3c1550b0eda7bb0585ead327b5d967e (patch)
tree62cec94c894c7bc01221c007716aca2e2541dcce /src/Haddock/Convert.hs
parentf5782ed0e979119a5ee3b48643b2161f06259774 (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.hs40
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!