2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[HsTypes]{Abstract syntax: user-defined types}
6 If compiled without \tr{#define COMPILING_GHC}, you get
7 (part of) a Haskell-abstract-syntax library. With it,
12 HsType(..), HsTyVar(..),
13 Context, ClassAssertion
16 , getTyVarName, replaceTyVarName
18 , pprForAll, pprContext, pprClassAssertion
19 , cmpHsType, cmpHsTypes, cmpContext
22 #include "HsVersions.h"
24 import Type ( Kind, UsageAnn(..) )
25 import PprType ( {- instance Outputable Kind -} )
27 import Util ( thenCmp, cmpList )
30 This is the syntax for types as seen in type signatures.
33 type Context name = [ClassAssertion name]
35 type ClassAssertion name = (name, [HsType name])
36 -- The type is usually a type variable, but it
37 -- doesn't have to be when reading interface files
40 = HsForAllTy (Maybe [HsTyVar name]) -- Nothing for implicitly quantified signatures
44 | MonoTyVar name -- Type variable
46 | MonoTyApp (HsType name)
49 | MonoFunTy (HsType name) -- function type
52 | MonoListTy (HsType name) -- Element type
54 | MonoTupleTy [HsType name] -- Element types (length gives arity)
57 -- these next two are only used in interfaces
58 | MonoDictTy name -- Class
64 mkHsForAllTy [] [] ty = ty
65 mkHsForAllTy tvs ctxt ty = HsForAllTy (Just tvs) ctxt ty
69 | IfaceTyVar name Kind
70 -- *** NOTA BENE *** A "monotype" in a pragma can have
71 -- for-alls in it, (mostly to do with dictionaries). These
72 -- must be explicitly Kinded.
74 getTyVarName (UserTyVar n) = n
75 getTyVarName (IfaceTyVar n _) = n
77 replaceTyVarName :: HsTyVar name1 -> name2 -> HsTyVar name2
78 replaceTyVarName (UserTyVar n) n' = UserTyVar n'
79 replaceTyVarName (IfaceTyVar n k) n' = IfaceTyVar n' k
83 %************************************************************************
85 \subsection{Pretty printing}
87 %************************************************************************
91 instance (Outputable name) => Outputable (HsType name) where
94 instance (Outputable name) => Outputable (HsTyVar name) where
95 ppr (UserTyVar name) = ppr name
96 ppr (IfaceTyVar name kind) = hsep [ppr name, dcolon, ppr kind]
99 pprForAll tvs = ptext SLIT("forall") <+> interppSP tvs <> ptext SLIT(".")
101 pprContext :: (Outputable name) => Context name -> SDoc
102 pprContext [] = empty
103 pprContext context = parens (hsep (punctuate comma (map pprClassAssertion context))) <+> ptext SLIT("=>")
105 pprClassAssertion :: (Outputable name) => ClassAssertion name -> SDoc
106 pprClassAssertion (clas, tys)
107 = ppr clas <+> hsep (map pprParendHsType tys)
111 pREC_TOP = (0 :: Int)
112 pREC_FUN = (1 :: Int)
113 pREC_CON = (2 :: Int)
115 maybeParen :: Bool -> SDoc -> SDoc
116 maybeParen True p = parens p
117 maybeParen False p = p
119 -- printing works more-or-less as for Types
121 pprHsType, pprParendHsType :: (Outputable name) => HsType name -> SDoc
123 pprHsType ty = ppr_mono_ty pREC_TOP ty
124 pprParendHsType ty = ppr_mono_ty pREC_CON ty
126 ppr_mono_ty ctxt_prec (HsForAllTy maybe_tvs ctxt ty)
127 = maybeParen (ctxt_prec >= pREC_FUN) $
128 sep [pprForAll tvs, pprContext ctxt, pprHsType ty]
130 tvs = case maybe_tvs of
134 ppr_mono_ty ctxt_prec (MonoTyVar name)
137 ppr_mono_ty ctxt_prec (MonoFunTy ty1 ty2)
138 = let p1 = ppr_mono_ty pREC_FUN ty1
139 p2 = ppr_mono_ty pREC_TOP ty2
141 maybeParen (ctxt_prec >= pREC_FUN)
142 (sep [p1, (<>) (ptext SLIT("-> ")) p2])
144 ppr_mono_ty ctxt_prec (MonoTupleTy tys True)
145 = parens (sep (punctuate comma (map ppr tys)))
146 ppr_mono_ty ctxt_prec (MonoTupleTy tys False)
147 = ptext SLIT("(#") <> sep (punctuate comma (map ppr tys)) <> ptext SLIT("#)")
149 ppr_mono_ty ctxt_prec (MonoListTy ty)
150 = brackets (ppr_mono_ty pREC_TOP ty)
152 ppr_mono_ty ctxt_prec (MonoTyApp fun_ty arg_ty)
153 = maybeParen (ctxt_prec >= pREC_CON)
154 (hsep [ppr_mono_ty pREC_FUN fun_ty, ppr_mono_ty pREC_CON arg_ty])
156 ppr_mono_ty ctxt_prec (MonoDictTy clas tys)
157 = ppr clas <+> hsep (map (ppr_mono_ty pREC_CON) tys)
159 ppr_mono_ty ctxt_prec (MonoUsgTy u ty)
160 = maybeParen (ctxt_prec >= pREC_CON) $
161 ppr u <+> ppr_mono_ty pREC_CON ty
165 %************************************************************************
167 \subsection{Comparison}
169 %************************************************************************
171 We do define a specialised equality for these \tr{*Type} types; used
172 in checking interfaces. Most any other use is likely to be {\em
173 wrong}, so be careful!
176 cmpHsTyVar :: (a -> a -> Ordering) -> HsTyVar a -> HsTyVar a -> Ordering
177 cmpHsType :: (a -> a -> Ordering) -> HsType a -> HsType a -> Ordering
178 cmpHsTypes :: (a -> a -> Ordering) -> [HsType a] -> [HsType a] -> Ordering
179 cmpContext :: (a -> a -> Ordering) -> Context a -> Context a -> Ordering
181 cmpHsTyVar cmp (UserTyVar v1) (UserTyVar v2) = v1 `cmp` v2
182 cmpHsTyVar cmp (IfaceTyVar v1 _) (IfaceTyVar v2 _) = v1 `cmp` v2
183 cmpHsTyVar cmp (UserTyVar _) other = LT
184 cmpHsTyVar cmp other1 other2 = GT
187 cmpHsTypes cmp [] [] = EQ
188 cmpHsTypes cmp [] tys2 = LT
189 cmpHsTypes cmp tys1 [] = GT
190 cmpHsTypes cmp (ty1:tys1) (ty2:tys2) = cmpHsType cmp ty1 ty2 `thenCmp` cmpHsTypes cmp tys1 tys2
192 cmpHsType cmp (HsForAllTy tvs1 c1 t1) (HsForAllTy tvs2 c2 t2)
193 = cmpMaybe (cmpList (cmpHsTyVar cmp)) tvs1 tvs2 `thenCmp`
194 cmpContext cmp c1 c2 `thenCmp`
197 cmpHsType cmp (MonoTyVar n1) (MonoTyVar n2)
200 cmpHsType cmp (MonoTupleTy tys1 b1) (MonoTupleTy tys2 b2)
201 = (b1 `compare` b2) `thenCmp` cmpHsTypes cmp tys1 tys2
203 cmpHsType cmp (MonoListTy ty1) (MonoListTy ty2)
204 = cmpHsType cmp ty1 ty2
206 cmpHsType cmp (MonoTyApp fun_ty1 arg_ty1) (MonoTyApp fun_ty2 arg_ty2)
207 = cmpHsType cmp fun_ty1 fun_ty2 `thenCmp` cmpHsType cmp arg_ty1 arg_ty2
209 cmpHsType cmp (MonoFunTy a1 b1) (MonoFunTy a2 b2)
210 = cmpHsType cmp a1 a2 `thenCmp` cmpHsType cmp b1 b2
212 cmpHsType cmp (MonoDictTy c1 tys1) (MonoDictTy c2 tys2)
213 = cmp c1 c2 `thenCmp` cmpHsTypes cmp tys1 tys2
215 cmpHsType cmp (MonoUsgTy u1 ty1) (MonoUsgTy u2 ty2)
216 = cmpUsg u1 u2 `thenCmp` cmpHsType cmp ty1 ty2
218 cmpHsType cmp ty1 ty2 -- tags must be different
222 if tag1 _LT_ tag2 then LT else GT
224 tag (MonoTyVar n1) = (ILIT(1) :: FAST_INT)
225 tag (MonoTupleTy tys1 _) = ILIT(2)
226 tag (MonoListTy ty1) = ILIT(3)
227 tag (MonoTyApp tc1 tys1) = ILIT(4)
228 tag (MonoFunTy a1 b1) = ILIT(5)
229 tag (MonoDictTy c1 tys1) = ILIT(7)
230 tag (MonoUsgTy c1 tys1) = ILIT(6)
231 tag (HsForAllTy _ _ _) = ILIT(8)
235 = cmpList cmp_ctxt a b
237 cmp_ctxt (c1, tys1) (c2, tys2)
238 = cmp c1 c2 `thenCmp` cmpHsTypes cmp tys1 tys2
240 -- Should be in Type, perhaps
241 cmpUsg UsOnce UsOnce = EQ
242 cmpUsg UsOnce UsMany = LT
243 cmpUsg UsMany UsOnce = GT
244 cmpUsg UsMany UsMany = EQ
245 cmpUsg u1 u2 = pprPanic "cmpUsg:" $
248 -- Should be in Maybes, I guess
249 cmpMaybe cmp Nothing Nothing = EQ
250 cmpMaybe cmp Nothing (Just x) = LT
251 cmpMaybe cmp (Just x) Nothing = GT
252 cmpMaybe cmp (Just x) (Just y) = x `cmp` y