HsExpr.lhs 33.7 KB
Newer Older
1
%
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
%
5
6

HsExpr: Abstract Haskell syntax: expressions
7
8

\begin{code}
9
{-# OPTIONS -w #-}
10
11
12
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
Ian Lynagh's avatar
Ian Lynagh committed
13
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
14
15
-- for details

16
17
module HsExpr where

18
#include "HsVersions.h"
19
20

-- friends:
21
22
23
24
25
26
import HsDecls
import HsPat
import HsLit
import HsTypes
import HsImpExp
import HsBinds
27
28

-- others:
29
30
31
import Var
import Name
import BasicTypes
32
import DataCon
33
import SrcLoc
34
import Outputable	
35
import FastString
36
37
\end{code}

38

39
40
41
42
43
44
45
%************************************************************************
%*									*
\subsection{Expressions proper}
%*									*
%************************************************************************

\begin{code}
46
47
type LHsExpr id = Located (HsExpr id)

48
49
50
51
52
53
54
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
-------------------------
-- PostTcExpr is an evidence expression attached to the
-- syntax tree by the type checker (c.f. postTcType)
-- We use a PostTcTable where there are a bunch of pieces of 
-- evidence, more than is convenient to keep individually
type PostTcExpr  = HsExpr Id
type PostTcTable = [(Name, Id)]

noPostTcExpr :: PostTcExpr
noPostTcExpr = HsLit (HsString FSLIT("noPostTcExpr"))

noPostTcTable :: PostTcTable
noPostTcTable = []

-------------------------
-- SyntaxExpr is like PostTcExpr, but it's filled in a little earlier,
-- by the renamer.  It's used for rebindable syntax.  
-- E.g. (>>=) is filled in before the renamer by the appropriate Name
--      for (>>=), and then instantiated by the type checker with its
--	type args tec

type SyntaxExpr id = HsExpr id

noSyntaxExpr :: SyntaxExpr id	-- Before renaming, and sometimes after,
				-- (if the syntax slot makes no sense)
noSyntaxExpr = HsLit (HsString FSLIT("noSyntaxExpr"))


type SyntaxTable id = [(Name, SyntaxExpr id)]
--	*** Currently used only for CmdTop (sigh) ***
-- * Before the renamer, this list is noSyntaxTable
--
-- * After the renamer, it takes the form [(std_name, HsVar actual_name)]
--   For example, for the 'return' op of a monad
--	normal case:		(GHC.Base.return, HsVar GHC.Base.return)
--	with rebindable syntax:	(GHC.Base.return, return_22)
--		where return_22 is whatever "return" is in scope
--
-- * After the type checker, it takes the form [(std_name, <expression>)]
--	where <expression> is the evidence for the method

noSyntaxTable :: SyntaxTable id
noSyntaxTable = []


-------------------------
94
data HsExpr id
95
  = HsVar	id		-- variable
96
  | HsIPVar	(IPName id)	-- implicit parameter
97
98
  | HsOverLit	(HsOverLit id) -- Overloaded literals

99
  | HsLit	HsLit		-- Simple (non-overloaded) literals
100

101
102
103
  | HsLam	(MatchGroup  id)	-- Currently always a single match

  | HsApp	(LHsExpr id)		-- Application
104
		(LHsExpr id)
105

106
  -- Operator applications:
107
108
  -- NB Bracketed ops such as (+) come out as Vars.

109
110
111
  -- NB We need an expr for the operator in an OpApp/Section since
  -- the typechecker may need to apply the operator to a few types.

112
113
  | OpApp	(LHsExpr id)	-- left operand
		(LHsExpr id)	-- operator
114
		Fixity		-- Renamer adds fixity; bottom until then
115
		(LHsExpr id)	-- right operand
116

117
  | NegApp	(LHsExpr id)	-- negated expr
118
		(SyntaxExpr id)	-- Name of 'negate'
119

120
  | HsPar	(LHsExpr id)	-- parenthesised expr
121

122
123
124
125
  | SectionL	(LHsExpr id)	-- operand
		(LHsExpr id)	-- operator
  | SectionR	(LHsExpr id)	-- operator
		(LHsExpr id)	-- operand
126
				
127
  | HsCase	(LHsExpr id)
128
		(MatchGroup id)
129

130
131
132
  | HsIf	(LHsExpr id)	--  predicate
		(LHsExpr id)	--  then part
		(LHsExpr id)	--  else part
133

134
  | HsLet	(HsLocalBinds id) -- let(rec)
135
		(LHsExpr  id)
136

137
138
  | HsDo	(HsStmtContext Name)	-- The parameterisation is unimportant
					-- because in this context we never use
139
					-- the PatGuard or ParStmt variant
140
		[LStmt id]		-- "do":one or more stmts
141
142
143
		(LHsExpr id)		-- The body; the last expression in the 'do'
					--	     of [ body | ... ] in a list comp
		PostTcType		-- Type of the whole expression
144
145

  | ExplicitList		-- syntactic list
146
		PostTcType	-- Gives type of components of list
147
		[LHsExpr id]
148

chak's avatar
chak committed
149
150
  | ExplicitPArr		-- syntactic parallel array: [:e1, ..., en:]
		PostTcType	-- type of elements of the parallel array
151
		[LHsExpr id]
chak's avatar
chak committed
152

153
  | ExplicitTuple		-- tuple
154
		[LHsExpr id]
155
156
157
				-- NB: Unit is ExplicitTuple []
				-- for tuples, we can get the types
				-- direct from the components
158
		Boxity
159
160


161
	-- Record construction
162
  | RecordCon	(Located id)		-- The constructor.  After type checking
163
					-- it's the dataConWrapId of the constructor
164
		PostTcExpr		-- Data con Id applied to type args
165
		(HsRecordBinds id)
sof's avatar
sof committed
166

167
	-- Record update
168
  | RecordUpd	(LHsExpr id)
169
		(HsRecordBinds id)
170
171
172
173
174
		[DataCon]		-- Filled in by the type checker to the *non-empty*
					-- list of DataCons that have all the upd'd fields
		[PostTcType]		-- Argument types of *input* record type
		[PostTcType]		-- 		and  *output* record type
	-- For a type family, the arg types are of the *instance* tycon, not the family tycon
175

176
  | ExprWithTySig			-- e :: type
177
178
		(LHsExpr id)
		(LHsType id)
179
180
181
182
183

  | ExprWithTySigOut			-- TRANSLATION
		(LHsExpr id)
		(LHsType Name)		-- Retain the signature for round-tripping purposes

184
185
  | ArithSeq				-- arithmetic sequence
		PostTcExpr
186
		(ArithSeqInfo id)
187
188
189

  | PArrSeq	           		-- arith. sequence for parallel array
		PostTcExpr		-- [:e1..e2:] or [:e1, e2..e3:]
190
		(ArithSeqInfo id)
191

192
  | HsSCC	FastString	-- "set cost centre" (_scc_) annotation
193
		(LHsExpr id) 	-- expr whose cost is to be measured
194
195

  | HsCoreAnn   FastString      -- hdaume: core annotation
196
                (LHsExpr id)
197
		
198
  -----------------------------------------------------------
199
  -- MetaHaskell Extensions
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
200

201
  | HsBracket    (HsBracket id)
202
203
204
205
206

  | HsBracketOut (HsBracket Name)	-- Output of the type checker is the *original*
		 [PendingSplice]	-- renamed expression, plus *typechecked* splices
					-- to be pasted back in by the desugarer

207
  | HsSpliceE (HsSplice id) 
208

209
210
211
  -----------------------------------------------------------
  -- Arrow notation extension

212
213
  | HsProc	(LPat id)		-- arrow abstraction, proc
		(LHsCmdTop id)		-- body of the abstraction
214
215
216
217
218
219
					-- always has an empty stack

  ---------------------------------------
  -- The following are commands, not expressions proper

  | HsArrApp	-- Arrow tail, or arrow application (f -< arg)
220
221
	(LHsExpr id)	-- arrow expression, f
	(LHsExpr id)	-- input expression, arg
222
223
224
225
226
227
	PostTcType	-- type of the arrow expressions f,
			-- of the form a t t', where arg :: t
	HsArrAppType	-- higher-order (-<<) or first-order (-<)
	Bool		-- True => right-to-left (f -< arg)
			-- False => left-to-right (arg >- f)

ross's avatar
ross committed
228
  | HsArrForm	-- Command formation,  (| e cmd1 .. cmdn |)
229
	(LHsExpr id)	-- the operator
230
231
232
233
			-- after type-checking, a type abstraction to be
			-- applied to the type of the local environment tuple
	(Maybe Fixity)	-- fixity (filled in by the renamer), for forms that
			-- were converted from OpApp's by the renamer
234
	[LHsCmdTop id]	-- argument commands
235

236

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
237
238
239
240
241
  ---------------------------------------
  -- Haskell program coverage (Hpc) Support

  | HsTick 
     Int				-- module-local tick number
242
     [id]                               -- variables in scope
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
243
244
245
246
247
248
249
250
251
252
253
254
255
256
     (LHsExpr id)			-- sub-expression

  | HsBinTick
     Int				-- module-local tick number for True
     Int				-- module-local tick number for False
     (LHsExpr id)			-- sub-expression

  | HsTickPragma			-- A pragma introduced tick
     (FastString,(Int,Int),(Int,Int))   -- external span for this tick    
     (LHsExpr id)     

  ---------------------------------------
  -- These constructors only appear temporarily in the parser.
  -- The renamer translates them into the Right Thing.
257
258
259

  | EWildPat			-- wildcard

260
261
  | EAsPat	(Located id)	-- as pattern
		(LHsExpr id)
262

263
264
265
  | EViewPat	(LHsExpr id)	-- view pattern
		(LHsExpr id)

266
  | ELazyPat	(LHsExpr id) -- ~ pattern
267

268
  | HsType      (LHsType id)     -- Explicit type argument; e.g  f {| Int |} x y
269

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
270
271
  ---------------------------------------
  -- Finally, HsWrap appears only in typechecker output
272

273
  |  HsWrap	HsWrapper 	-- TRANSLATION
274
275
		(HsExpr id)

276
type PendingSplice = (Name, LHsExpr Id)	-- Typechecked splices, waiting to be 
277
					-- pasted back in by the desugarer
278
279
280
281
282
283
284
285
286
\end{code}

A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
@ClassDictLam dictvars methods expr@ is, therefore:
\begin{verbatim}
\ x -> case x of ( dictvars-and-methods-tuple ) -> expr
\end{verbatim}

\begin{code}
287
instance OutputableBndr id => Outputable (HsExpr id) where
288
    ppr expr = pprExpr expr
289
290
291
\end{code}

\begin{code}
292
293
-----------------------
-- pprExpr, pprLExpr, pprBinds call pprDeeper; 
294
295
-- the underscore versions do not
pprLExpr :: OutputableBndr id => LHsExpr id -> SDoc
296
297
298
pprLExpr (L _ e) = pprExpr e

pprExpr :: OutputableBndr id => HsExpr id -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
299
300
301
302
303
304
305
306
307
308
309
310
pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e
          | otherwise                           = pprDeeper (ppr_expr e)

isQuietHsExpr :: HsExpr id -> Bool
-- Parentheses do display something, but it gives little info and
-- if we go deeper when we go inside them then we get ugly things
-- like (...)
isQuietHsExpr (HsPar _) = True
-- applications don't display anything themselves
isQuietHsExpr (HsApp _ _) = True
isQuietHsExpr (OpApp _ _ _ _) = True
isQuietHsExpr _ = False
311

312
pprBinds :: (OutputableBndr idL, OutputableBndr idR) => HsLocalBindsLR idL idR -> SDoc
313
pprBinds b = pprDeeper (ppr b)
314

315
-----------------------
316
317
ppr_lexpr :: OutputableBndr id => LHsExpr id -> SDoc
ppr_lexpr e = ppr_expr (unLoc e)
318

319
ppr_expr :: OutputableBndr id => HsExpr id -> SDoc
320
ppr_expr (HsVar v)	 = pprHsVar v
321
ppr_expr (HsIPVar v)     = ppr v
322
323
ppr_expr (HsLit lit)     = ppr lit
ppr_expr (HsOverLit lit) = ppr lit
324
325
326
327
ppr_expr (HsPar e)	 = parens (ppr_lexpr e)

ppr_expr (HsCoreAnn s e)
  = vcat [ptext SLIT("HsCoreAnn") <+> ftext s, ppr_lexpr e]
328

329
330
ppr_expr (HsApp e1 e2)
  = let (fun, args) = collect_args e1 [e2] in
331
    hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))
332
  where
333
334
    collect_args (L _ (HsApp fun arg)) args = collect_args fun (arg:args)
    collect_args fun args = (fun, args)
335

336
ppr_expr (OpApp e1 op fixity e2)
337
  = case unLoc op of
338
339
340
      HsVar v -> pp_infixly v
      _	      -> pp_prefixly
  where
341
342
    pp_e1 = pprDebugParendExpr e1   -- In debug mode, add parens 
    pp_e2 = pprDebugParendExpr e2   -- to make precedence clear
343
344

    pp_prefixly
345
      = hang (ppr op) 2 (sep [pp_e1, pp_e2])
346
347

    pp_infixly v
348
      = sep [nest 2 pp_e1, pprInfix v, nest 2 pp_e2]
349

350
ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
351

352
ppr_expr (SectionL expr op)
353
  = case unLoc op of
354
355
356
      HsVar v -> pp_infixly v
      _	      -> pp_prefixly
  where
357
    pp_expr = pprDebugParendExpr expr
358

359
    pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
sof's avatar
sof committed
360
		       4 (hsep [pp_expr, ptext SLIT("x_ )")])
361
    pp_infixly v = (sep [pp_expr, pprInfix v])
362

363
ppr_expr (SectionR op expr)
364
  = case unLoc op of
365
366
367
      HsVar v -> pp_infixly v
      _	      -> pp_prefixly
  where
368
    pp_expr = pprDebugParendExpr expr
369

370
    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext SLIT("x_")])
sof's avatar
sof committed
371
		       4 ((<>) pp_expr rparen)
372
    pp_infixly v
373
      = (sep [pprInfix v, pp_expr])
374

375
376
ppr_expr (HsLam matches :: HsExpr id) 
  = pprMatches (LambdaExpr :: HsMatchContext id) matches
377

378
ppr_expr (HsCase expr matches :: HsExpr id)
379
  = sep [ sep [ptext SLIT("case"), nest 4 (ppr expr), ptext SLIT("of")],
380
	    nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches) ]
381

382
383
384
ppr_expr (HsIf e1 e2 e3)
  = sep [hsep [ptext SLIT("if"), nest 2 (ppr e1), ptext SLIT("then")],
	   nest 4 (ppr e2),
sof's avatar
sof committed
385
	   ptext SLIT("else"),
386
	   nest 4 (ppr e3)]
387
388

-- special case: let ... in let ...
389
ppr_expr (HsLet binds expr@(L _ (HsLet _ _)))
390
  = sep [hang (ptext SLIT("let")) 2 (hsep [pprBinds binds, ptext SLIT("in")]),
391
	 ppr_lexpr expr]
392

393
ppr_expr (HsLet binds expr)
394
  = sep [hang (ptext SLIT("let")) 2 (pprBinds binds),
395
	 hang (ptext SLIT("in"))  2 (ppr expr)]
396

397
ppr_expr (HsDo do_or_list_comp stmts body _) = pprDo do_or_list_comp stmts body
398

399
ppr_expr (ExplicitList _ exprs)
400
  = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
401

chak's avatar
chak committed
402
ppr_expr (ExplicitPArr _ exprs)
403
  = pa_brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
chak's avatar
chak committed
404

405
ppr_expr (ExplicitTuple exprs boxity)
406
  = tupleParens boxity (sep (punctuate comma (map ppr_lexpr exprs)))
407

408
ppr_expr (RecordCon con_id con_expr rbinds)
409
  = hang (ppr con_id) 2 (ppr rbinds)
410

411
ppr_expr (RecordUpd aexp rbinds _ _ _)
412
  = hang (pprParendExpr aexp) 2 (ppr rbinds)
413
414

ppr_expr (ExprWithTySig expr sig)
415
  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
416
	 4 (ppr sig)
417
418
419
ppr_expr (ExprWithTySigOut expr sig)
  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
	 4 (ppr sig)
420

421
422
ppr_expr (ArithSeq expr info) = brackets (ppr info)
ppr_expr (PArrSeq expr info)  = pa_brackets (ppr info)
chak's avatar
chak committed
423

424
ppr_expr EWildPat     = char '_'
425
426
427
428
ppr_expr (ELazyPat e) = char '~' <> pprParendExpr e
ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e

ppr_expr (HsSCC lbl expr)
429
  = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ftext lbl), pprParendExpr expr ]
430

431
ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
432
ppr_expr (HsType id)	    = ppr id
chak's avatar
chak committed
433

434
435
ppr_expr (HsSpliceE s)       = pprSplice s
ppr_expr (HsBracket b)       = pprHsBracket b
436
437
ppr_expr (HsBracketOut e []) = ppr e	
ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("pending") <+> ppr ps
438

439
440
ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
  = hsep [ptext SLIT("proc"), ppr pat, ptext SLIT("->"), ppr cmd]
441

442
443
ppr_expr (HsTick tickId vars exp)
  = hcat [ptext SLIT("tick<"), ppr tickId,ptext SLIT(">("), hsep (map pprHsVar vars), ppr exp,ptext SLIT(")")]
andy@galois.com's avatar
andy@galois.com committed
444
445
446
447
448
449
450
ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
  = hcat [ptext SLIT("bintick<"), 
	  ppr tickIdTrue,
	  ptext SLIT(","),
	  ppr tickIdFalse,
	  ptext SLIT(">("), 
	  ppr exp,ptext SLIT(")")]
andy@galois.com's avatar
andy@galois.com committed
451
452
ppr_expr (HsTickPragma externalSrcLoc exp)
  = hcat [ptext SLIT("tickpragma<"), ppr externalSrcLoc,ptext SLIT(">("), ppr exp,ptext SLIT(")")]
andy@galois.com's avatar
andy@galois.com committed
453

454
455
456
457
458
459
460
461
ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
  = hsep [ppr_lexpr arrow, ptext SLIT("-<"), ppr_lexpr arg]
ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
  = hsep [ppr_lexpr arg, ptext SLIT(">-"), ppr_lexpr arrow]
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
  = hsep [ppr_lexpr arrow, ptext SLIT("-<<"), ppr_lexpr arg]
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
  = hsep [ppr_lexpr arg, ptext SLIT(">>-"), ppr_lexpr arrow]
462

463
464
465
466
467
ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
  = sep [pprCmdArg (unLoc arg1), hsep [pprInfix v, pprCmdArg (unLoc arg2)]]
ppr_expr (HsArrForm op _ args)
  = hang (ptext SLIT("(|") <> ppr_lexpr op)
	 4 (sep (map (pprCmdArg.unLoc) args) <> ptext SLIT("|)"))
468
469

pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
470
471
472
473
pprCmdArg (HsCmdTop cmd@(L _ (HsArrForm _ Nothing [])) _ _ _)
  = ppr_lexpr cmd
pprCmdArg (HsCmdTop cmd _ _ _)
  = parens (ppr_lexpr cmd)
474
475
476
477
478
479
480
481

-- Put a var in backquotes if it's not an operator already
pprInfix :: Outputable name => name -> SDoc
pprInfix v | isOperator ppr_v = ppr_v
	   | otherwise        = char '`' <> ppr_v <> char '`'
	   where
	     ppr_v = ppr v

chak's avatar
chak committed
482
483
-- add parallel array brackets around a document
--
484
485
pa_brackets :: SDoc -> SDoc
pa_brackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")    
486
487
\end{code}

488
489
490
491
492
493
494
495
496
497
HsSyn records exactly where the user put parens, with HsPar.
So generally speaking we print without adding any parens.
However, some code is internally generated, and in some places
parens are absolutely required; so for these places we use
pprParendExpr (but don't print double parens of course).

For operator applications we don't add parens, because the oprerator
fixities should do the job, except in debug mode (-dppr-debug) so we
can see the structure of the parse tree.

498
\begin{code}
499
500
501
502
503
504
pprDebugParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
pprDebugParendExpr expr
  = getPprStyle (\sty ->
    if debugStyle sty then pprParendExpr expr
		      else pprLExpr      expr)
  
505
pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
506
pprParendExpr expr
507
  = let
508
509
510
	pp_as_was = pprLExpr expr
	-- Using pprLExpr makes sure that we go 'deeper'
	-- I think that is usually (always?) right
511
    in
512
    case unLoc expr of
513
514
515
516
517
518
519
520
521
522
523
524
525
      HsLit l		   -> pp_as_was
      HsOverLit l 	   -> pp_as_was
      HsVar _		   -> pp_as_was
      HsIPVar _		   -> pp_as_was
      ExplicitList _ _     -> pp_as_was
      ExplicitPArr _ _     -> pp_as_was
      ExplicitTuple _ _	   -> pp_as_was
      HsPar _		   -> pp_as_was
      HsBracket _	   -> pp_as_was
      HsBracketOut _ []	   -> pp_as_was
      HsDo sc _ _ _
       | isListCompExpr sc -> pp_as_was
      _			   -> parens pp_as_was
526
527
528
529
530
531
532
533
534

isAtomicHsExpr :: HsExpr id -> Bool	-- A single token
isAtomicHsExpr (HsVar {})     = True
isAtomicHsExpr (HsLit {})     = True
isAtomicHsExpr (HsOverLit {}) = True
isAtomicHsExpr (HsIPVar {})   = True
isAtomicHsExpr (HsWrap _ e)   = isAtomicHsExpr e
isAtomicHsExpr (HsPar e)      = isAtomicHsExpr (unLoc e)
isAtomicHsExpr e	      = False
535
536
\end{code}

537
538
539
540
541
542
543
544
545
546
547
%************************************************************************
%*									*
\subsection{Commands (in arrow abstractions)}
%*									*
%************************************************************************

We re-use HsExpr to represent these.

\begin{code}
type HsCmd id = HsExpr id

548
549
type LHsCmd id = LHsExpr id

550
551
552
553
554
555
556
557
558
data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
\end{code}

The legal constructors for commands are:

  = HsArrApp ...		-- as above

  | HsArrForm ...		-- as above

ross's avatar
ross committed
559
560
561
  | HsApp	(HsCmd id)
		(HsExpr id)

562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
  | HsLam	(Match  id)	-- kappa

  -- the renamer turns this one into HsArrForm
  | OpApp	(HsExpr id)	-- left operand
		(HsCmd id)	-- operator
		Fixity		-- Renamer adds fixity; bottom until then
		(HsCmd id)	-- right operand

  | HsPar	(HsCmd id)	-- parenthesised command

  | HsCase	(HsExpr id)
		[Match id]	-- bodies are HsCmd's
		SrcLoc

  | HsIf	(HsExpr id)	--  predicate
		(HsCmd id)	--  then part
		(HsCmd id)	--  else part
		SrcLoc

581
  | HsLet	(HsLocalBinds id)	-- let(rec)
582
583
584
585
586
587
588
589
590
591
592
593
594
595
		(HsCmd  id)

  | HsDo	(HsStmtContext Name)	-- The parameterisation is unimportant
					-- because in this context we never use
					-- the PatGuard or ParStmt variant
		[Stmt id]	-- HsExpr's are really HsCmd's
		PostTcType	-- Type of the whole expression
		SrcLoc

Top-level command, introducing a new arrow.
This may occur inside a proc (where the stack is empty) or as an
argument of a command-forming operator.

\begin{code}
596
597
type LHsCmdTop id = Located (HsCmdTop id)

598
data HsCmdTop id
599
  = HsCmdTop	(LHsCmd id)
600
601
		[PostTcType]	-- types of inputs on the command's stack
		PostTcType	-- return type of the command
602
		(SyntaxTable id)
603
604
605
606
				-- after type checking:
				-- names used in the command's desugaring
\end{code}

607
608
609
610
611
612
613
%************************************************************************
%*									*
\subsection{Record binds}
%*									*
%************************************************************************

\begin{code}
614
type HsRecordBinds id = HsRecFields id (LHsExpr id)
615
616
\end{code}

617
618


619
620
%************************************************************************
%*									*
621
\subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
622
623
624
%*									*
%************************************************************************

625
626
627
628
629
630
631
632
633
634
635
636
637
638
@Match@es are sets of pattern bindings and right hand sides for
functions, patterns or case branches. For example, if a function @g@
is defined as:
\begin{verbatim}
g (x,y) = y
g ((x:ys),y) = y+1,
\end{verbatim}
then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.

It is always the case that each element of an @[Match]@ list has the
same number of @pats@s inside it.  This corresponds to saying that
a function defined by pattern matching must have the same number of
patterns in each equation.

639
\begin{code}
640
641
642
643
644
645
646
data MatchGroup id 
  = MatchGroup 
	[LMatch id] 	-- The alternatives
	PostTcType	-- The type is the type of the entire group
			-- 	t1 -> ... -> tn -> tr
			-- where there are n patterns

647
648
type LMatch id = Located (Match id)

649
data Match id
650
  = Match
651
652
	[LPat id]		-- The patterns
	(Maybe (LHsType id))	-- A type signature for the result of the match
653
				--	Nothing after typechecking
654
	(GRHSs id)
655

656
matchGroupArity :: MatchGroup id -> Arity
657
658
matchGroupArity (MatchGroup [] _) 
  = panic "matchGroupArity"	-- MatchGroup is never empty
659
660
661
662
663
664
665
matchGroupArity (MatchGroup (match:matches) _)
  = ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
	-- Assertion just checks that all the matches have the same number of pats
    n_pats
  where
    n_pats = length (hsLMatchPats match)

666
667
668
hsLMatchPats :: LMatch id -> [LPat id]
hsLMatchPats (L _ (Match pats _ _)) = pats

669
-- GRHSs are used both for pattern bindings and for Matches
670
data GRHSs id	
671
  = GRHSs [LGRHS id]		-- Guarded RHSs
672
	  (HsLocalBinds id)	-- The where clause
673

674
type LGRHS id = Located (GRHS id)
675

676
677
data GRHS id = GRHS [LStmt id]		-- Guards
		    (LHsExpr id)	-- Right hand side
678
\end{code}
679

680
We know the list must have at least one @Match@ in it.
681

682
\begin{code}
683
pprMatches :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> MatchGroup idR -> SDoc
684
685
686
pprMatches ctxt (MatchGroup matches ty) = vcat (map (pprMatch ctxt) (map unLoc matches))
                                          -- Don't print the type; it's only 
                                          -- a place-holder before typechecking
687
688

-- Exported to HsBinds, which can't see the defn of HsMatchContext
689
pprFunBind :: (OutputableBndr idL, OutputableBndr idR) => idL -> Bool -> MatchGroup idR -> SDoc
690
pprFunBind fun inf matches = pprMatches (FunRhs fun inf) matches
691
692

-- Exported to HsBinds, which can't see the defn of HsMatchContext
693
694
pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
	   => LPat bndr -> GRHSs id -> SDoc
695
pprPatBind pat (grhss :: GRHSs id) = sep [ppr pat, nest 4 (pprGRHSs (PatBindRhs :: HsMatchContext id) grhss)]
696
697


698
pprMatch :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> Match idR -> SDoc
699
pprMatch ctxt (Match pats maybe_ty grhss)
700
701
702
  = herald <+> sep [sep (map ppr other_pats), 
		    ppr_maybe_ty, 
		    nest 2 (pprGRHSs ctxt grhss)]
703
  where
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
    (herald, other_pats) 
	= case ctxt of
	    FunRhs fun is_infix
		| not is_infix -> (ppr fun, pats)
			-- f x y z = e
			-- Not pprBndr; the AbsBinds will
			-- have printed the signature

		| null pats3 -> (pp_infix, [])
			-- x &&& y = e

		| otherwise -> (parens pp_infix, pats3)
			-- (x &&& y) z = e
		where
		  (pat1:pat2:pats3) = pats
		  pp_infix = ppr pat1 <+> ppr fun <+> ppr pat2

	    LambdaExpr -> (char '\\', pats)
	    other      -> (empty,     pats)
723

724
725
726
727
728
    ppr_maybe_ty = case maybe_ty of
			Just ty -> dcolon <+> ppr ty
			Nothing -> empty


729
pprGRHSs :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> GRHSs idR -> SDoc
730
pprGRHSs ctxt (GRHSs grhss binds)
Ian Lynagh's avatar
Ian Lynagh committed
731
732
733
  = vcat (map (pprGRHS ctxt . unLoc) grhss)
 $$ if isEmptyLocalBinds binds then empty
                               else text "where" $$ nest 4 (pprBinds binds)
734

735
pprGRHS :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> GRHS idR -> SDoc
736

737
pprGRHS ctxt (GRHS [] expr)
738
 =  pp_rhs ctxt expr
739

740
pprGRHS ctxt (GRHS guards expr)
741
 = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
742

743
pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
744
\end{code}
745

746
747
748
749
750
751
752
%************************************************************************
%*									*
\subsection{Do stmts and list comprehensions}
%*									*
%************************************************************************

\begin{code}
753
754
755
756
type LStmt id = Located (StmtLR id id)
type LStmtLR idL idR = Located (StmtLR idL idR)

type Stmt id = StmtLR id id
757

758
759
-- The SyntaxExprs in here are used *only* for do-notation, which
-- has rebindable syntax.  Otherwise they are unused.
760
761
762
763
764
data StmtLR idL idR
  = BindStmt	(LPat idL)		
		(LHsExpr idR) 
		(SyntaxExpr idR)		-- The (>>=) operator
		(SyntaxExpr idR)		-- The fail operator 
765
766
767
		-- The fail operator is noSyntaxExpr 
		-- if the pattern match can't fail

768
769
  | ExprStmt	(LHsExpr idR)
		(SyntaxExpr idR)		-- The (>>) operator
770
771
		PostTcType		-- Element type of the RHS (used for arrows)

772
  | LetStmt	(HsLocalBindsLR idL idR)	
773
774

	-- ParStmts only occur in a list comprehension
775
776
  | ParStmt	[([LStmt idL], [idR])] -- After renaming, the ids are the binders
					 -- bound by the stmts and used subsequently
777

778
	-- Recursive statement (see Note [RecStmt] below)
779
  | RecStmt  [LStmtLR idL idR] 
780
		--- The next two fields are only valid after renaming
781
	     [idR] 	-- The ids are a subset of the variables bound by the stmts
782
783
	     	 	-- that are used in stmts that follow the RecStmt

784
	     [idR]	-- Ditto, but these variables are the "recursive" ones, that 
785
786
787
			-- are used before they are bound in the stmts of the RecStmt
			-- From a type-checking point of view, these ones have to be monomorphic

788
789
		--- These fields are only valid after typechecking
	     [PostTcExpr]	-- These expressions correspond
790
791
792
793
				-- 1-to-1 with the "recursive" [id], and are the expresions that 
				-- should be returned by the recursion.  They may not quite be the
				-- Ids themselves, because the Id may be *polymorphic*, but
				-- the returned thing has to be *monomorphic*.
794
	     (DictBinds idR)	-- Method bindings of Ids bound by the RecStmt,
795
				-- and used afterwards
796
797
\end{code}

798
ExprStmts are a bit tricky, because what they mean
799
depends on the context.  Consider the following contexts:
800
801
802

	A do expression of type (m res_ty)
	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
803
	* ExprStmt E any_ty:   do { ....; E; ... }
804
805
806
807
808
		E :: m any_ty
	  Translation: E >> ...
	
	A list comprehensions of type [elt_ty]
	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
809
	* ExprStmt E Bool:   [ .. | .... E ]
810
811
			[ .. | ..., E, ... ]
			[ .. | .... | ..., E | ... ]
812
813
		E :: Bool
	  Translation: if E then fail else ...
814

815
816
	A guard list, guarding a RHS of type rhs_ty
	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
817
	* ExprStmt E Bool:   f x | ..., E, ... = ...rhs...
818
819
820
		E :: Bool
	  Translation: if E then fail else ...
	
chak's avatar
chak committed
821
Array comprehensions are handled like list comprehensions -=chak
822

823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
Note [RecStmt]
~~~~~~~~~~~~~~
Example:
	HsDo [ BindStmt x ex

	     , RecStmt [a::forall a. a -> a, b] 
		       [a::Int -> Int,       c] 
		       [ BindStmt b (return x)
		       , LetStmt a = ea
		       , BindStmt c ec ]

	     , return (a b) ]

Here, the RecStmt binds a,b,c; but 
  - Only a,b are used in the stmts *following* the RecStmt, 
	This 'a' is *polymorphic'
  - Only a,c are used in the stmts *inside* the RecStmt
	*before* their bindings
	This 'a' is monomorphic

Nota Bene: the two a's have different types, even though they
have the same Name.


847
\begin{code}
848
instance (OutputableBndr idL, OutputableBndr idR) => Outputable (StmtLR idL idR) where
849
850
    ppr stmt = pprStmt stmt

851
pprStmt :: (OutputableBndr idL, OutputableBndr idR) => (StmtLR idL idR) -> SDoc
852
853
854
855
856
857
858
pprStmt (BindStmt pat expr _ _)	  = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
pprStmt (LetStmt binds)       	  = hsep [ptext SLIT("let"), pprBinds binds]
pprStmt (ExprStmt expr _ _)   	  = ppr expr
pprStmt (ParStmt stmtss)          = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
pprStmt (RecStmt segment _ _ _ _) = ptext SLIT("rec") <+> braces (vcat (map ppr segment))

pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> LHsExpr id -> SDoc
859
860
pprDo DoExpr      stmts body = ptext SLIT("do")  <+> pprDeeperList vcat (map ppr stmts ++ [ppr body])
pprDo (MDoExpr _) stmts body = ptext SLIT("mdo") <+> pprDeeperList vcat (map ppr stmts ++ [ppr body])
861
862
pprDo ListComp    stmts body = pprComp brackets    stmts body
pprDo PArrComp    stmts body = pprComp pa_brackets stmts body
863
pprDo other	  stmts body = panic "pprDo" 	-- PatGuard, ParStmtCxt
864
865
866

pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [LStmt id] -> LHsExpr id -> SDoc
pprComp brack quals body
867
  = brack $
868
	hang (ppr body <+> char '|')
869
	     4 (interpp'SP quals)
870
871
\end{code}

872
873
874
875
876
877
878
%************************************************************************
%*									*
		Template Haskell quotation brackets
%*									*
%************************************************************************

\begin{code}
879
data HsSplice id  = HsSplice 	--  $z  or $(f 4)
880
881
882
883
884
885
886
			id 		-- The id is just a unique name to 
			(LHsExpr id) 	-- identify this splice point
					
instance OutputableBndr id => Outputable (HsSplice id) where
  ppr = pprSplice

pprSplice :: OutputableBndr id => HsSplice id -> SDoc
887
pprSplice (HsSplice n e) = char '$' <> ifPprDebug (brackets (ppr n)) <> pprParendExpr e
888
889


890
891
data HsBracket id = ExpBr (LHsExpr id)		-- [|  expr  |]
		  | PatBr (LPat id)		-- [p| pat   |]
892
		  | DecBr (HsGroup id)		-- [d| decls |]
893
		  | TypBr (LHsType id)		-- [t| type  |]
894
		  | VarBr id			-- 'x, ''T
895
896
897
898
899
900
901

instance OutputableBndr id => Outputable (HsBracket id) where
  ppr = pprHsBracket


pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
902
pprHsBracket (DecBr d) = thBrackets (char 'd') (ppr d)
903
pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
904
905
906
907
908
pprHsBracket (VarBr n) = char '\'' <> ppr n
	-- Infelicity: can't show ' vs '', because
	-- we can't ask n what its OccName is, because the 
	-- pretty-printer for HsExpr doesn't ask for NamedThings
	-- But the pretty-printer for names will show the OccName class
909
910
911
912
913

thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+> 
			     pp_body <+> ptext SLIT("|]")
\end{code}

914
915
916
917
918
919
920
%************************************************************************
%*									*
\subsection{Enumerations and list comprehensions}
%*									*
%************************************************************************

\begin{code}
921
data ArithSeqInfo id
922
923
924
925
926
927
928
929
  = From	    (LHsExpr id)
  | FromThen 	    (LHsExpr id)
		    (LHsExpr id)
  | FromTo	    (LHsExpr id)
		    (LHsExpr id)
  | FromThenTo	    (LHsExpr id)
		    (LHsExpr id)
		    (LHsExpr id)
930
931
932
\end{code}

\begin{code}
933
instance OutputableBndr id => Outputable (ArithSeqInfo id) where
934
935
936
937
938
    ppr (From e1)		= hcat [ppr e1, pp_dotdot]
    ppr (FromThen e1 e2)	= hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
    ppr (FromTo e1 e3)	= hcat [ppr e1, pp_dotdot, ppr e3]
    ppr (FromThenTo e1 e2 e3)
      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
939

sof's avatar
sof committed
940
pp_dotdot = ptext SLIT(" .. ")
941
\end{code}
942
943
944
945
946
947
948
949
950


%************************************************************************
%*									*
\subsection{HsMatchCtxt}
%*									*
%************************************************************************

\begin{code}
951
data HsMatchContext id	-- Context of a Match
952
  = FunRhs id Bool		-- Function binding for f; True <=> written infix
953
954
  | CaseAlt			-- Guard on a case alternative
  | LambdaExpr			-- Pattern of a lambda
955
  | ProcExpr			-- Pattern of a proc
956
957
958
959
  | PatBindRhs			-- Pattern binding
  | RecUpd			-- Record update [used only in DsExpr to tell matchWrapper
				-- 	what sort of runtime error message to generate]
  | StmtCtxt (HsStmtContext id)	-- Pattern of a do-stmt or list comprehension
960
961
  deriving ()

962
963
964
data HsStmtContext id
  = ListComp 
  | DoExpr 
965
966
967
  | MDoExpr PostTcTable			-- Recursive do-expression
					-- (tiresomely, it needs table
					--  of its return/bind ops)
968
969
  | PArrComp				-- Parallel array comprehension
  | PatGuard (HsMatchContext id)	-- Pattern guard for specified thing
970
  | ParStmtCtxt (HsStmtContext id)	-- A branch of a parallel stmt 
971
972
973
\end{code}

\begin{code}
974
isDoExpr :: HsStmtContext id -> Bool
975
976
isDoExpr DoExpr      = True
isDoExpr (MDoExpr _) = True
977
978
979
980
981
982
isDoExpr _           = False

isListCompExpr :: HsStmtContext id -> Bool
isListCompExpr ListComp = True
isListCompExpr PArrComp = True
isListCompExpr _        = False
983
984
985
\end{code}

\begin{code}
986
matchSeparator (FunRhs {})  = ptext SLIT("=")
987
988
matchSeparator CaseAlt      = ptext SLIT("->") 
matchSeparator LambdaExpr   = ptext SLIT("->") 
989
matchSeparator ProcExpr     = ptext SLIT("->") 
990
matchSeparator PatBindRhs   = ptext SLIT("=") 
991
992
matchSeparator (StmtCtxt _) = ptext SLIT("<-")  
matchSeparator RecUpd       = panic "unused"
993
994
995
\end{code}

\begin{code}
996
pprMatchContext (FunRhs fun _) 	  = ptext SLIT("the definition of") <+> quotes (ppr fun)
997
998
999
1000
pprMatchContext CaseAlt	     	  = ptext SLIT("a case alternative")
pprMatchContext RecUpd	     	  = ptext SLIT("a record-update construct")
pprMatchContext PatBindRhs   	  = ptext SLIT("a pattern binding")
pprMatchContext LambdaExpr   	  = ptext SLIT("a lambda abstraction")
1001
pprMatchContext ProcExpr   	  = ptext SLIT("an arrow abstraction")
1002
1003
pprMatchContext (StmtCtxt ctxt)   = ptext SLIT("a pattern binding in") $$ pprStmtContext ctxt

1004
pprStmtContext (ParStmtCtxt c) = sep [ptext SLIT("a parallel branch of"), pprStmtContext c]
1005
1006
pprStmtContext (PatGuard ctxt) = ptext SLIT("a pattern guard for") $$ pprMatchContext ctxt
pprStmtContext DoExpr          = ptext SLIT("a 'do' expression")
1007
pprStmtContext (MDoExpr _)     = ptext SLIT("an 'mdo' expression")
1008
1009
1010
pprStmtContext ListComp        = ptext SLIT("a list comprehension")
pprStmtContext PArrComp        = ptext SLIT("an array comprehension")

1011
1012
1013
1014
1015
1016
1017
1018
{- 
pprMatchRhsContext (FunRhs fun) = ptext SLIT("a right-hand side of function") <+> quotes (ppr fun)
pprMatchRhsContext CaseAlt	= ptext SLIT("the body of a case alternative")
pprMatchRhsContext PatBindRhs	= ptext SLIT("the right-hand side of a pattern binding")
pprMatchRhsContext LambdaExpr	= ptext SLIT("the body of a lambda")
pprMatchRhsContext ProcExpr	= ptext SLIT("the body of a proc")
pprMatchRhsContext other	= panic "pprMatchRhsContext"	-- RecUpd, StmtCtxt

1019
1020
1021
1022
1023
-- Used for the result statement of comprehension
-- e.g. the 'e' in	[ e | ... ]
--	or the 'r' in   f x = r
pprStmtResultContext (PatGuard ctxt) = pprMatchRhsContext ctxt
pprStmtResultContext other	     = ptext SLIT("the result of") <+> pprStmtContext other
1024
-}
1025
1026

-- Used to generate the string for a *runtime* error message
1027
matchContextErrString (FunRhs fun _)   	      	 = "function " ++ showSDoc (ppr fun)
1028
1029
1030
1031
matchContextErrString CaseAlt	      	      	 = "case"
matchContextErrString PatBindRhs      	      	 = "pattern binding"
matchContextErrString RecUpd	      	      	 = "record update"
matchContextErrString LambdaExpr      	      	 = "lambda"
1032
matchContextErrString ProcExpr      	      	 = "proc"
1033
1034
1035
matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
matchContextErrString (StmtCtxt (PatGuard _)) 	 = "pattern guard"
matchContextErrString (StmtCtxt DoExpr)       	 = "'do' expression"
1036
matchContextErrString (StmtCtxt (MDoExpr _))   	 = "'mdo' expression"
1037
1038
matchContextErrString (StmtCtxt ListComp)     	 = "list comprehension"
matchContextErrString (StmtCtxt PArrComp)     	 = "array comprehension"
1039
\end{code}