2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[HsDecls]{Abstract syntax: global declarations}
6 Definitions for: @FixityDecl@, @TyDecl@ and @ConDecl@, @ClassDecl@,
7 @InstDecl@, @DefaultDecl@.
10 #include "HsVersions.h"
17 import HsLoop ( nullMonoBinds, MonoBinds, Sig )
18 import HsPragmas ( DataPragmas, ClassPragmas,
19 InstancePragmas, ClassOpPragmas
26 import ProtoName ( cmpProtoName, ProtoName )
27 import SrcLoc ( SrcLoc )
28 import Util ( cmpList, panic#{-ToDo:rm eventually-} )
31 %************************************************************************
33 \subsection[FixityDecl]{A fixity declaration}
35 %************************************************************************
37 These are only used in generating interfaces at the moment. They are
38 not used in pretty-printing.
48 instance (NamedThing name, Outputable name)
49 => Outputable (FixityDecl name) where
50 ppr sty (InfixL var prec) = print_it sty "l" prec var
51 ppr sty (InfixR var prec) = print_it sty "r" prec var
52 ppr sty (InfixN var prec) = print_it sty "" prec var
54 print_it sty suff prec var
55 = ppBesides [ppStr "infix", ppStr suff, ppSP, ppInt prec, ppSP, pprOp sty var]
58 %************************************************************************
60 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
62 %************************************************************************
66 = TyData (Context name) -- context
67 name -- type constructor
68 [name] -- type variables
69 [ConDecl name] -- data constructors (empty if abstract)
70 (Maybe [name]) -- derivings; Nothing => not specified
71 -- (i.e., derive default); Just [] => derive
72 -- *nothing*; Just <list> => as you would
77 | TyNew (Context name) -- context
78 name -- type constructor
79 [name] -- type variables
80 [ConDecl name] -- data constructor (empty if abstract)
81 (Maybe [name]) -- derivings; as above
85 | TySynonym name -- type constructor
86 [name] -- type variables
87 (MonoType name) -- synonym expansion
93 instance (NamedThing name, Outputable name)
94 => Outputable (TyDecl name) where
96 ppr sty (TySynonym tycon tyvars mono_ty src_loc)
97 = ppHang (pp_decl_head sty SLIT("type") ppNil tycon tyvars)
98 4 (ppCat [ppEquals, ppr sty mono_ty])
100 ppr sty (TyData context tycon tyvars condecls derivings pragmas src_loc)
102 (pp_decl_head sty SLIT("data") (pprContext sty context) tycon tyvars)
103 (pp_condecls sty condecls)
106 ppr sty (TyNew context tycon tyvars condecl derivings pragmas src_loc)
108 (pp_decl_head sty SLIT("newtype") (pprContext sty context) tycon tyvars)
109 (pp_condecls sty condecl)
112 pp_decl_head sty str pp_context tycon tyvars
113 = ppCat [ppPStr str, pp_context, ppr sty tycon, interppSP sty tyvars]
115 pp_condecls sty [] = ppNil -- abstract datatype
116 pp_condecls sty (c:cs)
117 = ppSep (ppBeside (ppStr "= ") (ppr sty c)
118 : map (\ x -> ppBeside (ppStr "| ") (ppr sty x)) cs)
120 pp_tydecl sty pp_head pp_decl_rhs derivings
121 = ppHang pp_head 4 (ppSep [
125 Just ds -> ppBeside (ppPStr SLIT("deriving "))
126 (ppParens (ppInterleave ppComma (map (ppr sty) ds)))])
129 A type for recording what types a datatype should be specialised to.
130 It's called a ``Sig'' because it's sort of like a ``type signature''
131 for an datatype declaration.
134 data SpecDataSig name
135 = SpecDataSig name -- tycon to specialise
139 instance (NamedThing name, Outputable name)
140 => Outputable (SpecDataSig name) where
142 ppr sty (SpecDataSig tycon ty _)
143 = ppCat [ppStr "{-# SPECIALIZE data", ppr sty ty, ppStr "#-}"]
146 %************************************************************************
148 \subsection[ConDecl]{A data-constructor declaration}
150 %************************************************************************
154 = ConDecl name -- prefix-style con decl
158 | ConOpDecl (BangType name) -- infix-style con decl
164 [([name], BangType name)] -- list of "fields"
167 | NewConDecl name -- newtype con decl
172 = Banged (MonoType name)
173 | Unbanged (MonoType name)
176 In checking interfaces, we need to ``compare'' @ConDecls@. Use with care!
178 eqConDecls cons1 cons2
179 = case (cmpList cmp cons1 cons2) of { EQ_ -> True; _ -> False }
181 cmp (ConDecl n1 tys1 _) (ConDecl n2 tys2 _)
182 = case cmpProtoName n1 n2 of
183 EQ_ -> cmpList cmp_bang_ty tys1 tys2
185 cmp (ConOpDecl _ _ _ _) _ = panic# "eqConDecls:ConOpDecl"
186 cmp (RecConDecl _ _ _) _ = panic# "eqConDecls:RecConDecl"
187 cmp (NewConDecl _ _ _) _ = panic# "eqConDecls:NewConDecl"
190 cmp_ty = cmpMonoType cmpProtoName
192 cmp_bang_ty (Banged ty1) (Banged ty2) = cmp_ty ty1 ty2
193 cmp_bang_ty (Unbanged ty1) (Unbanged ty2) = cmp_ty ty1 ty2
194 cmp_bang_ty (Banged _) _ = LT_
195 cmp_bang_ty _ _ = GT_
199 instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
201 ppr sty (ConDecl con tys _)
202 = ppCat [pprNonOp sty con, ppInterleave ppNil (map (ppr_bang sty) tys)]
203 ppr sty (ConOpDecl ty1 op ty2 _)
204 = ppCat [ppr_bang sty ty1, pprOp sty op, ppr_bang sty ty2]
205 ppr sty (NewConDecl con ty _)
206 = ppCat [pprNonOp sty con, pprParendMonoType sty ty]
207 ppr sty (RecConDecl con fields _)
208 = ppCat [pprNonOp sty con, ppChar '{',
209 ppInterleave pp'SP (map pp_field fields), ppChar '}']
211 pp_field (n, ty) = ppCat [ppr sty n, ppPStr SLIT("::"), ppr_bang sty ty]
213 ppr_bang sty (Banged ty) = ppBeside (ppChar '!') (pprParendMonoType sty ty)
214 ppr_bang sty (Unbanged ty) = pprParendMonoType sty ty
217 %************************************************************************
219 \subsection[ClassDecl]{A class declaration}
221 %************************************************************************
224 data ClassDecl tyvar uvar name pat
225 = ClassDecl (Context name) -- context...
226 name -- name of the class
227 name -- the class type variable
228 [Sig name] -- methods' signatures
229 (MonoBinds tyvar uvar name pat) -- default methods
235 instance (NamedThing name, Outputable name, Outputable pat,
236 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
237 => Outputable (ClassDecl tyvar uvar name pat) where
239 ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc)
240 = ppAboves [ppCat [ppStr "class", pprContext sty context, ppr sty clas,
241 ppr sty tyvar, ppStr "where"],
242 -- ToDo: really shouldn't print "where" unless there are sigs
243 ppNest 4 (ppAboves (map (ppr sty) sigs)),
244 ppNest 4 (ppr sty methods),
245 ppNest 4 (ppr sty pragmas)]
248 %************************************************************************
250 \subsection[InstDecl]{An instance declaration (also, @SpecInstSig@)}
252 %************************************************************************
255 data InstDecl tyvar uvar name pat
256 = InstDecl name -- Class
258 (PolyType name) -- Context => Instance-type
259 -- Using a polytype means that the renamer conveniently
260 -- figures out the quantified type variables for us.
262 (MonoBinds tyvar uvar name pat)
264 Bool -- True <=> This instance decl is from the
265 -- module being compiled; False <=> It is from
266 -- an imported interface.
268 FAST_STRING -- The name of the module where the instance decl
269 -- originally came from; easy enough if it's
270 -- the module being compiled; otherwise, the
271 -- info comes from a pragma.
273 [Sig name] -- actually user-supplied pragmatic info
274 (InstancePragmas name) -- interface-supplied pragmatic info
279 instance (NamedThing name, Outputable name, Outputable pat,
280 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
281 => Outputable (InstDecl tyvar uvar name pat) where
283 ppr sty (InstDecl clas ty binds local modname uprags pragmas src_loc)
287 HsPreForAllTy c t -> (c, t)
288 HsForAllTy _ c t -> (c, t)
290 top_matter = ppCat [ppStr "instance", pprContext sty context,
291 ppr sty clas, pprParendMonoType sty inst_ty]
293 if nullMonoBinds binds && null uprags then
294 ppAbove top_matter (ppNest 4 (ppr sty pragmas))
297 ppCat [top_matter, ppStr "where"],
298 if null uprags then ppNil else ppNest 4 (ppr sty uprags),
299 ppNest 4 (ppr sty binds),
300 ppNest 4 (ppr sty pragmas) ]
303 A type for recording what instances the user wants to specialise;
304 called a ``Sig'' because it's sort of like a ``type signature'' for an
307 data SpecInstSig name
308 = SpecInstSig name -- class
309 (MonoType name) -- type to specialise to
312 instance (NamedThing name, Outputable name)
313 => Outputable (SpecInstSig name) where
315 ppr sty (SpecInstSig clas ty _)
316 = ppCat [ppStr "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, ppStr "#-}"]
319 %************************************************************************
321 \subsection[DefaultDecl]{A @default@ declaration}
323 %************************************************************************
325 There can only be one default declaration per module, but it is hard
326 for the parser to check that; we pass them all through in the abstract
327 syntax, and that restriction must be checked in the front end.
330 data DefaultDecl name
331 = DefaultDecl [MonoType name]
334 instance (NamedThing name, Outputable name)
335 => Outputable (DefaultDecl name) where
337 ppr sty (DefaultDecl tys src_loc)
338 = ppBeside (ppPStr SLIT("default ")) (ppParens (interpp'SP sty tys))