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 )
23 import Name ( pprOp, pprNonOp )
24 import Outputable ( interppSP, interpp'SP,
25 Outputable(..){-instance * []-}
28 import SrcLoc ( SrcLoc )
29 import Util ( cmpList, panic#{-ToDo:rm eventually-} )
32 %************************************************************************
34 \subsection[FixityDecl]{A fixity declaration}
36 %************************************************************************
46 instance (NamedThing name, Outputable name)
47 => Outputable (FixityDecl name) where
48 ppr sty (InfixL var prec) = print_it sty "l" prec var
49 ppr sty (InfixR var prec) = print_it sty "r" prec var
50 ppr sty (InfixN var prec) = print_it sty "" prec var
52 print_it sty suff prec var
53 = ppBesides [ppStr "infix", ppStr suff, ppSP, ppInt prec, ppSP, pprOp sty var]
56 %************************************************************************
58 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
60 %************************************************************************
64 = TyData (Context name) -- context
65 name -- type constructor
66 [name] -- type variables
67 [ConDecl name] -- data constructors (empty if abstract)
68 (Maybe [name]) -- derivings; Nothing => not specified
69 -- (i.e., derive default); Just [] => derive
70 -- *nothing*; Just <list> => as you would
75 | TyNew (Context name) -- context
76 name -- type constructor
77 [name] -- type variables
78 [ConDecl name] -- data constructor (empty if abstract)
79 (Maybe [name]) -- derivings; as above
83 | TySynonym name -- type constructor
84 [name] -- type variables
85 (MonoType name) -- synonym expansion
91 instance (NamedThing name, Outputable name)
92 => Outputable (TyDecl name) where
94 ppr sty (TySynonym tycon tyvars mono_ty src_loc)
95 = ppHang (pp_decl_head sty SLIT("type") ppNil tycon tyvars)
96 4 (ppCat [ppEquals, ppr sty mono_ty])
98 ppr sty (TyData context tycon tyvars condecls derivings pragmas src_loc)
100 (pp_decl_head sty SLIT("data") (pprContext sty context) tycon tyvars)
101 (pp_condecls sty condecls)
104 ppr sty (TyNew context tycon tyvars condecl derivings pragmas src_loc)
106 (pp_decl_head sty SLIT("newtype") (pprContext sty context) tycon tyvars)
107 (pp_condecls sty condecl)
110 pp_decl_head sty str pp_context tycon tyvars
111 = ppCat [ppPStr str, pp_context, ppr sty tycon, interppSP sty tyvars]
113 pp_condecls sty [] = ppNil -- abstract datatype
114 pp_condecls sty (c:cs)
115 = ppSep (ppBeside (ppStr "= ") (ppr sty c)
116 : map (\ x -> ppBeside (ppStr "| ") (ppr sty x)) cs)
118 pp_tydecl sty pp_head pp_decl_rhs derivings
119 = ppHang pp_head 4 (ppSep [
123 Just ds -> ppBeside (ppPStr SLIT("deriving "))
124 (ppParens (ppInterleave ppComma (map (ppr sty) ds)))])
127 A type for recording what types a datatype should be specialised to.
128 It's called a ``Sig'' because it's sort of like a ``type signature''
129 for an datatype declaration.
132 data SpecDataSig name
133 = SpecDataSig name -- tycon to specialise
137 instance (NamedThing name, Outputable name)
138 => Outputable (SpecDataSig name) where
140 ppr sty (SpecDataSig tycon ty _)
141 = ppCat [ppStr "{-# SPECIALIZE data", ppr sty ty, ppStr "#-}"]
144 %************************************************************************
146 \subsection[ConDecl]{A data-constructor declaration}
148 %************************************************************************
152 = ConDecl name -- prefix-style con decl
156 | ConOpDecl (BangType name) -- infix-style con decl
162 [([name], BangType name)] -- list of "fields"
165 | NewConDecl name -- newtype con decl
170 = Banged (MonoType name)
171 | Unbanged (MonoType name)
175 instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
177 ppr sty (ConDecl con tys _)
178 = ppCat [pprNonOp sty con, ppInterleave ppNil (map (ppr_bang sty) tys)]
179 ppr sty (ConOpDecl ty1 op ty2 _)
180 = ppCat [ppr_bang sty ty1, pprOp sty op, ppr_bang sty ty2]
181 ppr sty (NewConDecl con ty _)
182 = ppCat [pprNonOp sty con, pprParendMonoType sty ty]
183 ppr sty (RecConDecl con fields _)
184 = ppCat [pprNonOp sty con, ppChar '{',
185 ppInterleave pp'SP (map pp_field fields), ppChar '}']
187 pp_field (n, ty) = ppCat [ppr sty n, ppPStr SLIT("::"), ppr_bang sty ty]
189 ppr_bang sty (Banged ty) = ppBeside (ppChar '!') (pprParendMonoType sty ty)
190 ppr_bang sty (Unbanged ty) = pprParendMonoType sty ty
193 %************************************************************************
195 \subsection[ClassDecl]{A class declaration}
197 %************************************************************************
200 data ClassDecl tyvar uvar name pat
201 = ClassDecl (Context name) -- context...
202 name -- name of the class
203 name -- the class type variable
204 [Sig name] -- methods' signatures
205 (MonoBinds tyvar uvar name pat) -- default methods
211 instance (NamedThing name, Outputable name, Outputable pat,
212 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
213 => Outputable (ClassDecl tyvar uvar name pat) where
215 ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc)
217 top_matter = ppCat [ppStr "class", pprContext sty context,
218 ppr sty clas, ppr sty tyvar]
220 if null sigs && nullMonoBinds methods then
221 ppAbove top_matter (ppNest 4 (ppr sty pragmas))
223 ppAboves [ppCat [top_matter, ppStr "where"],
224 ppNest 4 (ppAboves (map (ppr sty) sigs)),
225 ppNest 4 (ppr sty methods),
226 ppNest 4 (ppr sty pragmas) ]
229 %************************************************************************
231 \subsection[InstDecl]{An instance declaration (also, @SpecInstSig@)}
233 %************************************************************************
236 data InstDecl tyvar uvar name pat
237 = InstDecl name -- Class
239 (PolyType name) -- Context => Instance-type
240 -- Using a polytype means that the renamer conveniently
241 -- figures out the quantified type variables for us.
243 (MonoBinds tyvar uvar name pat)
245 Bool -- True <=> This instance decl is from the
246 -- module being compiled; False <=> It is from
247 -- an imported interface.
249 (Maybe Module) -- The name of the module where the instance decl
250 -- originally came from; Nothing => Prelude
252 [Sig name] -- actually user-supplied pragmatic info
253 (InstancePragmas name) -- interface-supplied pragmatic info
258 instance (NamedThing name, Outputable name, Outputable pat,
259 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
260 => Outputable (InstDecl tyvar uvar name pat) where
262 ppr sty (InstDecl clas ty binds local modname uprags pragmas src_loc)
266 HsPreForAllTy c t -> (c, t)
267 HsForAllTy _ c t -> (c, t)
269 top_matter = ppCat [ppStr "instance", pprContext sty context,
270 ppr sty clas, pprParendMonoType sty inst_ty]
272 if nullMonoBinds binds && null uprags then
273 ppAbove top_matter (ppNest 4 (ppr sty pragmas))
275 ppAboves [ppCat [top_matter, ppStr "where"],
276 if null uprags then ppNil else ppNest 4 (ppr sty uprags),
277 ppNest 4 (ppr sty binds),
278 ppNest 4 (ppr sty pragmas) ]
281 A type for recording what instances the user wants to specialise;
282 called a ``Sig'' because it's sort of like a ``type signature'' for an
285 data SpecInstSig name
286 = SpecInstSig name -- class
287 (MonoType name) -- type to specialise to
290 instance (NamedThing name, Outputable name)
291 => Outputable (SpecInstSig name) where
293 ppr sty (SpecInstSig clas ty _)
294 = ppCat [ppStr "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, ppStr "#-}"]
297 %************************************************************************
299 \subsection[DefaultDecl]{A @default@ declaration}
301 %************************************************************************
303 There can only be one default declaration per module, but it is hard
304 for the parser to check that; we pass them all through in the abstract
305 syntax, and that restriction must be checked in the front end.
308 data DefaultDecl name
309 = DefaultDecl [MonoType name]
312 instance (NamedThing name, Outputable name)
313 => Outputable (DefaultDecl name) where
315 ppr sty (DefaultDecl tys src_loc)
316 = ppBeside (ppPStr SLIT("default ")) (ppParens (interpp'SP sty tys))