New kind-polymorphic core

This big patch implements a kind-polymorphic core for GHC. The current
implementation focuses on making sure that all kind-monomorphic programs still
work in the new core; it is not yet guaranteed that kind-polymorphic programs
(using the new -XPolyKinds flag) will work.

For more information, see http://haskell.org/haskellwiki/GHC/Kinds

1 files changed, 15 insertions, 12 deletions

diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index c1f3a89a..44429167 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -35,7 +35,6 @@ import           Text.XHtml hiding     ( name, title, p, quote )
 import GHC
 import Name
 import BasicTypes            ( ipNameName )
-import Outputable            ( ppr, showSDoc, Outputable )
 
 
 -- TODO: use DeclInfo DocName or something
@@ -150,8 +149,8 @@ ppTyName name
 --------------------------------------------------------------------------------
 
 
-ppTyFamHeader :: Bool -> Bool -> TyClDecl DocName -> Bool -> Html
-ppTyFamHeader summary associated decl unicode =
+ppTyFamHeader :: Bool -> Bool -> TyClDecl DocName -> Bool -> Qualification -> Html
+ppTyFamHeader summary associated decl unicode qual =
 
   (case tcdFlavour decl of
      TypeFamily
@@ -165,7 +164,7 @@ ppTyFamHeader summary associated decl unicode =
   ppTyClBinderWithVars summary decl <+>
 
   case tcdKind decl of
-    Just kind -> dcolon unicode  <+> ppKind kind
+    Just kind -> dcolon unicode  <+> ppLKind unicode qual kind
     Nothing -> noHtml
 
 
@@ -173,13 +172,13 @@ ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->
               TyClDecl DocName -> Bool -> Qualification -> Html
 ppTyFam summary associated links loc mbDoc decl unicode qual
 
-  | summary   = ppTyFamHeader True associated decl unicode
+  | summary   = ppTyFamHeader True associated decl unicode qual
   | otherwise = header_ +++ maybeDocSection qual mbDoc +++ instancesBit
 
   where
     docname = tcdName decl
 
-    header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode)
+    header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode qual)
 
     instancesBit = ppInstances instances docname unicode qual
 
@@ -635,10 +634,6 @@ ppDataHeader summary decl unicode qual
 --------------------------------------------------------------------------------
 
 
-ppKind :: Outputable a => a -> Html
-ppKind k = toHtml $ showSDoc (ppr k)
-
-
 ppBang :: HsBang -> Html
 ppBang HsNoBang = noHtml
 ppBang _        = toHtml "!" -- Unpacked args is an implementation detail,
@@ -684,6 +679,11 @@ ppType       unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual
 ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual
 ppFunLhType  unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual
 
+ppLKind :: Bool -> Qualification-> LHsKind DocName -> Html
+ppLKind unicode qual y = ppKind unicode qual (unLoc y)
+
+ppKind :: Bool -> Qualification-> HsKind DocName -> Html
+ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual
 
 -- Drop top-level for-all type variables in user style
 -- since they are implicit in Haskell
@@ -713,7 +713,7 @@ ppr_mono_ty _         (HsTyVar name)      _ q = ppDocName q name
 ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q = ppr_fun_ty ctxt_prec ty1 ty2 u q
 ppr_mono_ty _         (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)
 ppr_mono_ty _         (HsKindSig ty kind) u q =
-    parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppKind kind)
+    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)
@@ -725,6 +725,9 @@ ppr_mono_ty _         (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteT
 #endif
 ppr_mono_ty _         (HsRecTy {})        _ _ = error "ppr_mono_ty HsRecTy"
 ppr_mono_ty _         (HsCoreTy {})       _ _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _         (HsExplicitListTy _ tys) u q = quote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
+ppr_mono_ty _         (HsExplicitTupleTy _ tys) u q = quote $ parenList $ map (ppLType u q) tys
+ppr_mono_ty _         (HsWrapTy {})       _ _ = error "ppr_mono_ty HsWrapTy"
 
 ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual
   = maybeParen ctxt_prec pREC_OP $
@@ -734,7 +737,7 @@ ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual
   = maybeParen ctxt_prec pREC_CON $
     hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual]
 
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual
+ppr_mono_ty ctxt_prec (HsOpTy ty1 (_, op) ty2) unicode qual
   = maybeParen ctxt_prec pREC_FUN $
     ppr_mono_lty pREC_OP ty1 unicode qual <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual
   where