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 SYN_IE(Context), SYN_IE(ClassAssertion)
19 , pprParendMonoType, pprContext
20 , extractMonoTyNames, extractCtxtTyNames
21 , cmpPolyType, cmpMonoType, cmpContext
28 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 [] ctxt ty)
106 = print_it sty ppNil ctxt ty
107 ppr sty (HsForAllTy tvs ctxt ty)
109 (ppBesides [ppStr "_forall_ ", interppSP sty tvs, ppStr " => "])
112 print_it sty pp_forall ctxt ty
113 = ppCat [ifnotPprForUser sty pp_forall, -- print foralls unless PprForUser
114 pprContext sty ctxt, ppr sty ty]
116 pprParendPolyType :: Outputable name => PprStyle -> PolyType name -> Pretty
117 pprParendPolyType sty ty = ppr sty ty -- ToDo: more later
119 instance (Outputable name) => Outputable (MonoType name) where
122 pREC_TOP = (0 :: Int)
123 pREC_FUN = (1 :: Int)
124 pREC_CON = (2 :: Int)
126 -- printing works more-or-less as for Types
128 pprMonoType, pprParendMonoType :: (Outputable name) => PprStyle -> MonoType name -> Pretty
130 pprMonoType sty ty = ppr_mono_ty sty pREC_TOP ty
131 pprParendMonoType sty ty = ppr_mono_ty sty pREC_CON ty
133 ppr_mono_ty sty ctxt_prec (MonoTyVar name) = ppr sty name
135 ppr_mono_ty sty ctxt_prec (MonoFunTy ty1 ty2)
136 = let p1 = ppr_mono_ty sty pREC_FUN ty1
137 p2 = ppr_mono_ty sty pREC_TOP ty2
139 if ctxt_prec < pREC_FUN then -- no parens needed
140 ppSep [p1, ppBeside (ppStr "-> ") p2]
142 ppSep [ppBeside ppLparen p1, ppBesides [ppStr "-> ", p2, ppRparen]]
144 ppr_mono_ty sty ctxt_prec (MonoTupleTy tys)
145 = ppBesides [ppLparen, ppInterleave ppComma (map (ppr sty) tys), ppRparen]
147 ppr_mono_ty sty ctxt_prec (MonoListTy ty)
148 = ppBesides [ppLbrack, ppr_mono_ty sty pREC_TOP ty, ppRbrack]
150 ppr_mono_ty sty ctxt_prec (MonoTyApp tycon tys)
151 = let pp_tycon = ppr sty tycon in
154 else if ctxt_prec < pREC_CON then -- no parens needed
155 ppCat [pp_tycon, ppInterleave ppNil (map (ppr_mono_ty sty pREC_CON) tys)]
157 ppBesides [ ppLparen, pp_tycon, ppSP,
158 ppInterleave ppNil (map (ppr_mono_ty sty pREC_CON) tys), ppRparen ]
161 ppr_mono_ty sty ctxt_prec (MonoDictTy clas ty)
162 = ppBesides [ppStr "{{", ppr sty clas, ppSP, ppr_mono_ty sty ctxt_prec ty, ppStr "}}"]
164 #endif {- COMPILING_GHC -}
170 extractCtxtTyNames :: Eq name => Context name -> [name]
171 extractMonoTyNames :: Eq name => (name -> Bool) -> MonoType name -> [name]
173 extractCtxtTyNames ctxt
177 | tv `is_elem` acc = acc
178 | otherwise = tv : acc
180 is_elem = isIn "extractCtxtTyNames"
182 extractMonoTyNames is_tyvar_name ty
185 get (MonoTyApp con tys) acc = let
186 rest = foldr get acc tys
188 if is_tyvar_name con && not (con `is_elem` rest)
191 get (MonoListTy ty) acc = get ty acc
192 get (MonoFunTy ty1 ty2) acc = get ty1 (get ty2 acc)
193 get (MonoDictTy _ ty) acc = get ty acc
194 get (MonoTupleTy tys) acc = foldr get acc tys
195 get (MonoTyVar tv) acc
196 | tv `is_elem` acc = acc
197 | otherwise = tv : acc
199 is_elem = isIn "extractMonoTyNames"
201 #endif {- COMPILING_GHC -}
204 We do define a specialised equality for these \tr{*Type} types; used
205 in checking interfaces. Most any other use is likely to be {\em
206 wrong}, so be careful!
210 cmpPolyType :: (a -> a -> TAG_) -> PolyType a -> PolyType a -> TAG_
211 cmpMonoType :: (a -> a -> TAG_) -> MonoType a -> MonoType a -> TAG_
212 cmpContext :: (a -> a -> TAG_) -> Context a -> Context a -> TAG_
214 -- We assume that HsPreForAllTys have been smashed by now.
216 cmpPolyType _ (HsPreForAllTy _ _) _ = panic# "cmpPolyType:HsPreForAllTy:1st arg"
217 cmpPolyType _ _ (HsPreForAllTy _ _) = panic# "cmpPolyType:HsPreForAllTy:2nd arg"
220 cmpPolyType cmp (HsForAllTy tvs1 c1 t1) (HsForAllTy tvs2 c2 t2)
221 = cmpList cmp tvs1 tvs2 `thenCmp`
222 cmpContext cmp c1 c2 `thenCmp`
223 cmpMonoType cmp t1 t2
226 cmpMonoType cmp (MonoTyVar n1) (MonoTyVar n2)
229 cmpMonoType cmp (MonoTupleTy tys1) (MonoTupleTy tys2)
230 = cmpList (cmpMonoType cmp) tys1 tys2
231 cmpMonoType cmp (MonoListTy ty1) (MonoListTy ty2)
232 = cmpMonoType cmp ty1 ty2
234 cmpMonoType cmp (MonoTyApp tc1 tys1) (MonoTyApp tc2 tys2)
235 = cmp tc1 tc2 `thenCmp`
236 cmpList (cmpMonoType cmp) tys1 tys2
238 cmpMonoType cmp (MonoFunTy a1 b1) (MonoFunTy a2 b2)
239 = cmpMonoType cmp a1 a2 `thenCmp` cmpMonoType cmp b1 b2
241 cmpMonoType cmp (MonoDictTy c1 ty1) (MonoDictTy c2 ty2)
242 = cmp c1 c2 `thenCmp` cmpMonoType cmp ty1 ty2
244 cmpMonoType cmp ty1 ty2 -- tags must be different
248 if tag1 _LT_ tag2 then LT_ else GT_
250 tag (MonoTyVar n1) = (ILIT(1) :: FAST_INT)
251 tag (MonoTupleTy tys1) = ILIT(2)
252 tag (MonoListTy ty1) = ILIT(3)
253 tag (MonoTyApp tc1 tys1) = ILIT(4)
254 tag (MonoFunTy a1 b1) = ILIT(5)
255 tag (MonoDictTy c1 ty1) = ILIT(7)
259 = cmpList cmp_ctxt a b
261 cmp_ctxt (c1, tv1) (c2, tv2)
262 = cmp c1 c2 `thenCmp` cmp tv1 tv2
264 #endif {- COMPILING_GHC -}