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(..)
19 , pprParendMonoType, pprContext
20 , extractMonoTyNames, extractCtxtTyNames
21 , cmpPolyType, cmpMonoType, cmpContext
28 import Outputable ( interppSP, ifnotPprForUser )
31 import Util ( thenCmp, cmpList, isIn, panic# )
33 #endif {- COMPILING_GHC -}
36 This is the syntax for types as seen in type signatures.
40 = HsPreForAllTy (Context name)
43 -- The renamer turns HsPreForAllTys into HsForAllTys when they
44 -- occur in signatures, to make the binding of variables
45 -- explicit. This distinction is made visible for
46 -- non-COMPILING_GHC code, because you probably want to do the
53 type Context name = [ClassAssertion name]
55 type ClassAssertion name = (name, name)
58 = MonoTyVar name -- Type variable
60 | MonoTyApp name -- Type constructor or variable
63 -- We *could* have a "MonoTyCon name" equiv to "MonoTyApp name []"
64 -- (for efficiency, what?) WDP 96/02/18
66 | MonoFunTy (MonoType name) -- function type
69 | MonoListTy (MonoType name) -- list type
70 | MonoTupleTy [MonoType name] -- tuple type (length gives arity)
73 -- these next two are only used in unfoldings in interfaces
74 | MonoDictTy name -- Class
77 | MonoForAllTy [(name, Kind)]
79 -- *** NOTA BENE *** A "monotype" in a pragma can have
80 -- for-alls in it, (mostly to do with dictionaries). These
81 -- must be explicitly Kinded.
83 #endif {- COMPILING_GHC -}
86 This is used in various places:
89 pprContext :: (Outputable name) => PprStyle -> (Context name) -> Pretty
91 pprContext sty [] = ppNil
92 pprContext sty [(clas, ty)] = ppCat [ppr sty clas, ppr sty ty, ppStr "=>"]
93 pprContext sty context
94 = ppBesides [ppLparen,
95 ppInterleave ppComma (map pp_assert context),
96 ppRparen, ppStr " =>"]
99 = ppCat [ppr sty clas, ppr sty ty]
103 instance (Outputable name) => Outputable (PolyType name) where
104 ppr sty (HsPreForAllTy ctxt ty)
105 = print_it sty ppNil ctxt ty
106 ppr sty (HsForAllTy [] ctxt ty)
107 = print_it sty ppNil ctxt ty
108 ppr sty (HsForAllTy tvs ctxt ty)
110 (ppBesides [ppStr "_forall_ ", interppSP sty tvs, ppStr " => "])
113 print_it sty pp_forall ctxt ty
114 = ppCat [ifnotPprForUser sty pp_forall, -- print foralls unless PprForUser
115 pprContext sty ctxt, ppr sty ty]
117 pprParendPolyType :: Outputable name => PprStyle -> PolyType name -> Pretty
118 pprParendPolyType sty ty = ppr sty ty -- ToDo: more later
120 instance (Outputable name) => Outputable (MonoType name) where
123 pREC_TOP = (0 :: Int)
124 pREC_FUN = (1 :: Int)
125 pREC_CON = (2 :: Int)
127 -- printing works more-or-less as for Types
129 pprMonoType, pprParendMonoType :: (Outputable name) => PprStyle -> MonoType name -> Pretty
131 pprMonoType sty ty = ppr_mono_ty sty pREC_TOP ty
132 pprParendMonoType sty ty = ppr_mono_ty sty pREC_CON ty
134 ppr_mono_ty sty ctxt_prec (MonoTyVar name) = ppr sty name
136 ppr_mono_ty sty ctxt_prec (MonoFunTy ty1 ty2)
137 = let p1 = ppr_mono_ty sty pREC_FUN ty1
138 p2 = ppr_mono_ty sty pREC_TOP ty2
140 if ctxt_prec < pREC_FUN then -- no parens needed
141 ppSep [p1, ppBeside (ppStr "-> ") p2]
143 ppSep [ppBeside ppLparen p1, ppBesides [ppStr "-> ", p2, ppRparen]]
145 ppr_mono_ty sty ctxt_prec (MonoTupleTy tys)
146 = ppBesides [ppLparen, ppInterleave ppComma (map (ppr sty) tys), ppRparen]
148 ppr_mono_ty sty ctxt_prec (MonoListTy ty)
149 = ppBesides [ppLbrack, ppr_mono_ty sty pREC_TOP ty, ppRbrack]
151 ppr_mono_ty sty ctxt_prec (MonoTyApp tycon tys)
152 = let pp_tycon = ppr sty tycon in
155 else if ctxt_prec < pREC_CON then -- no parens needed
156 ppCat [pp_tycon, ppInterleave ppNil (map (ppr_mono_ty sty pREC_CON) tys)]
158 ppBesides [ ppLparen, pp_tycon, ppSP,
159 ppInterleave ppNil (map (ppr_mono_ty sty pREC_CON) tys), ppRparen ]
162 ppr_mono_ty sty ctxt_prec (MonoDictTy clas ty)
163 = ppBesides [ppStr "{{", ppr sty clas, ppSP, ppr_mono_ty sty ctxt_prec ty, ppStr "}}"]
165 #endif {- COMPILING_GHC -}
171 extractCtxtTyNames :: Eq name => Context name -> [name]
172 extractMonoTyNames :: Eq name => (name -> Bool) -> MonoType name -> [name]
174 extractCtxtTyNames ctxt
178 | tv `is_elem` acc = acc
179 | otherwise = tv : acc
181 is_elem = isIn "extractCtxtTyNames"
183 extractMonoTyNames is_tyvar_name ty
186 get (MonoTyApp con tys) acc = let
187 rest = foldr get acc tys
189 if is_tyvar_name con && not (con `is_elem` rest)
192 get (MonoListTy ty) acc = get ty acc
193 get (MonoFunTy ty1 ty2) acc = get ty1 (get ty2 acc)
194 get (MonoDictTy _ ty) acc = get ty acc
195 get (MonoTupleTy tys) acc = foldr get acc tys
196 get (MonoTyVar tv) acc
197 | tv `is_elem` acc = acc
198 | otherwise = tv : acc
200 is_elem = isIn "extractMonoTyNames"
202 #endif {- COMPILING_GHC -}
205 We do define a specialised equality for these \tr{*Type} types; used
206 in checking interfaces. Most any other use is likely to be {\em
207 wrong}, so be careful!
211 cmpPolyType :: (a -> a -> TAG_) -> PolyType a -> PolyType a -> TAG_
212 cmpMonoType :: (a -> a -> TAG_) -> MonoType a -> MonoType a -> TAG_
213 cmpContext :: (a -> a -> TAG_) -> Context a -> Context a -> TAG_
215 -- We assume that HsPreForAllTys have been smashed by now.
217 cmpPolyType _ (HsPreForAllTy _ _) _ = panic# "cmpPolyType:HsPreForAllTy:1st arg"
218 cmpPolyType _ _ (HsPreForAllTy _ _) = panic# "cmpPolyType:HsPreForAllTy:2nd arg"
221 cmpPolyType cmp (HsForAllTy tvs1 c1 t1) (HsForAllTy tvs2 c2 t2)
222 = cmpList cmp tvs1 tvs2 `thenCmp`
223 cmpContext cmp c1 c2 `thenCmp`
224 cmpMonoType cmp t1 t2
227 cmpMonoType cmp (MonoTyVar n1) (MonoTyVar n2)
230 cmpMonoType cmp (MonoTupleTy tys1) (MonoTupleTy tys2)
231 = cmpList (cmpMonoType cmp) tys1 tys2
232 cmpMonoType cmp (MonoListTy ty1) (MonoListTy ty2)
233 = cmpMonoType cmp ty1 ty2
235 cmpMonoType cmp (MonoTyApp tc1 tys1) (MonoTyApp tc2 tys2)
236 = cmp tc1 tc2 `thenCmp`
237 cmpList (cmpMonoType cmp) tys1 tys2
239 cmpMonoType cmp (MonoFunTy a1 b1) (MonoFunTy a2 b2)
240 = cmpMonoType cmp a1 a2 `thenCmp` cmpMonoType cmp b1 b2
242 cmpMonoType cmp (MonoDictTy c1 ty1) (MonoDictTy c2 ty2)
243 = cmp c1 c2 `thenCmp` cmpMonoType cmp ty1 ty2
245 cmpMonoType cmp ty1 ty2 -- tags must be different
249 if tag1 _LT_ tag2 then LT_ else GT_
251 tag (MonoTyVar n1) = (ILIT(1) :: FAST_INT)
252 tag (MonoTupleTy tys1) = ILIT(2)
253 tag (MonoListTy ty1) = ILIT(3)
254 tag (MonoTyApp tc1 tys1) = ILIT(4)
255 tag (MonoFunTy a1 b1) = ILIT(5)
256 tag (MonoDictTy c1 ty1) = ILIT(7)
260 = cmpList cmp_ctxt a b
262 cmp_ctxt (c1, tv1) (c2, tv2)
263 = cmp c1 c2 `thenCmp` cmp tv1 tv2
265 #endif {- COMPILING_GHC -}