HsDecls.lhs 9.61 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[HsDecls]{Abstract syntax: global declarations}

Definitions for: @FixityDecl@, @TyDecl@ and @ConDecl@, @ClassDecl@,
@InstDecl@, @DefaultDecl@.

\begin{code}
#include "HsVersions.h"

module HsDecls where

14
IMP_Ubiq()
15
16

-- friends:
17
IMPORT_DELOOPER(HsLoop)		( nullMonoBinds, MonoBinds, Sig )
18
import HsPragmas	( DataPragmas, ClassPragmas,
19
20
			  InstancePragmas, ClassOpPragmas
			)
21
22
23
import HsTypes

-- others:
24
import Name		( pprSym, pprNonSym )
25
26
27
import Outputable	( interppSP, interpp'SP,
			  Outputable(..){-instance * []-}
			)
28
29
import Pretty
import SrcLoc		( SrcLoc )
30
import Util		( panic#{-ToDo:rm eventually-} )
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
\end{code}

%************************************************************************
%*									*
\subsection[FixityDecl]{A fixity declaration}
%*									*
%************************************************************************

\begin{code}
data FixityDecl name
  = InfixL	name Int
  | InfixR	name Int
  | InfixN	name Int
\end{code}

\begin{code}
instance (NamedThing name, Outputable name)
     => Outputable (FixityDecl name) where
    ppr sty (InfixL var prec)	= print_it sty "l" prec var
    ppr sty (InfixR var prec)	= print_it sty "r" prec var
    ppr sty (InfixN var prec)	= print_it sty ""  prec var

print_it sty suff prec var
54
  = ppBesides [ppStr "infix", ppStr suff, ppSP, ppInt prec, ppSP, pprSym sty var]
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
\end{code}

%************************************************************************
%*									*
\subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
%*									*
%************************************************************************

\begin{code}
data TyDecl name
  = TyData	(Context name)	-- context
		name		-- type constructor
		[name]		-- type variables
		[ConDecl name]	-- data constructors (empty if abstract)
		(Maybe [name])	-- derivings; Nothing => not specified
				-- (i.e., derive default); Just [] => derive
				-- *nothing*; Just <list> => as you would
				-- expect...
		(DataPragmas name)
		SrcLoc

  | TyNew	(Context name)	-- context
		name		-- type constructor
		[name]		-- type variables
		[ConDecl name]	-- data constructor (empty if abstract)
		(Maybe [name])	-- derivings; as above
		(DataPragmas name)
		SrcLoc

  | TySynonym	name		-- type constructor
		[name]		-- type variables
		(MonoType name)	-- synonym expansion
		SrcLoc

\end{code}

\begin{code}
instance (NamedThing name, Outputable name)
	      => Outputable (TyDecl name) where

    ppr sty (TySynonym tycon tyvars mono_ty src_loc)
      = ppHang (pp_decl_head sty SLIT("type") ppNil tycon tyvars)
	     4 (ppCat [ppEquals, ppr sty mono_ty])

    ppr sty (TyData context tycon tyvars condecls derivings pragmas src_loc)
      = pp_tydecl sty
		  (pp_decl_head sty SLIT("data") (pprContext sty context) tycon tyvars)
		  (pp_condecls sty condecls)
		  derivings

    ppr sty (TyNew context tycon tyvars condecl derivings pragmas src_loc)
      = pp_tydecl sty
		  (pp_decl_head sty SLIT("newtype") (pprContext sty context) tycon tyvars)
		  (pp_condecls sty condecl)
		  derivings

pp_decl_head sty str pp_context tycon tyvars
  = ppCat [ppPStr str, pp_context, ppr sty tycon, interppSP sty tyvars]

pp_condecls sty [] = ppNil -- abstract datatype
pp_condecls sty (c:cs)
  = ppSep (ppBeside (ppStr "= ") (ppr sty c)
	   : map (\ x -> ppBeside (ppStr "| ") (ppr sty x)) cs)

pp_tydecl sty pp_head pp_decl_rhs derivings
  = ppHang pp_head 4 (ppSep [
	pp_decl_rhs,
	case derivings of
	  Nothing -> ppNil
	  Just ds -> ppBeside (ppPStr SLIT("deriving "))
			(ppParens (ppInterleave ppComma (map (ppr sty) ds)))])
\end{code}

A type for recording what types a datatype should be specialised to.
It's called a ``Sig'' because it's sort of like a ``type signature''
for an datatype declaration.

\begin{code}
data SpecDataSig name
  = SpecDataSig name		-- tycon to specialise
		(MonoType name)
		SrcLoc

instance (NamedThing name, Outputable name)
	      => Outputable (SpecDataSig name) where

    ppr sty (SpecDataSig tycon ty _)
      = ppCat [ppStr "{-# SPECIALIZE data", ppr sty ty, ppStr "#-}"]
\end{code}

%************************************************************************
%*									*
\subsection[ConDecl]{A data-constructor declaration}
%*									*
%************************************************************************

\begin{code}
data ConDecl name
  = ConDecl	name		-- prefix-style con decl
		[BangType name]
		SrcLoc

  | ConOpDecl	(BangType name)	-- infix-style con decl
		name
		(BangType name)
		SrcLoc

  | RecConDecl	name
163
		[([name], BangType name)]	-- list of "fields"
164
165
166
167
168
169
170
		SrcLoc

  | NewConDecl  name		-- newtype con decl
		(MonoType name)
		SrcLoc

data BangType name
171
172
  = Banged   (PolyType name)	-- PolyType: to allow Haskell extensions
  | Unbanged (PolyType name)	-- (MonoType only needed for straight Haskell)
173
174
175
176
177
178
\end{code}

\begin{code}
instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where

    ppr sty (ConDecl con tys _)
179
      = ppCat [pprNonSym sty con, ppInterleave ppNil (map (ppr_bang sty) tys)]
180
    ppr sty (ConOpDecl ty1 op ty2 _)
181
      = ppCat [ppr_bang sty ty1, pprSym sty op, ppr_bang sty ty2]
182
    ppr sty (NewConDecl con ty _)
183
      = ppCat [pprNonSym sty con, pprParendMonoType sty ty]
184
    ppr sty (RecConDecl con fields _)
185
      = ppCat [pprNonSym sty con, ppChar '{',
186
187
188
189
	       ppInterleave pp'SP (map pp_field fields), ppChar '}']
      where
	pp_field (n, ty) = ppCat [ppr sty n, ppPStr SLIT("::"), ppr_bang sty ty]

190
191
ppr_bang sty (Banged   ty) = ppBeside (ppChar '!') (pprParendPolyType sty ty)
ppr_bang sty (Unbanged ty) = pprParendPolyType sty ty
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
\end{code}

%************************************************************************
%*									*
\subsection[ClassDecl]{A class declaration}
%*									*
%************************************************************************

\begin{code}
data ClassDecl tyvar uvar name pat
  = ClassDecl	(Context name)	    		-- context...
		name		    		-- name of the class
		name		    		-- the class type variable
		[Sig name]			-- methods' signatures
		(MonoBinds tyvar uvar name pat)	-- default methods
		(ClassPragmas name)
		SrcLoc
\end{code}

\begin{code}
instance (NamedThing name, Outputable name, Outputable pat,
	  Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
		=> Outputable (ClassDecl tyvar uvar name pat) where

    ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc)
217
218
219
220
221
222
223
224
225
226
227
     = let 
           top_matter = ppCat [ppStr "class", pprContext sty context,
                               ppr sty clas, ppr sty tyvar]
       in
       if null sigs && nullMonoBinds methods then
	   ppAbove top_matter (ppNest 4 (ppr sty pragmas))
       else
	   ppAboves [ppCat [top_matter, ppStr "where"],
		     ppNest 4 (ppAboves (map (ppr sty) sigs)),
		     ppNest 4 (ppr sty methods),
		     ppNest 4 (ppr sty pragmas) ]
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
\end{code}

%************************************************************************
%*									*
\subsection[InstDecl]{An instance declaration (also, @SpecInstSig@)}
%*									*
%************************************************************************

\begin{code}
data InstDecl tyvar uvar name pat
  = InstDecl	name		-- Class

		(PolyType name)	-- Context => Instance-type
				-- Using a polytype means that the renamer conveniently
				-- figures out the quantified type variables for us.

		(MonoBinds tyvar uvar name pat)

		Bool		-- True <=> This instance decl is from the
				-- module being compiled; False <=> It is from
				-- an imported interface.

250
251
		(Maybe Module)	-- The name of the module where the instance decl
				-- originally came from; Nothing => Prelude
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275

		[Sig name]		-- actually user-supplied pragmatic info
		(InstancePragmas name)	-- interface-supplied pragmatic info
		SrcLoc
\end{code}

\begin{code}
instance (NamedThing name, Outputable name, Outputable pat,
	  Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
	      => Outputable (InstDecl tyvar uvar name pat) where

    ppr sty (InstDecl clas ty binds local modname uprags pragmas src_loc)
      = let
	    (context, inst_ty)
	      = case ty of
		  HsPreForAllTy c t -> (c, t)
		  HsForAllTy  _ c t -> (c, t)

	    top_matter = ppCat [ppStr "instance", pprContext sty context,
			        ppr sty clas, pprParendMonoType sty inst_ty]
	in
	if nullMonoBinds binds && null uprags then
	    ppAbove top_matter (ppNest 4 (ppr sty pragmas))
	else
276
277
278
279
	    ppAboves [ppCat [top_matter, ppStr "where"],
	              if null uprags then ppNil else ppNest 4 (ppr sty uprags),
	              ppNest 4 (ppr sty binds),
	              ppNest 4 (ppr sty pragmas) ]
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
\end{code}

A type for recording what instances the user wants to specialise;
called a ``Sig'' because it's sort of like a ``type signature'' for an
instance.
\begin{code}
data SpecInstSig name
  = SpecInstSig  name		    -- class
		 (MonoType name)    -- type to specialise to
		 SrcLoc

instance (NamedThing name, Outputable name)
	      => Outputable (SpecInstSig name) where

    ppr sty (SpecInstSig clas ty _)
      = ppCat [ppStr "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, ppStr "#-}"]
\end{code}

%************************************************************************
%*									*
\subsection[DefaultDecl]{A @default@ declaration}
%*									*
%************************************************************************

There can only be one default declaration per module, but it is hard
for the parser to check that; we pass them all through in the abstract
syntax, and that restriction must be checked in the front end.

\begin{code}
data DefaultDecl name
  = DefaultDecl	[MonoType name]
		SrcLoc

instance (NamedThing name, Outputable name)
	      => Outputable (DefaultDecl name) where

    ppr sty (DefaultDecl tys src_loc)
      = ppBeside (ppPStr SLIT("default ")) (ppParens (interpp'SP sty tys))
\end{code}