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 )
25 import SrcLoc ( SrcLoc )
26 import Util ( cmpList, panic#{-ToDo:rm eventually-} )
29 %************************************************************************
31 \subsection[FixityDecl]{A fixity declaration}
33 %************************************************************************
43 instance (NamedThing name, Outputable name)
44 => Outputable (FixityDecl name) where
45 ppr sty (InfixL var prec) = print_it sty "l" prec var
46 ppr sty (InfixR var prec) = print_it sty "r" prec var
47 ppr sty (InfixN var prec) = print_it sty "" prec var
49 print_it sty suff prec var
50 = ppBesides [ppStr "infix", ppStr suff, ppSP, ppInt prec, ppSP, pprOp sty var]
53 %************************************************************************
55 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
57 %************************************************************************
61 = TyData (Context name) -- context
62 name -- type constructor
63 [name] -- type variables
64 [ConDecl name] -- data constructors (empty if abstract)
65 (Maybe [name]) -- derivings; Nothing => not specified
66 -- (i.e., derive default); Just [] => derive
67 -- *nothing*; Just <list> => as you would
72 | TyNew (Context name) -- context
73 name -- type constructor
74 [name] -- type variables
75 [ConDecl name] -- data constructor (empty if abstract)
76 (Maybe [name]) -- derivings; as above
80 | TySynonym name -- type constructor
81 [name] -- type variables
82 (MonoType name) -- synonym expansion
88 instance (NamedThing name, Outputable name)
89 => Outputable (TyDecl name) where
91 ppr sty (TySynonym tycon tyvars mono_ty src_loc)
92 = ppHang (pp_decl_head sty SLIT("type") ppNil tycon tyvars)
93 4 (ppCat [ppEquals, ppr sty mono_ty])
95 ppr sty (TyData context tycon tyvars condecls derivings pragmas src_loc)
97 (pp_decl_head sty SLIT("data") (pprContext sty context) tycon tyvars)
98 (pp_condecls sty condecls)
101 ppr sty (TyNew context tycon tyvars condecl derivings pragmas src_loc)
103 (pp_decl_head sty SLIT("newtype") (pprContext sty context) tycon tyvars)
104 (pp_condecls sty condecl)
107 pp_decl_head sty str pp_context tycon tyvars
108 = ppCat [ppPStr str, pp_context, ppr sty tycon, interppSP sty tyvars]
110 pp_condecls sty [] = ppNil -- abstract datatype
111 pp_condecls sty (c:cs)
112 = ppSep (ppBeside (ppStr "= ") (ppr sty c)
113 : map (\ x -> ppBeside (ppStr "| ") (ppr sty x)) cs)
115 pp_tydecl sty pp_head pp_decl_rhs derivings
116 = ppHang pp_head 4 (ppSep [
120 Just ds -> ppBeside (ppPStr SLIT("deriving "))
121 (ppParens (ppInterleave ppComma (map (ppr sty) ds)))])
124 A type for recording what types a datatype should be specialised to.
125 It's called a ``Sig'' because it's sort of like a ``type signature''
126 for an datatype declaration.
129 data SpecDataSig name
130 = SpecDataSig name -- tycon to specialise
134 instance (NamedThing name, Outputable name)
135 => Outputable (SpecDataSig name) where
137 ppr sty (SpecDataSig tycon ty _)
138 = ppCat [ppStr "{-# SPECIALIZE data", ppr sty ty, ppStr "#-}"]
141 %************************************************************************
143 \subsection[ConDecl]{A data-constructor declaration}
145 %************************************************************************
149 = ConDecl name -- prefix-style con decl
153 | ConOpDecl (BangType name) -- infix-style con decl
159 [([name], BangType name)] -- list of "fields"
162 | NewConDecl name -- newtype con decl
167 = Banged (MonoType name)
168 | Unbanged (MonoType name)
172 instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
174 ppr sty (ConDecl con tys _)
175 = ppCat [pprNonOp sty con, ppInterleave ppNil (map (ppr_bang sty) tys)]
176 ppr sty (ConOpDecl ty1 op ty2 _)
177 = ppCat [ppr_bang sty ty1, pprOp sty op, ppr_bang sty ty2]
178 ppr sty (NewConDecl con ty _)
179 = ppCat [pprNonOp sty con, pprParendMonoType sty ty]
180 ppr sty (RecConDecl con fields _)
181 = ppCat [pprNonOp sty con, ppChar '{',
182 ppInterleave pp'SP (map pp_field fields), ppChar '}']
184 pp_field (n, ty) = ppCat [ppr sty n, ppPStr SLIT("::"), ppr_bang sty ty]
186 ppr_bang sty (Banged ty) = ppBeside (ppChar '!') (pprParendMonoType sty ty)
187 ppr_bang sty (Unbanged ty) = pprParendMonoType sty ty
190 %************************************************************************
192 \subsection[ClassDecl]{A class declaration}
194 %************************************************************************
197 data ClassDecl tyvar uvar name pat
198 = ClassDecl (Context name) -- context...
199 name -- name of the class
200 name -- the class type variable
201 [Sig name] -- methods' signatures
202 (MonoBinds tyvar uvar name pat) -- default methods
208 instance (NamedThing name, Outputable name, Outputable pat,
209 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
210 => Outputable (ClassDecl tyvar uvar name pat) where
212 ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc)
214 top_matter = ppCat [ppStr "class", pprContext sty context,
215 ppr sty clas, ppr sty tyvar]
217 if null sigs && nullMonoBinds methods then
218 ppAbove top_matter (ppNest 4 (ppr sty pragmas))
220 ppAboves [ppCat [top_matter, ppStr "where"],
221 ppNest 4 (ppAboves (map (ppr sty) sigs)),
222 ppNest 4 (ppr sty methods),
223 ppNest 4 (ppr sty pragmas) ]
226 %************************************************************************
228 \subsection[InstDecl]{An instance declaration (also, @SpecInstSig@)}
230 %************************************************************************
233 data InstDecl tyvar uvar name pat
234 = InstDecl name -- Class
236 (PolyType name) -- Context => Instance-type
237 -- Using a polytype means that the renamer conveniently
238 -- figures out the quantified type variables for us.
240 (MonoBinds tyvar uvar name pat)
242 Bool -- True <=> This instance decl is from the
243 -- module being compiled; False <=> It is from
244 -- an imported interface.
246 (Maybe Module) -- The name of the module where the instance decl
247 -- originally came from; Nothing => Prelude
249 [Sig name] -- actually user-supplied pragmatic info
250 (InstancePragmas name) -- interface-supplied pragmatic info
255 instance (NamedThing name, Outputable name, Outputable pat,
256 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
257 => Outputable (InstDecl tyvar uvar name pat) where
259 ppr sty (InstDecl clas ty binds local modname uprags pragmas src_loc)
263 HsPreForAllTy c t -> (c, t)
264 HsForAllTy _ c t -> (c, t)
266 top_matter = ppCat [ppStr "instance", pprContext sty context,
267 ppr sty clas, pprParendMonoType sty inst_ty]
269 if nullMonoBinds binds && null uprags then
270 ppAbove top_matter (ppNest 4 (ppr sty pragmas))
272 ppAboves [ppCat [top_matter, ppStr "where"],
273 if null uprags then ppNil else ppNest 4 (ppr sty uprags),
274 ppNest 4 (ppr sty binds),
275 ppNest 4 (ppr sty pragmas) ]
278 A type for recording what instances the user wants to specialise;
279 called a ``Sig'' because it's sort of like a ``type signature'' for an
282 data SpecInstSig name
283 = SpecInstSig name -- class
284 (MonoType name) -- type to specialise to
287 instance (NamedThing name, Outputable name)
288 => Outputable (SpecInstSig name) where
290 ppr sty (SpecInstSig clas ty _)
291 = ppCat [ppStr "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, ppStr "#-}"]
294 %************************************************************************
296 \subsection[DefaultDecl]{A @default@ declaration}
298 %************************************************************************
300 There can only be one default declaration per module, but it is hard
301 for the parser to check that; we pass them all through in the abstract
302 syntax, and that restriction must be checked in the front end.
305 data DefaultDecl name
306 = DefaultDecl [MonoType name]
309 instance (NamedThing name, Outputable name)
310 => Outputable (DefaultDecl name) where
312 ppr sty (DefaultDecl tys src_loc)
313 = ppBeside (ppPStr SLIT("default ")) (ppParens (interpp'SP sty tys))