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! | 
