, hsUsOnce, hsUsMany
, mkHsForAllTy, mkHsDictTy, mkHsIParamTy
- , hsTyVarName, hsTyVarNames, replaceTyVarName,
+ , hsTyVarName, hsTyVarNames, replaceTyVarName
+ , getHsInstHead
-- Type place holder
- PostTcType, placeHolderType,
+ , PostTcType, placeHolderType,
-- Printing
- , pprParendHsType, pprHsForAll, pprHsContext, pprHsTyVarBndr
+ , pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
-- Equality over Hs things
, EqHsEnv, emptyEqHsEnv, extendEqHsEnv,
#include "HsVersions.h"
import Class ( FunDep )
-import TcType ( Type, Kind, ThetaType, SourceType(..), IPName,
+import TcType ( Type, Kind, ThetaType, SourceType(..),
tcSplitSigmaTy, liftedTypeKind, eqKind, tcEqType
)
import TypeRep ( Type(..), TyNote(..) ) -- toHsType sees the representation
import OccName ( NameSpace, tvName )
import Var ( TyVar, tyVarKind )
import Subst ( substTyWith )
-import PprType ( {- instance Outputable Kind -}, pprParendKind )
-import BasicTypes ( Boxity(..), Arity, tupleParens )
-import PrelNames ( mkTupConRdrName, listTyConKey, usOnceTyConKey, usManyTyConKey, hasKey,
- usOnceTyConName, usManyTyConName
- )
+import PprType ( {- instance Outputable Kind -}, pprParendKind, pprKind )
+import BasicTypes ( Boxity(..), Arity, IPName, tupleParens )
+import PrelNames ( mkTupConRdrName, listTyConKey, parrTyConKey,
+ usOnceTyConKey, usManyTyConKey, hasKey,
+ usOnceTyConName, usManyTyConName )
import FiniteMap
import Util ( eqListBy, lengthIs )
import Outputable
| HsListTy (HsType name) -- Element type
+ | HsPArrTy (HsType name) -- Elem. type of parallel array: [:t:]
+
| HsTupleTy (HsTupCon name)
[HsType name] -- Element types (length gives arity)
-- Generics
-- these next two are only used in interfaces
| HsPredTy (HsPred name)
-
- | HsUsageTy (HsType name) -- Usage annotation
- (HsType name) -- Annotated type
+
+ | HsKindSig (HsType name) -- (ty :: kind)
+ Kind -- A type with a kind signature
-----------------------
\end{code}
+\begin{code}
+getHsInstHead :: HsType name -> ([HsTyVarBndr name], (name, [HsType name]))
+ -- Split up an instance decl type, returning the 'head' part
+
+-- In interface fiels, the type of the decl is held like this:
+-- forall a. Foo a -> Baz (T a)
+-- so we have to strip off function argument types,
+-- as well as the bit before the '=>' (which is always
+-- empty in interface files)
+--
+-- The parser ensures the type will have the right shape.
+-- (e.g. see ParseUtil.checkInstType)
+
+getHsInstHead (HsForAllTy (Just tvs) _ tau) = (tvs, get_head1 tau)
+getHsInstHead tau = ([], get_head1 tau)
+
+get_head1 (HsFunTy _ ty) = get_head1 ty
+get_head1 (HsPredTy (HsClassP cls tys)) = (cls,tys)
+\end{code}
+
+
%************************************************************************
%* *
\subsection{Pretty printing}
ptext SLIT("forall") <+> interppSP tvs <> dot <+>
-- **! ToDo: want to hide uvars from user, but not enough info
-- in a HsTyVarBndr name (see PprType). KSW 2000-10.
- (if null cxt then
- empty
- else
- ppr_context cxt <+> ptext SLIT("=>")
- )
+ pprHsContext cxt
else -- Used in interfaces
ptext SLIT("__forall") <+> interppSP tvs <+>
- ppr_context cxt <+> ptext SLIT("=>")
+ ppr_hs_context cxt <+> ptext SLIT("=>")
pprHsContext :: (Outputable name) => HsContext name -> SDoc
pprHsContext [] = empty
-pprHsContext cxt = ppr_context cxt <+> ptext SLIT("=>")
+pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
-ppr_context [] = empty
-ppr_context cxt = parens (interpp'SP cxt)
+ppr_hs_context [] = empty
+ppr_hs_context cxt = parens (interpp'SP cxt)
\end{code}
\begin{code}
(sep [p1, (<>) (ptext SLIT("-> ")) p2])
ppr_mono_ty ctxt_prec (HsTupleTy con tys) = hsTupParens con (interpp'SP tys)
+ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_ty pREC_TOP ty <+> dcolon <+> pprKind kind)
ppr_mono_ty ctxt_prec (HsListTy ty) = brackets (ppr_mono_ty pREC_TOP ty)
+ppr_mono_ty ctxt_prec (HsPArrTy ty) = pabrackets (ppr_mono_ty pREC_TOP ty)
+ where
+ pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
= maybeParen (ctxt_prec >= pREC_CON)
ppr_mono_ty ctxt_prec (HsPredTy pred)
= braces (ppr pred)
-ppr_mono_ty ctxt_prec (HsUsageTy u ty)
- = maybeParen (ctxt_prec >= pREC_CON)
- (sep [ptext SLIT("__u") <+> ppr_mono_ty pREC_CON u,
- ppr_mono_ty pREC_CON ty])
- -- pREC_FUN would be logical for u, but it yields a reduce/reduce conflict with AppTy
-
-- Generics
ppr_mono_ty ctxt_prec (HsNumTy n) = integer n
ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) = ppr ty1 <+> ppr op <+> ppr ty2
| not saturated = generic_case
| isTupleTyCon tc = HsTupleTy (HsTupCon (getName tc) (tupleTyConBoxity tc) (tyConArity tc)) tys'
| tc `hasKey` listTyConKey = HsListTy (head tys')
+ | tc `hasKey` parrTyConKey = HsPArrTy (head tys')
| tc `hasKey` usOnceTyConKey = hsUsOnce_Name -- must print !, . unqualified
| tc `hasKey` usManyTyConKey = hsUsMany_Name -- must print !, . unqualified
| otherwise = generic_case
(map toHsPred preds)
(toHsType tau)
-toHsType (UsageTy u ty) = HsUsageTy (toHsType u) (toHsType ty)
- -- **! consider dropping usMany annotations ToDo KSW 2000-10
-
-
toHsPred (ClassP cls tys) = HsClassP (getName cls) (map toHsType tys)
toHsPred (IParam n ty) = HsIParam n (toHsType ty)
eq_hsType env (HsListTy ty1) (HsListTy ty2)
= eq_hsType env ty1 ty2
+eq_hsType env (HsKindSig ty1 k1) (HsKindSig ty2 k2)
+ = eq_hsType env ty1 ty2 && k1 `eqKind` k2
+
+eq_hsType env (HsPArrTy ty1) (HsPArrTy ty2)
+ = eq_hsType env ty1 ty2
+
eq_hsType env (HsAppTy fun_ty1 arg_ty1) (HsAppTy fun_ty2 arg_ty2)
= eq_hsType env fun_ty1 fun_ty2 && eq_hsType env arg_ty1 arg_ty2
eq_hsType env (HsPredTy p1) (HsPredTy p2)
= eq_hsPred env p1 p2
-eq_hsType env (HsUsageTy u1 ty1) (HsUsageTy u2 ty2)
- = eq_hsType env u1 u2 && eq_hsType env ty1 ty2
-
eq_hsType env (HsOpTy lty1 op1 rty1) (HsOpTy lty2 op2 rty2)
= eq_hsVar env op1 op2 && eq_hsType env lty1 lty2 && eq_hsType env rty1 rty2