Add quasi-quotation, courtesy of Geoffrey Mainland
[ghc-hetmet.git] / compiler / hsSyn / HsExpr.lhs
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 module HsExpr where
10
11 #include "HsVersions.h"
12
13 -- friends:
14 import HsDecls
15 import HsPat
16 import HsLit
17 import HsTypes
18 import HsImpExp
19 import HsBinds
20
21 -- others:
22 import Var
23 import Name
24 import BasicTypes
25 import DataCon
26 import SrcLoc
27 import Outputable
28 import FastString
29 \end{code}
30
31
32 %************************************************************************
33 %*                                                                      *
34 \subsection{Expressions proper}
35 %*                                                                      *
36 %************************************************************************
37
38 \begin{code}
39 type LHsExpr id = Located (HsExpr id)
40
41 -------------------------
42 -- PostTcExpr is an evidence expression attached to the
43 -- syntax tree by the type checker (c.f. postTcType)
44 -- We use a PostTcTable where there are a bunch of pieces of
45 -- evidence, more than is convenient to keep individually
46 type PostTcExpr  = HsExpr Id
47 type PostTcTable = [(Name, Id)]
48
49 noPostTcExpr :: PostTcExpr
50 noPostTcExpr = HsLit (HsString FSLIT("noPostTcExpr"))
51
52 noPostTcTable :: PostTcTable
53 noPostTcTable = []
54
55 -------------------------
56 -- SyntaxExpr is like PostTcExpr, but it's filled in a little earlier,
57 -- by the renamer.  It's used for rebindable syntax.
58 -- E.g. (>>=) is filled in before the renamer by the appropriate Name
59 --      for (>>=), and then instantiated by the type checker with its
60 --      type args tec
61
62 type SyntaxExpr id = HsExpr id
63
64 noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
65                               -- (if the syntax slot makes no sense)
66 noSyntaxExpr = HsLit (HsString FSLIT("noSyntaxExpr"))
67
68
69 type SyntaxTable id = [(Name, SyntaxExpr id)]
70 -- *** Currently used only for CmdTop (sigh) ***
71 -- * Before the renamer, this list is noSyntaxTable
72 --
73 -- * After the renamer, it takes the form [(std_name, HsVar actual_name)]
74 --   For example, for the 'return' op of a monad
75 --      normal case:            (GHC.Base.return, HsVar GHC.Base.return)
76 --      with rebindable syntax: (GHC.Base.return, return_22)
77 --              where return_22 is whatever "return" is in scope
78 --
79 -- * After the type checker, it takes the form [(std_name, <expression>)]
80 --      where <expression> is the evidence for the method
81
82 noSyntaxTable :: SyntaxTable id
83 noSyntaxTable = []
84
85
86 -------------------------
87 data HsExpr id
88   = HsVar     id                        -- variable
89   | HsIPVar   (IPName id)               -- implicit parameter
90   | HsOverLit (HsOverLit id)            -- Overloaded literals
91
92   | HsLit     HsLit                     -- Simple (non-overloaded) literals
93
94   | HsLam     (MatchGroup id)           -- Currently always a single match
95
96   | HsApp     (LHsExpr id) (LHsExpr id) -- Application
97
98   -- Operator applications:
99   -- NB Bracketed ops such as (+) come out as Vars.
100
101   -- NB We need an expr for the operator in an OpApp/Section since
102   -- the typechecker may need to apply the operator to a few types.
103
104   | OpApp       (LHsExpr id)    -- left operand
105                 (LHsExpr id)    -- operator
106                 Fixity          -- Renamer adds fixity; bottom until then
107                 (LHsExpr id)    -- right operand
108
109   | NegApp      (LHsExpr id)    -- negated expr
110                 (SyntaxExpr id) -- Name of 'negate'
111
112   | HsPar       (LHsExpr id)    -- parenthesised expr
113
114   | SectionL    (LHsExpr id)    -- operand
115                 (LHsExpr id)    -- operator
116   | SectionR    (LHsExpr id)    -- operator
117                 (LHsExpr id)    -- operand
118
119   | HsCase      (LHsExpr id)
120                 (MatchGroup id)
121
122   | HsIf        (LHsExpr id)    --  predicate
123                 (LHsExpr id)    --  then part
124                 (LHsExpr id)    --  else part
125
126   | HsLet       (HsLocalBinds id) -- let(rec)
127                 (LHsExpr  id)
128
129   | HsDo        (HsStmtContext Name) -- The parameterisation is unimportant
130                                      -- because in this context we never use
131                                      -- the PatGuard or ParStmt variant
132                 [LStmt id]           -- "do":one or more stmts
133                 (LHsExpr id)         -- The body; the last expression in the
134                                      -- 'do' of [ body | ... ] in a list comp
135                 PostTcType           -- Type of the whole expression
136
137   | ExplicitList                -- syntactic list
138                 PostTcType      -- Gives type of components of list
139                 [LHsExpr id]
140
141   | ExplicitPArr                -- syntactic parallel array: [:e1, ..., en:]
142                 PostTcType      -- type of elements of the parallel array
143                 [LHsExpr id]
144
145   | ExplicitTuple               -- tuple
146                 [LHsExpr id]
147                                 -- NB: Unit is ExplicitTuple []
148                                 -- for tuples, we can get the types
149                                 -- direct from the components
150                 Boxity
151
152
153   -- Record construction
154   | RecordCon   (Located id)       -- The constructor.  After type checking
155                                    -- it's the dataConWrapId of the constructor
156                 PostTcExpr         -- Data con Id applied to type args
157                 (HsRecordBinds id)
158
159   -- Record update
160   | RecordUpd   (LHsExpr id)
161                 (HsRecordBinds id)
162                 [DataCon]          -- Filled in by the type checker to the
163                                    -- *non-empty* list of DataCons that have
164                                    -- all the upd'd fields
165                 [PostTcType]       -- Argument types of *input* record type
166                 [PostTcType]       --              and  *output* record type
167   -- For a type family, the arg types are of the *instance* tycon,
168   -- not the family tycon
169
170   | ExprWithTySig                       -- e :: type
171                 (LHsExpr id)
172                 (LHsType id)
173
174   | ExprWithTySigOut                    -- TRANSLATION
175                 (LHsExpr id)
176                 (LHsType Name)          -- Retain the signature for
177                                         -- round-tripping purposes
178
179   | ArithSeq                            -- arithmetic sequence
180                 PostTcExpr
181                 (ArithSeqInfo id)
182
183   | PArrSeq                             -- arith. sequence for parallel array
184                 PostTcExpr              -- [:e1..e2:] or [:e1, e2..e3:]
185                 (ArithSeqInfo id)
186
187   | HsSCC       FastString              -- "set cost centre" SCC pragma
188                 (LHsExpr id)            -- expr whose cost is to be measured
189
190   | HsCoreAnn   FastString              -- hdaume: core annotation
191                 (LHsExpr id)
192
193   -----------------------------------------------------------
194   -- MetaHaskell Extensions
195
196   | HsBracket    (HsBracket id)
197
198   | HsBracketOut (HsBracket Name)       -- Output of the type checker is
199                                         -- the *original*
200                  [PendingSplice]        -- renamed expression, plus
201                                         -- *typechecked* splices to be
202                                         -- pasted back in by the desugarer
203
204   | HsSpliceE (HsSplice id)
205
206   | HsQuasiQuoteE (HsQuasiQuote id)
207         -- See Note [Quasi-quote overview] in TcSplice
208
209   -----------------------------------------------------------
210   -- Arrow notation extension
211
212   | HsProc      (LPat id)               -- arrow abstraction, proc
213                 (LHsCmdTop id)          -- body of the abstraction
214                                         -- always has an empty stack
215
216   ---------------------------------------
217   -- The following are commands, not expressions proper
218
219   | HsArrApp            -- Arrow tail, or arrow application (f -< arg)
220         (LHsExpr id)    -- arrow expression, f
221         (LHsExpr id)    -- input expression, arg
222         PostTcType      -- type of the arrow expressions f,
223                         -- of the form a t t', where arg :: t
224         HsArrAppType    -- higher-order (-<<) or first-order (-<)
225         Bool            -- True => right-to-left (f -< arg)
226                         -- False => left-to-right (arg >- f)
227
228   | HsArrForm           -- Command formation,  (| e cmd1 .. cmdn |)
229         (LHsExpr id)    -- the operator
230                         -- after type-checking, a type abstraction to be
231                         -- applied to the type of the local environment tuple
232         (Maybe Fixity)  -- fixity (filled in by the renamer), for forms that
233                         -- were converted from OpApp's by the renamer
234         [LHsCmdTop id]  -- argument commands
235
236
237   ---------------------------------------
238   -- Haskell program coverage (Hpc) Support
239
240   | HsTick
241      Int                                -- module-local tick number
242      [id]                               -- variables in scope
243      (LHsExpr id)                       -- sub-expression
244
245   | HsBinTick
246      Int                                -- module-local tick number for True
247      Int                                -- module-local tick number for False
248      (LHsExpr id)                       -- sub-expression
249
250   | HsTickPragma                        -- A pragma introduced tick
251      (FastString,(Int,Int),(Int,Int))   -- external span for this tick
252      (LHsExpr id)
253
254   ---------------------------------------
255   -- These constructors only appear temporarily in the parser.
256   -- The renamer translates them into the Right Thing.
257
258   | EWildPat                 -- wildcard
259
260   | EAsPat      (Located id) -- as pattern
261                 (LHsExpr id)
262
263   | EViewPat    (LHsExpr id) -- view pattern
264                 (LHsExpr id)
265
266   | ELazyPat    (LHsExpr id) -- ~ pattern
267
268   | HsType      (LHsType id) -- Explicit type argument; e.g  f {| Int |} x y
269
270   ---------------------------------------
271   -- Finally, HsWrap appears only in typechecker output
272
273   |  HsWrap     HsWrapper    -- TRANSLATION
274                 (HsExpr id)
275
276 type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be
277                                         -- pasted back in by the desugarer
278 \end{code}
279
280 A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
281 @ClassDictLam dictvars methods expr@ is, therefore:
282 \begin{verbatim}
283 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
284 \end{verbatim}
285
286 \begin{code}
287 instance OutputableBndr id => Outputable (HsExpr id) where
288     ppr expr = pprExpr expr
289 \end{code}
290
291 \begin{code}
292 -----------------------
293 -- pprExpr, pprLExpr, pprBinds call pprDeeper;
294 -- the underscore versions do not
295 pprLExpr :: OutputableBndr id => LHsExpr id -> SDoc
296 pprLExpr (L _ e) = pprExpr e
297
298 pprExpr :: OutputableBndr id => HsExpr id -> SDoc
299 pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e
300           | otherwise                           = pprDeeper (ppr_expr e)
301
302 isQuietHsExpr :: HsExpr id -> Bool
303 -- Parentheses do display something, but it gives little info and
304 -- if we go deeper when we go inside them then we get ugly things
305 -- like (...)
306 isQuietHsExpr (HsPar _) = True
307 -- applications don't display anything themselves
308 isQuietHsExpr (HsApp _ _) = True
309 isQuietHsExpr (OpApp _ _ _ _) = True
310 isQuietHsExpr _ = False
311
312 pprBinds :: (OutputableBndr idL, OutputableBndr idR)
313          => HsLocalBindsLR idL idR -> SDoc
314 pprBinds b = pprDeeper (ppr b)
315
316 -----------------------
317 ppr_lexpr :: OutputableBndr id => LHsExpr id -> SDoc
318 ppr_lexpr e = ppr_expr (unLoc e)
319
320 ppr_expr :: OutputableBndr id => HsExpr id -> SDoc
321 ppr_expr (HsVar v)       = pprHsVar v
322 ppr_expr (HsIPVar v)     = ppr v
323 ppr_expr (HsLit lit)     = ppr lit
324 ppr_expr (HsOverLit lit) = ppr lit
325 ppr_expr (HsPar e)       = parens (ppr_lexpr e)
326
327 ppr_expr (HsCoreAnn s e)
328   = vcat [ptext SLIT("HsCoreAnn") <+> ftext s, ppr_lexpr e]
329
330 ppr_expr (HsApp e1 e2)
331   = let (fun, args) = collect_args e1 [e2] in
332     hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))
333   where
334     collect_args (L _ (HsApp fun arg)) args = collect_args fun (arg:args)
335     collect_args fun args = (fun, args)
336
337 ppr_expr (OpApp e1 op _ e2)
338   = case unLoc op of
339       HsVar v -> pp_infixly v
340       _       -> pp_prefixly
341   where
342     pp_e1 = pprDebugParendExpr e1   -- In debug mode, add parens
343     pp_e2 = pprDebugParendExpr e2   -- to make precedence clear
344
345     pp_prefixly
346       = hang (ppr op) 2 (sep [pp_e1, pp_e2])
347
348     pp_infixly v
349       = sep [nest 2 pp_e1, pprInfix v, nest 2 pp_e2]
350
351 ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
352
353 ppr_expr (SectionL expr op)
354   = case unLoc op of
355       HsVar v -> pp_infixly v
356       _       -> pp_prefixly
357   where
358     pp_expr = pprDebugParendExpr expr
359
360     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
361                        4 (hsep [pp_expr, ptext SLIT("x_ )")])
362     pp_infixly v = (sep [pp_expr, pprInfix v])
363
364 ppr_expr (SectionR op expr)
365   = case unLoc op of
366       HsVar v -> pp_infixly v
367       _       -> pp_prefixly
368   where
369     pp_expr = pprDebugParendExpr expr
370
371     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext SLIT("x_")])
372                        4 ((<>) pp_expr rparen)
373     pp_infixly v
374       = (sep [pprInfix v, pp_expr])
375
376 --avoid using PatternSignatures for stage1 code portability
377 ppr_expr exprType@(HsLam matches)
378   = pprMatches (LambdaExpr `asTypeOf` idType exprType) matches
379  where idType :: HsExpr id -> HsMatchContext id; idType = undefined
380
381 ppr_expr exprType@(HsCase expr matches)
382   = sep [ sep [ptext SLIT("case"), nest 4 (ppr expr), ptext SLIT("of")],
383           nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches) ]
384  where idType :: HsExpr id -> HsMatchContext id; idType = undefined
385
386 ppr_expr (HsIf e1 e2 e3)
387   = sep [hsep [ptext SLIT("if"), nest 2 (ppr e1), ptext SLIT("then")],
388          nest 4 (ppr e2),
389          ptext SLIT("else"),
390          nest 4 (ppr e3)]
391
392 -- special case: let ... in let ...
393 ppr_expr (HsLet binds expr@(L _ (HsLet _ _)))
394   = sep [hang (ptext SLIT("let")) 2 (hsep [pprBinds binds, ptext SLIT("in")]),
395          ppr_lexpr expr]
396
397 ppr_expr (HsLet binds expr)
398   = sep [hang (ptext SLIT("let")) 2 (pprBinds binds),
399          hang (ptext SLIT("in"))  2 (ppr expr)]
400
401 ppr_expr (HsDo do_or_list_comp stmts body _) = pprDo do_or_list_comp stmts body
402
403 ppr_expr (ExplicitList _ exprs)
404   = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
405
406 ppr_expr (ExplicitPArr _ exprs)
407   = pa_brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
408
409 ppr_expr (ExplicitTuple exprs boxity)
410   = tupleParens boxity (sep (punctuate comma (map ppr_lexpr exprs)))
411
412 ppr_expr (RecordCon con_id _ rbinds)
413   = hang (ppr con_id) 2 (ppr rbinds)
414
415 ppr_expr (RecordUpd aexp rbinds _ _ _)
416   = hang (pprParendExpr aexp) 2 (ppr rbinds)
417
418 ppr_expr (ExprWithTySig expr sig)
419   = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
420          4 (ppr sig)
421 ppr_expr (ExprWithTySigOut expr sig)
422   = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
423          4 (ppr sig)
424
425 ppr_expr (ArithSeq _ info) = brackets (ppr info)
426 ppr_expr (PArrSeq  _ info) = pa_brackets (ppr info)
427
428 ppr_expr EWildPat       = char '_'
429 ppr_expr (ELazyPat e)   = char '~' <> pprParendExpr e
430 ppr_expr (EAsPat v e)   = ppr v <> char '@' <> pprParendExpr e
431 ppr_expr (EViewPat p e) = ppr p <+> ptext SLIT("->") <+> ppr e
432
433 ppr_expr (HsSCC lbl expr)
434   = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ftext lbl),
435           pprParendExpr expr ]
436
437 ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
438 ppr_expr (HsType id)      = ppr id
439
440 ppr_expr (HsSpliceE s)       = pprSplice s
441 ppr_expr (HsBracket b)       = pprHsBracket b
442 ppr_expr (HsBracketOut e []) = ppr e
443 ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("pending") <+> ppr ps
444 ppr_expr (HsQuasiQuoteE (HsQuasiQuote name quoter _ quote)) 
445     = char '$' <> brackets (ppr name) <>
446       ptext SLIT("[:") <> ppr quoter <> ptext SLIT("|") <>
447       ppr quote <> ptext SLIT("|]")
448
449 ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
450   = hsep [ptext SLIT("proc"), ppr pat, ptext SLIT("->"), ppr cmd]
451
452 ppr_expr (HsTick tickId vars exp)
453   = hcat [ptext SLIT("tick<"),
454           ppr tickId,
455           ptext SLIT(">("),
456           hsep (map pprHsVar vars),
457           ppr exp,
458           ptext SLIT(")")]
459 ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
460   = hcat [ptext SLIT("bintick<"),
461           ppr tickIdTrue,
462           ptext SLIT(","),
463           ppr tickIdFalse,
464           ptext SLIT(">("),
465           ppr exp,ptext SLIT(")")]
466 ppr_expr (HsTickPragma externalSrcLoc exp)
467   = hcat [ptext SLIT("tickpragma<"),
468           ppr externalSrcLoc,
469           ptext SLIT(">("),
470           ppr exp,
471           ptext SLIT(")")]
472
473 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
474   = hsep [ppr_lexpr arrow, ptext SLIT("-<"), ppr_lexpr arg]
475 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
476   = hsep [ppr_lexpr arg, ptext SLIT(">-"), ppr_lexpr arrow]
477 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
478   = hsep [ppr_lexpr arrow, ptext SLIT("-<<"), ppr_lexpr arg]
479 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
480   = hsep [ppr_lexpr arg, ptext SLIT(">>-"), ppr_lexpr arrow]
481
482 ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
483   = sep [pprCmdArg (unLoc arg1), hsep [pprInfix v, pprCmdArg (unLoc arg2)]]
484 ppr_expr (HsArrForm op _ args)
485   = hang (ptext SLIT("(|") <> ppr_lexpr op)
486          4 (sep (map (pprCmdArg.unLoc) args) <> ptext SLIT("|)"))
487
488 pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
489 pprCmdArg (HsCmdTop cmd@(L _ (HsArrForm _ Nothing [])) _ _ _)
490   = ppr_lexpr cmd
491 pprCmdArg (HsCmdTop cmd _ _ _)
492   = parens (ppr_lexpr cmd)
493
494 -- Put a var in backquotes if it's not an operator already
495 pprInfix :: Outputable name => name -> SDoc
496 pprInfix v | isOperator ppr_v = ppr_v
497            | otherwise        = char '`' <> ppr_v <> char '`'
498     where ppr_v = ppr v
499
500 -- add parallel array brackets around a document
501 --
502 pa_brackets :: SDoc -> SDoc
503 pa_brackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
504 \end{code}
505
506 HsSyn records exactly where the user put parens, with HsPar.
507 So generally speaking we print without adding any parens.
508 However, some code is internally generated, and in some places
509 parens are absolutely required; so for these places we use
510 pprParendExpr (but don't print double parens of course).
511
512 For operator applications we don't add parens, because the oprerator
513 fixities should do the job, except in debug mode (-dppr-debug) so we
514 can see the structure of the parse tree.
515
516 \begin{code}
517 pprDebugParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
518 pprDebugParendExpr expr
519   = getPprStyle (\sty ->
520     if debugStyle sty then pprParendExpr expr
521                       else pprLExpr      expr)
522
523 pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
524 pprParendExpr expr
525   = let
526         pp_as_was = pprLExpr expr
527         -- Using pprLExpr makes sure that we go 'deeper'
528         -- I think that is usually (always?) right
529     in
530     case unLoc expr of
531       HsLit _              -> pp_as_was
532       HsOverLit _          -> pp_as_was
533       HsVar _              -> pp_as_was
534       HsIPVar _            -> pp_as_was
535       ExplicitList _ _     -> pp_as_was
536       ExplicitPArr _ _     -> pp_as_was
537       ExplicitTuple _ _    -> pp_as_was
538       HsPar _              -> pp_as_was
539       HsBracket _          -> pp_as_was
540       HsBracketOut _ []    -> pp_as_was
541       HsDo sc _ _ _
542        | isListCompExpr sc -> pp_as_was
543       _                    -> parens pp_as_was
544
545 isAtomicHsExpr :: HsExpr id -> Bool -- A single token
546 isAtomicHsExpr (HsVar {})     = True
547 isAtomicHsExpr (HsLit {})     = True
548 isAtomicHsExpr (HsOverLit {}) = True
549 isAtomicHsExpr (HsIPVar {})   = True
550 isAtomicHsExpr (HsWrap _ e)   = isAtomicHsExpr e
551 isAtomicHsExpr (HsPar e)      = isAtomicHsExpr (unLoc e)
552 isAtomicHsExpr _              = False
553 \end{code}
554
555 %************************************************************************
556 %*                                                                      *
557 \subsection{Commands (in arrow abstractions)}
558 %*                                                                      *
559 %************************************************************************
560
561 We re-use HsExpr to represent these.
562
563 \begin{code}
564 type HsCmd id = HsExpr id
565
566 type LHsCmd id = LHsExpr id
567
568 data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
569 \end{code}
570
571 The legal constructors for commands are:
572
573   = HsArrApp ...                -- as above
574
575   | HsArrForm ...               -- as above
576
577   | HsApp       (HsCmd id)
578                 (HsExpr id)
579
580   | HsLam       (Match  id)     -- kappa
581
582   -- the renamer turns this one into HsArrForm
583   | OpApp       (HsExpr id)     -- left operand
584                 (HsCmd id)      -- operator
585                 Fixity          -- Renamer adds fixity; bottom until then
586                 (HsCmd id)      -- right operand
587
588   | HsPar       (HsCmd id)      -- parenthesised command
589
590   | HsCase      (HsExpr id)
591                 [Match id]      -- bodies are HsCmd's
592                 SrcLoc
593
594   | HsIf        (HsExpr id)     --  predicate
595                 (HsCmd id)      --  then part
596                 (HsCmd id)      --  else part
597                 SrcLoc
598
599   | HsLet       (HsLocalBinds id)       -- let(rec)
600                 (HsCmd  id)
601
602   | HsDo        (HsStmtContext Name)    -- The parameterisation is unimportant
603                                         -- because in this context we never use
604                                         -- the PatGuard or ParStmt variant
605                 [Stmt id]       -- HsExpr's are really HsCmd's
606                 PostTcType      -- Type of the whole expression
607                 SrcLoc
608
609 Top-level command, introducing a new arrow.
610 This may occur inside a proc (where the stack is empty) or as an
611 argument of a command-forming operator.
612
613 \begin{code}
614 type LHsCmdTop id = Located (HsCmdTop id)
615
616 data HsCmdTop id
617   = HsCmdTop (LHsCmd id)
618              [PostTcType]     -- types of inputs on the command's stack
619              PostTcType       -- return type of the command
620              (SyntaxTable id) -- after type checking:
621                               -- names used in the command's desugaring
622 \end{code}
623
624 %************************************************************************
625 %*                                                                      *
626 \subsection{Record binds}
627 %*                                                                      *
628 %************************************************************************
629
630 \begin{code}
631 type HsRecordBinds id = HsRecFields id (LHsExpr id)
632 \end{code}
633
634
635
636 %************************************************************************
637 %*                                                                      *
638 \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
639 %*                                                                      *
640 %************************************************************************
641
642 @Match@es are sets of pattern bindings and right hand sides for
643 functions, patterns or case branches. For example, if a function @g@
644 is defined as:
645 \begin{verbatim}
646 g (x,y) = y
647 g ((x:ys),y) = y+1,
648 \end{verbatim}
649 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
650
651 It is always the case that each element of an @[Match]@ list has the
652 same number of @pats@s inside it.  This corresponds to saying that
653 a function defined by pattern matching must have the same number of
654 patterns in each equation.
655
656 \begin{code}
657 data MatchGroup id
658   = MatchGroup
659         [LMatch id]     -- The alternatives
660         PostTcType      -- The type is the type of the entire group
661                         --      t1 -> ... -> tn -> tr
662                         -- where there are n patterns
663
664 type LMatch id = Located (Match id)
665
666 data Match id
667   = Match
668         [LPat id]               -- The patterns
669         (Maybe (LHsType id))    -- A type signature for the result of the match
670                                 -- Nothing after typechecking
671         (GRHSs id)
672
673 matchGroupArity :: MatchGroup id -> Arity
674 matchGroupArity (MatchGroup [] _)
675   = panic "matchGroupArity"     -- MatchGroup is never empty
676 matchGroupArity (MatchGroup (match:matches) _)
677   = ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
678     -- Assertion just checks that all the matches have the same number of pats
679     n_pats
680   where
681     n_pats = length (hsLMatchPats match)
682
683 hsLMatchPats :: LMatch id -> [LPat id]
684 hsLMatchPats (L _ (Match pats _ _)) = pats
685
686 -- GRHSs are used both for pattern bindings and for Matches
687 data GRHSs id
688   = GRHSs [LGRHS id]             -- Guarded RHSs
689           (HsLocalBinds id)      -- The where clause
690
691 type LGRHS id = Located (GRHS id)
692
693 data GRHS id = GRHS [LStmt id]   -- Guards
694                     (LHsExpr id) -- Right hand side
695 \end{code}
696
697 We know the list must have at least one @Match@ in it.
698
699 \begin{code}
700 pprMatches :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> MatchGroup idR -> SDoc
701 pprMatches ctxt (MatchGroup matches _)
702     = vcat (map (pprMatch ctxt) (map unLoc matches))
703       -- Don't print the type; it's only a place-holder before typechecking
704
705 -- Exported to HsBinds, which can't see the defn of HsMatchContext
706 pprFunBind :: (OutputableBndr idL, OutputableBndr idR) => idL -> Bool -> MatchGroup idR -> SDoc
707 pprFunBind fun inf matches = pprMatches (FunRhs fun inf) matches
708
709 -- Exported to HsBinds, which can't see the defn of HsMatchContext
710 pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
711            => LPat bndr -> GRHSs id -> SDoc
712 pprPatBind pat ty@(grhss)
713  = sep [ppr pat, nest 4 (pprGRHSs (PatBindRhs `asTypeOf` idType ty) grhss)]
714 --avoid using PatternSignatures for stage1 code portability
715  where idType :: GRHSs id -> HsMatchContext id; idType = undefined
716
717
718 pprMatch :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> Match idR -> SDoc
719 pprMatch ctxt (Match pats maybe_ty grhss)
720   = herald <+> sep [sep (map ppr other_pats),
721                     ppr_maybe_ty,
722                     nest 2 (pprGRHSs ctxt grhss)]
723   where
724     (herald, other_pats)
725         = case ctxt of
726             FunRhs fun is_infix
727                 | not is_infix -> (ppr fun, pats)
728                         -- f x y z = e
729                         -- Not pprBndr; the AbsBinds will
730                         -- have printed the signature
731
732                 | null pats3 -> (pp_infix, [])
733                         -- x &&& y = e
734
735                 | otherwise -> (parens pp_infix, pats3)
736                         -- (x &&& y) z = e
737                 where
738                   (pat1:pat2:pats3) = pats
739                   pp_infix = ppr pat1 <+> ppr fun <+> ppr pat2
740
741             LambdaExpr -> (char '\\', pats)
742             _          -> (empty,     pats)
743
744     ppr_maybe_ty = case maybe_ty of
745                         Just ty -> dcolon <+> ppr ty
746                         Nothing -> empty
747
748
749 pprGRHSs :: (OutputableBndr idL, OutputableBndr idR)
750          => HsMatchContext idL -> GRHSs idR -> SDoc
751 pprGRHSs ctxt (GRHSs grhss binds)
752   = vcat (map (pprGRHS ctxt . unLoc) grhss)
753  $$ if isEmptyLocalBinds binds then empty
754                                else text "where" $$ nest 4 (pprBinds binds)
755
756 pprGRHS :: (OutputableBndr idL, OutputableBndr idR)
757         => HsMatchContext idL -> GRHS idR -> SDoc
758
759 pprGRHS ctxt (GRHS [] expr)
760  =  pp_rhs ctxt expr
761
762 pprGRHS ctxt (GRHS guards expr)
763  = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
764
765 pp_rhs :: OutputableBndr idR => HsMatchContext idL -> LHsExpr idR -> SDoc
766 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
767 \end{code}
768
769 %************************************************************************
770 %*                                                                      *
771 \subsection{Do stmts and list comprehensions}
772 %*                                                                      *
773 %************************************************************************
774
775 \begin{code}
776 type LStmt id = Located (StmtLR id id)
777 type LStmtLR idL idR = Located (StmtLR idL idR)
778
779 type Stmt id = StmtLR id id
780
781 data GroupByClause id
782     = GroupByNothing (LHsExpr id) -- Using expression, i.e.
783                                   -- "then group using f" ==> GroupByNothing f
784     | GroupBySomething (Either (LHsExpr id) (SyntaxExpr id)) (LHsExpr id)
785       -- "then group using f by e" ==> GroupBySomething (Left f) e
786       -- "then group by e"         ==> GroupBySomething (Right _) e: in
787       --                               this case the expression is filled
788       --                               in by the renamer
789
790 -- The SyntaxExprs in here are used *only* for do-notation, which
791 -- has rebindable syntax.  Otherwise they are unused.
792 data StmtLR idL idR
793   = BindStmt (LPat idL)
794              (LHsExpr idR)
795              (SyntaxExpr idR) -- The (>>=) operator
796              (SyntaxExpr idR) -- The fail operator
797              -- The fail operator is noSyntaxExpr
798              -- if the pattern match can't fail
799
800   | ExprStmt (LHsExpr idR)
801              (SyntaxExpr idR) -- The (>>) operator
802              PostTcType       -- Element type of the RHS (used for arrows)
803
804   | LetStmt  (HsLocalBindsLR idL idR)
805
806   -- ParStmts only occur in a list comprehension
807   | ParStmt  [([LStmt idL], [idR])]
808   -- After renaming, the ids are the binders bound by the stmts and used
809   -- after them
810
811   | TransformStmt ([LStmt idL], [idR]) (LHsExpr idR) (Maybe (LHsExpr idR))
812   -- After renaming, the IDs are the binders occurring within this
813   -- transform statement that are used after it
814   -- "qs, then f by e" ==> TransformStmt (qs, binders) f (Just e)
815   -- "qs, then f"      ==> TransformStmt (qs, binders) f Nothing
816
817   | GroupStmt ([LStmt idL], [(idR, idR)]) (GroupByClause idR)
818   -- After renaming, the IDs are the binders occurring within this
819   -- transform statement that are used after it which are paired with
820   -- the names which they group over in statements
821
822   -- Recursive statement (see Note [RecStmt] below)
823   | RecStmt  [LStmtLR idL idR]
824              --- The next two fields are only valid after renaming
825              [idR] -- The ids are a subset of the variables bound by the
826                    -- stmts that are used in stmts that follow the RecStmt
827
828              [idR] -- Ditto, but these variables are the "recursive" ones,
829                    -- that are used before they are bound in the stmts of
830                    -- the RecStmt. From a type-checking point of view,
831                    -- these ones have to be monomorphic
832
833              --- These fields are only valid after typechecking
834              [PostTcExpr]       -- These expressions correspond 1-to-1 with
835                                 -- the "recursive" [id], and are the
836                                 -- expressions that should be returned by
837                                 -- the recursion.
838                                 -- They may not quite be the Ids themselves,
839                                 -- because the Id may be *polymorphic*, but
840                                 -- the returned thing has to be *monomorphic*.
841              (DictBinds idR)    -- Method bindings of Ids bound by the
842                                 -- RecStmt, and used afterwards
843 \end{code}
844
845 ExprStmts are a bit tricky, because what they mean
846 depends on the context.  Consider the following contexts:
847
848         A do expression of type (m res_ty)
849         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
850         * ExprStmt E any_ty:   do { ....; E; ... }
851                 E :: m any_ty
852           Translation: E >> ...
853
854         A list comprehensions of type [elt_ty]
855         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
856         * ExprStmt E Bool:   [ .. | .... E ]
857                         [ .. | ..., E, ... ]
858                         [ .. | .... | ..., E | ... ]
859                 E :: Bool
860           Translation: if E then fail else ...
861
862         A guard list, guarding a RHS of type rhs_ty
863         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
864         * ExprStmt E Bool:   f x | ..., E, ... = ...rhs...
865                 E :: Bool
866           Translation: if E then fail else ...
867
868 Array comprehensions are handled like list comprehensions -=chak
869
870 Note [RecStmt]
871 ~~~~~~~~~~~~~~
872 Example:
873         HsDo [ BindStmt x ex
874
875              , RecStmt [a::forall a. a -> a, b]
876                        [a::Int -> Int,       c]
877                        [ BindStmt b (return x)
878                        , LetStmt a = ea
879                        , BindStmt c ec ]
880
881              , return (a b) ]
882
883 Here, the RecStmt binds a,b,c; but
884   - Only a,b are used in the stmts *following* the RecStmt,
885         This 'a' is *polymorphic'
886   - Only a,c are used in the stmts *inside* the RecStmt
887         *before* their bindings
888         This 'a' is monomorphic
889
890 Nota Bene: the two a's have different types, even though they
891 have the same Name.
892
893
894 \begin{code}
895 instance (OutputableBndr idL, OutputableBndr idR) => Outputable (StmtLR idL idR) where
896     ppr stmt = pprStmt stmt
897
898 pprStmt :: (OutputableBndr idL, OutputableBndr idR) => (StmtLR idL idR) -> SDoc
899 pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
900 pprStmt (LetStmt binds)           = hsep [ptext SLIT("let"), pprBinds binds]
901 pprStmt (ExprStmt expr _ _)       = ppr expr
902 pprStmt (ParStmt stmtss)          = hsep (map doStmts stmtss)
903   where doStmts stmts = ptext SLIT("| ") <> ppr stmts
904 pprStmt (TransformStmt (stmts, _) usingExpr maybeByExpr)
905     = (hsep [stmtsDoc, ptext SLIT("then"), ppr usingExpr, byExprDoc])
906   where stmtsDoc = interpp'SP stmts
907         byExprDoc = maybe empty (\byExpr -> hsep [ptext SLIT("by"), ppr byExpr]) maybeByExpr
908 pprStmt (GroupStmt (stmts, _) groupByClause) = (hsep [stmtsDoc, ptext SLIT("then group"), pprGroupByClause groupByClause])
909   where stmtsDoc = interpp'SP stmts
910 pprStmt (RecStmt segment _ _ _ _) = ptext SLIT("rec") <+> braces (vcat (map ppr segment))
911
912 pprGroupByClause :: (OutputableBndr id) => GroupByClause id -> SDoc
913 pprGroupByClause (GroupByNothing usingExpr) = hsep [ptext SLIT("using"), ppr usingExpr]
914 pprGroupByClause (GroupBySomething eitherUsingExpr byExpr) = hsep [ptext SLIT("by"), ppr byExpr, usingExprDoc]
915   where usingExprDoc = either (\usingExpr -> hsep [ptext SLIT("using"), ppr usingExpr]) (const empty) eitherUsingExpr
916
917 pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> LHsExpr id -> SDoc
918 pprDo DoExpr      stmts body = ptext SLIT("do")  <+> pprDeeperList vcat (map ppr stmts ++ [ppr body])
919 pprDo (MDoExpr _) stmts body = ptext SLIT("mdo") <+> pprDeeperList vcat (map ppr stmts ++ [ppr body])
920 pprDo ListComp    stmts body = pprComp brackets    stmts body
921 pprDo PArrComp    stmts body = pprComp pa_brackets stmts body
922 pprDo _           _     _    = panic "pprDo" -- PatGuard, ParStmtCxt
923
924 pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [LStmt id] -> LHsExpr id -> SDoc
925 pprComp brack quals body
926   = brack $
927         hang (ppr body <+> char '|')
928              4 (interpp'SP quals)
929 \end{code}
930
931 %************************************************************************
932 %*                                                                      *
933                 Template Haskell quotation brackets
934 %*                                                                      *
935 %************************************************************************
936
937 \begin{code}
938 data HsSplice id  = HsSplice            --  $z  or $(f 4)
939                         id              -- The id is just a unique name to
940                         (LHsExpr id)    -- identify this splice point
941
942 instance OutputableBndr id => Outputable (HsSplice id) where
943   ppr = pprSplice
944
945 pprSplice :: OutputableBndr id => HsSplice id -> SDoc
946 pprSplice (HsSplice n e)
947     = char '$' <> ifPprDebug (brackets (ppr n)) <> pprParendExpr e
948
949
950 data HsBracket id = ExpBr (LHsExpr id)          -- [|  expr  |]
951                   | PatBr (LPat id)             -- [p| pat   |]
952                   | DecBr (HsGroup id)          -- [d| decls |]
953                   | TypBr (LHsType id)          -- [t| type  |]
954                   | VarBr id                    -- 'x, ''T
955
956 instance OutputableBndr id => Outputable (HsBracket id) where
957   ppr = pprHsBracket
958
959
960 pprHsBracket :: OutputableBndr id => HsBracket id -> SDoc
961 pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
962 pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
963 pprHsBracket (DecBr d) = thBrackets (char 'd') (ppr d)
964 pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
965 pprHsBracket (VarBr n) = char '\'' <> ppr n
966 -- Infelicity: can't show ' vs '', because
967 -- we can't ask n what its OccName is, because the
968 -- pretty-printer for HsExpr doesn't ask for NamedThings
969 -- But the pretty-printer for names will show the OccName class
970
971 thBrackets :: SDoc -> SDoc -> SDoc
972 thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
973                              pp_body <+> ptext SLIT("|]")
974 \end{code}
975
976 %************************************************************************
977 %*                                                                      *
978 \subsection{Enumerations and list comprehensions}
979 %*                                                                      *
980 %************************************************************************
981
982 \begin{code}
983 data ArithSeqInfo id
984   = From            (LHsExpr id)
985   | FromThen        (LHsExpr id)
986                     (LHsExpr id)
987   | FromTo          (LHsExpr id)
988                     (LHsExpr id)
989   | FromThenTo      (LHsExpr id)
990                     (LHsExpr id)
991                     (LHsExpr id)
992 \end{code}
993
994 \begin{code}
995 instance OutputableBndr id => Outputable (ArithSeqInfo id) where
996     ppr (From e1)             = hcat [ppr e1, pp_dotdot]
997     ppr (FromThen e1 e2)      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
998     ppr (FromTo e1 e3)        = hcat [ppr e1, pp_dotdot, ppr e3]
999     ppr (FromThenTo e1 e2 e3)
1000       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
1001
1002 pp_dotdot :: SDoc
1003 pp_dotdot = ptext SLIT(" .. ")
1004 \end{code}
1005
1006
1007 %************************************************************************
1008 %*                                                                      *
1009 \subsection{HsMatchCtxt}
1010 %*                                                                      *
1011 %************************************************************************
1012
1013 \begin{code}
1014 data HsMatchContext id  -- Context of a Match
1015   = FunRhs id Bool              -- Function binding for f; True <=> written infix
1016   | CaseAlt                     -- Guard on a case alternative
1017   | LambdaExpr                  -- Pattern of a lambda
1018   | ProcExpr                    -- Pattern of a proc
1019   | PatBindRhs                  -- Pattern binding
1020   | RecUpd                      -- Record update [used only in DsExpr to
1021                                 --    tell matchWrapper what sort of
1022                                 --    runtime error message to generate]
1023   | StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
1024   deriving ()
1025
1026 data HsStmtContext id
1027   = ListComp
1028   | DoExpr
1029   | MDoExpr PostTcTable                  -- Recursive do-expression
1030                                          -- (tiresomely, it needs table
1031                                          --  of its return/bind ops)
1032   | PArrComp                             -- Parallel array comprehension
1033   | PatGuard (HsMatchContext id)         -- Pattern guard for specified thing
1034   | ParStmtCtxt (HsStmtContext id)       -- A branch of a parallel stmt
1035   | TransformStmtCtxt (HsStmtContext id) -- A branch of a transform stmt
1036 \end{code}
1037
1038 \begin{code}
1039 isDoExpr :: HsStmtContext id -> Bool
1040 isDoExpr DoExpr      = True
1041 isDoExpr (MDoExpr _) = True
1042 isDoExpr _           = False
1043
1044 isListCompExpr :: HsStmtContext id -> Bool
1045 isListCompExpr ListComp = True
1046 isListCompExpr PArrComp = True
1047 isListCompExpr _        = False
1048 \end{code}
1049
1050 \begin{code}
1051 matchSeparator :: HsMatchContext id -> SDoc
1052 matchSeparator (FunRhs {})  = ptext SLIT("=")
1053 matchSeparator CaseAlt      = ptext SLIT("->")
1054 matchSeparator LambdaExpr   = ptext SLIT("->")
1055 matchSeparator ProcExpr     = ptext SLIT("->")
1056 matchSeparator PatBindRhs   = ptext SLIT("=")
1057 matchSeparator (StmtCtxt _) = ptext SLIT("<-")
1058 matchSeparator RecUpd       = panic "unused"
1059 \end{code}
1060
1061 \begin{code}
1062 pprMatchContext :: Outputable id => HsMatchContext id -> SDoc
1063 pprMatchContext (FunRhs fun _)    = ptext SLIT("the definition of")
1064                                     <+> quotes (ppr fun)
1065 pprMatchContext CaseAlt           = ptext SLIT("a case alternative")
1066 pprMatchContext RecUpd            = ptext SLIT("a record-update construct")
1067 pprMatchContext PatBindRhs        = ptext SLIT("a pattern binding")
1068 pprMatchContext LambdaExpr        = ptext SLIT("a lambda abstraction")
1069 pprMatchContext ProcExpr          = ptext SLIT("an arrow abstraction")
1070 pprMatchContext (StmtCtxt ctxt)   = ptext SLIT("a pattern binding in")
1071                                     $$ pprStmtContext ctxt
1072
1073 pprStmtContext :: Outputable id => HsStmtContext id -> SDoc
1074 pprStmtContext (ParStmtCtxt c)
1075  = sep [ptext SLIT("a parallel branch of"), pprStmtContext c]
1076 pprStmtContext (TransformStmtCtxt c)
1077  = sep [ptext SLIT("a transformed branch of"), pprStmtContext c]
1078 pprStmtContext (PatGuard ctxt)
1079  = ptext SLIT("a pattern guard for") $$ pprMatchContext ctxt
1080 pprStmtContext DoExpr          = ptext SLIT("a 'do' expression")
1081 pprStmtContext (MDoExpr _)     = ptext SLIT("an 'mdo' expression")
1082 pprStmtContext ListComp        = ptext SLIT("a list comprehension")
1083 pprStmtContext PArrComp        = ptext SLIT("an array comprehension")
1084
1085 {-
1086 pprMatchRhsContext (FunRhs fun) = ptext SLIT("a right-hand side of function") <+> quotes (ppr fun)
1087 pprMatchRhsContext CaseAlt      = ptext SLIT("the body of a case alternative")
1088 pprMatchRhsContext PatBindRhs   = ptext SLIT("the right-hand side of a pattern binding")
1089 pprMatchRhsContext LambdaExpr   = ptext SLIT("the body of a lambda")
1090 pprMatchRhsContext ProcExpr     = ptext SLIT("the body of a proc")
1091 pprMatchRhsContext other        = panic "pprMatchRhsContext"    -- RecUpd, StmtCtxt
1092
1093 -- Used for the result statement of comprehension
1094 -- e.g. the 'e' in      [ e | ... ]
1095 --      or the 'r' in   f x = r
1096 pprStmtResultContext (PatGuard ctxt) = pprMatchRhsContext ctxt
1097 pprStmtResultContext other           = ptext SLIT("the result of") <+> pprStmtContext other
1098 -}
1099
1100 -- Used to generate the string for a *runtime* error message
1101 matchContextErrString :: Outputable id => HsMatchContext id -> String
1102 matchContextErrString (FunRhs fun _)             = "function " ++ showSDoc (ppr fun)
1103 matchContextErrString CaseAlt                    = "case"
1104 matchContextErrString PatBindRhs                 = "pattern binding"
1105 matchContextErrString RecUpd                     = "record update"
1106 matchContextErrString LambdaExpr                 = "lambda"
1107 matchContextErrString ProcExpr                   = "proc"
1108 matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
1109 matchContextErrString (StmtCtxt (TransformStmtCtxt c)) = matchContextErrString (StmtCtxt c)
1110 matchContextErrString (StmtCtxt (PatGuard _))    = "pattern guard"
1111 matchContextErrString (StmtCtxt DoExpr)          = "'do' expression"
1112 matchContextErrString (StmtCtxt (MDoExpr _))     = "'mdo' expression"
1113 matchContextErrString (StmtCtxt ListComp)        = "list comprehension"
1114 matchContextErrString (StmtCtxt PArrComp)        = "array comprehension"
1115 \end{code}