X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsTypes.lhs;h=1ec096671f11f3bff136651fbc751001e5c8b825;hb=311b1cdfc9b1c311cc53482c461c18cba8885b2a;hp=ac6a0f9751162ddb0cf40e656ce1df4aa051c9b5;hpb=8c839b096be9a3fd44f4f681ed7f14fd95fe8ff9;p=ghc-hetmet.git

diff --git a/compiler/hsSyn/HsTypes.lhs b/compiler/hsSyn/HsTypes.lhs
index ac6a0f9..1ec0966 100644
--- a/compiler/hsSyn/HsTypes.lhs
+++ b/compiler/hsSyn/HsTypes.lhs
@@ -1,7 +1,9 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section[HsTypes]{Abstract syntax: user-defined types}
+
+HsTypes: Abstract syntax: user-defined types
 
 \begin{code}
 module HsTypes (
@@ -14,7 +16,7 @@ module HsTypes (
 	LBangType, BangType, HsBang(..), 
         getBangType, getBangStrictness, 
 	
-	mkExplicitHsForAllTy, mkImplicitHsForAllTy, 
+	mkExplicitHsForAllTy, mkImplicitHsForAllTy, hsExplicitTvs,
 	hsTyVarName, hsTyVarNames, replaceTyVarName,
 	hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
 	splitHsInstDeclTy, splitHsFunType,
@@ -30,12 +32,11 @@ module HsTypes (
 
 import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
 
-import Type		( Type )
-import Kind		( {- instance Outputable Kind -} Kind,
-			  pprParendKind, pprKind, isLiftedTypeKind )
-import BasicTypes	( IPName, Boxity, tupleParens )
-import SrcLoc		( Located(..), unLoc, noSrcSpan )
-import StaticFlags	( opt_PprStyle_Debug )
+import Type
+import HsDoc
+import BasicTypes
+import SrcLoc
+import StaticFlags
 import Outputable
 \end{code}
 
@@ -156,6 +157,8 @@ data HsType name
 
   | HsSpliceTy		(HsSplice name)
 
+  | HsDocTy             (LHsType name) (LHsDoc name) -- A documented type
+
 data HsExplicitForAll = Explicit | Implicit
 
 -----------------------
@@ -189,6 +192,12 @@ mk_forall_ty exp  tvs  ty			            = HsForAllTy exp tvs (L noSrcSpan []) ty
 Implicit `plus` Implicit = Implicit
 exp1     `plus` exp2     = Explicit
 
+hsExplicitTvs :: LHsType name -> [name]
+-- The explicitly-given forall'd type variables of a HsType
+hsExplicitTvs (L _ (HsForAllTy Explicit tvs _ _)) = hsLTyVarNames tvs
+hsExplicitTvs other   			          = []
+
+---------------------
 type LHsTyVarBndr name = Located (HsTyVarBndr name)
 
 data HsTyVarBndr name
@@ -239,6 +248,7 @@ splitHsInstDeclTy inst_ty
   where
     split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
     split_tau tvs cxt (HsParTy (L _ ty))	    = split_tau tvs cxt ty
+    split_tau _ _ other = pprPanic "splitHsInstDeclTy" (ppr inst_ty)
 
 -- Splits HsType into the (init, last) parts
 -- Breaks up any parens in the result type: 
@@ -355,6 +365,9 @@ ppr_mono_ty ctxt_prec (HsParTy ty)
   -- But we still use the precedence stuff to add parens because
   --	toHsType doesn't put in any HsParTys, so we may still need them
 
+ppr_mono_ty ctxt_prec (HsDocTy ty doc)
+  = ppr ty <+> ppr (unLoc doc)
+
 --------------------------
 ppr_fun_ty ctxt_prec ty1 ty2
   = let p1 = ppr_mono_lty pREC_FUN ty1