2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
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,
11 #include "HsVersions.h"
14 PolyType(..), MonoType(..),
15 Context(..), ClassAssertion(..)
18 , pprParendMonoType, pprContext
19 , extractMonoTyNames, extractCtxtTyNames
20 , cmpPolyType, cmpMonoType, cmpContext
27 import Outputable ( interppSP, ifnotPprForUser )
30 import Util ( thenCmp, cmpList, isIn, panic# )
32 #endif {- COMPILING_GHC -}
35 This is the syntax for types as seen in type signatures.
39 = HsPreForAllTy (Context name)
42 -- The renamer turns HsPreForAllTys into HsForAllTys when they
43 -- occur in signatures, to make the binding of variables
44 -- explicit. This distinction is made visible for
45 -- non-COMPILING_GHC code, because you probably want to do the
52 type Context name = [ClassAssertion name]
54 type ClassAssertion name = (name, name)
57 = MonoTyVar name -- Type variable
59 | MonoTyApp name -- Type constructor or variable
62 -- We *could* have a "MonoTyCon name" equiv to "MonoTyApp name []"
63 -- (for efficiency, what?) WDP 96/02/18
65 | MonoFunTy (MonoType name) -- function type
68 | MonoListTy (MonoType name) -- list type
69 | MonoTupleTy [MonoType name] -- tuple type (length gives arity)
72 -- these next two are only used in unfoldings in interfaces
73 | MonoDictTy name -- Class
76 | MonoForAllTy [(name, Kind)]
78 -- *** NOTA BENE *** A "monotype" in a pragma can have
79 -- for-alls in it, (mostly to do with dictionaries). These
80 -- must be explicitly Kinded.
82 #endif {- COMPILING_GHC -}
85 This is used in various places:
88 pprContext :: (Outputable name) => PprStyle -> (Context name) -> Pretty
90 pprContext sty [] = ppNil
91 pprContext sty [(clas, ty)] = ppCat [ppr sty clas, ppr sty ty, ppStr "=>"]
92 pprContext sty context
93 = ppBesides [ppLparen,
94 ppInterleave ppComma (map pp_assert context),
95 ppRparen, ppStr " =>"]
98 = ppCat [ppr sty clas, ppr sty ty]
102 instance (Outputable name) => Outputable (PolyType name) where
103 ppr sty (HsPreForAllTy ctxt ty)
104 = print_it sty ppNil ctxt ty
105 ppr sty (HsForAllTy tvs ctxt ty)
107 (ppBesides [ppStr "_forall_ ", interppSP sty tvs, ppStr " => "])
110 print_it sty pp_forall ctxt ty
111 = ppCat [ifnotPprForUser sty pp_forall, -- print foralls unless PprForUser
112 pprContext sty ctxt, ppr sty ty]
114 instance (Outputable name) => Outputable (MonoType name) where
117 pREC_TOP = (0 :: Int)
118 pREC_FUN = (1 :: Int)
119 pREC_CON = (2 :: Int)
121 -- printing works more-or-less as for Types
123 pprMonoType, pprParendMonoType :: (Outputable name) => PprStyle -> MonoType name -> Pretty
125 pprMonoType sty ty = ppr_mono_ty sty pREC_TOP ty
126 pprParendMonoType sty ty = ppr_mono_ty sty pREC_CON ty
128 ppr_mono_ty sty ctxt_prec (MonoTyVar name) = ppr sty name
130 ppr_mono_ty sty ctxt_prec (MonoFunTy ty1 ty2)
131 = let p1 = ppr_mono_ty sty pREC_FUN ty1
132 p2 = ppr_mono_ty sty pREC_TOP ty2
134 if ctxt_prec < pREC_FUN then -- no parens needed
135 ppSep [p1, ppBeside (ppStr "-> ") p2]
137 ppSep [ppBeside ppLparen p1, ppBesides [ppStr "-> ", p2, ppRparen]]
139 ppr_mono_ty sty ctxt_prec (MonoTupleTy tys)
140 = ppBesides [ppLparen, ppInterleave ppComma (map (ppr sty) tys), ppRparen]
142 ppr_mono_ty sty ctxt_prec (MonoListTy ty)
143 = ppBesides [ppLbrack, ppr_mono_ty sty pREC_TOP ty, ppRbrack]
145 ppr_mono_ty sty ctxt_prec (MonoTyApp tycon tys)
146 = let pp_tycon = ppr sty tycon in
149 else if ctxt_prec < pREC_CON then -- no parens needed
150 ppCat [pp_tycon, ppInterleave ppNil (map (ppr_mono_ty sty pREC_CON) tys)]
152 ppBesides [ ppLparen, pp_tycon, ppSP,
153 ppInterleave ppNil (map (ppr_mono_ty sty pREC_CON) tys), ppRparen ]
156 ppr_mono_ty sty ctxt_prec (MonoDictTy clas ty)
157 = ppBesides [ppStr "{{", ppr sty clas, ppSP, ppr_mono_ty sty ctxt_prec ty, ppStr "}}"]
159 #endif {- COMPILING_GHC -}
165 extractCtxtTyNames :: Eq name => Context name -> [name]
166 extractMonoTyNames :: Eq name => MonoType name -> [name]
168 extractCtxtTyNames ctxt
172 | tv `is_elem` acc = acc
173 | otherwise = tv : acc
175 is_elem = isIn "extractCtxtTyNames"
177 extractMonoTyNames ty
180 get (MonoTyApp con tys) acc = foldr get acc tys
181 get (MonoListTy ty) acc = get ty acc
182 get (MonoFunTy ty1 ty2) acc = get ty1 (get ty2 acc)
183 get (MonoDictTy _ ty) acc = get ty acc
184 get (MonoTupleTy tys) acc = foldr get acc tys
185 get (MonoTyVar tv) acc
186 | tv `is_elem` acc = acc
187 | otherwise = tv : acc
189 is_elem = isIn "extractMonoTyNames"
191 #endif {- COMPILING_GHC -}
194 We do define a specialised equality for these \tr{*Type} types; used
195 in checking interfaces. Most any other use is likely to be {\em
196 wrong}, so be careful!
200 cmpPolyType :: (a -> a -> TAG_) -> PolyType a -> PolyType a -> TAG_
201 cmpMonoType :: (a -> a -> TAG_) -> MonoType a -> MonoType a -> TAG_
202 cmpContext :: (a -> a -> TAG_) -> Context a -> Context a -> TAG_
204 -- We assume that HsPreForAllTys have been smashed by now.
206 cmpPolyType _ (HsPreForAllTy _ _) _ = panic# "cmpPolyType:HsPreForAllTy:1st arg"
207 cmpPolyType _ _ (HsPreForAllTy _ _) = panic# "cmpPolyType:HsPreForAllTy:2nd arg"
210 cmpPolyType cmp (HsForAllTy tvs1 c1 t1) (HsForAllTy tvs2 c2 t2)
211 = thenCmp (cmp_tvs tvs1 tvs2)
212 (thenCmp (cmpContext cmp c1 c2) (cmpMonoType cmp t1 t2))
217 cmp_tvs (a:as) (b:bs)
218 = thenCmp (cmp a b) (cmp_tvs as bs)
219 cmp_tvs _ _ = panic# "cmp_tvs"
222 cmpMonoType cmp (MonoTyVar n1) (MonoTyVar n2)
225 cmpMonoType cmp (MonoTupleTy tys1) (MonoTupleTy tys2)
226 = cmpList (cmpMonoType cmp) tys1 tys2
227 cmpMonoType cmp (MonoListTy ty1) (MonoListTy ty2)
228 = cmpMonoType cmp ty1 ty2
230 cmpMonoType cmp (MonoTyApp tc1 tys1) (MonoTyApp tc2 tys2)
231 = thenCmp (cmp tc1 tc2) (cmpList (cmpMonoType cmp) tys1 tys2)
233 cmpMonoType cmp (MonoFunTy a1 b1) (MonoFunTy a2 b2)
234 = thenCmp (cmpMonoType cmp a1 a2) (cmpMonoType cmp b1 b2)
236 cmpMonoType cmp (MonoDictTy c1 ty1) (MonoDictTy c2 ty2)
237 = thenCmp (cmp c1 c2) (cmpMonoType cmp ty1 ty2)
239 cmpMonoType cmp ty1 ty2 -- tags must be different
243 if tag1 _LT_ tag2 then LT_ else GT_
245 tag (MonoTyVar n1) = (ILIT(1) :: FAST_INT)
246 tag (MonoTupleTy tys1) = ILIT(2)
247 tag (MonoListTy ty1) = ILIT(3)
248 tag (MonoTyApp tc1 tys1) = ILIT(4)
249 tag (MonoFunTy a1 b1) = ILIT(5)
250 tag (MonoDictTy c1 ty1) = ILIT(7)
254 = cmpList cmp_ctxt a b
256 cmp_ctxt (c1, tv1) (c2, tv2)
257 = thenCmp (cmp c1 c2) (cmp tv1 tv2)
259 #endif {- COMPILING_GHC -}