HsExpr.lhs 46.5 KB
Newer Older
1
%
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 5
%
\begin{code}
6 7

-- | Abstract Haskell syntax for expressions.
8 9
module HsExpr where

10
#include "HsVersions.h"
11 12

-- friends:
13 14 15 16 17
import HsDecls
import HsPat
import HsLit
import HsTypes
import HsBinds
18 19

-- others:
20 21 22
import Var
import Name
import BasicTypes
23
import DataCon
24
import SrcLoc
Ian Lynagh's avatar
Ian Lynagh committed
25
import Outputable
26
import FastString
27 28
\end{code}

29

30
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
31
%*                                                                      *
32
\subsection{Expressions proper}
Ian Lynagh's avatar
Ian Lynagh committed
33
%*                                                                      *
34 35 36
%************************************************************************

\begin{code}
37 38
-- * Expressions proper

39 40
type LHsExpr id = Located (HsExpr id)

41
-------------------------
42 43
-- | PostTcExpr is an evidence expression attached to the syntax tree by the
-- type checker (c.f. postTcType).
44
type PostTcExpr  = HsExpr Id
45 46
-- | We use a PostTcTable where there are a bunch of pieces of evidence, more
-- than is convenient to keep individually.
47 48 49
type PostTcTable = [(Name, Id)]

noPostTcExpr :: PostTcExpr
Ian Lynagh's avatar
Ian Lynagh committed
50
noPostTcExpr = HsLit (HsString (fsLit "noPostTcExpr"))
51 52 53 54 55

noPostTcTable :: PostTcTable
noPostTcTable = []

-------------------------
56
-- | SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,
Ian Lynagh's avatar
Ian Lynagh committed
57
-- by the renamer.  It's used for rebindable syntax.
58 59 60 61
--
-- 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
62 63 64

type SyntaxExpr id = HsExpr id

Ian Lynagh's avatar
Ian Lynagh committed
65 66
noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
                              -- (if the syntax slot makes no sense)
Ian Lynagh's avatar
Ian Lynagh committed
67
noSyntaxExpr = HsLit (HsString (fsLit "noSyntaxExpr"))
68 69 70


type SyntaxTable id = [(Name, SyntaxExpr id)]
71 72 73
-- ^ Currently used only for 'CmdTop' (sigh)
--
-- * Before the renamer, this list is 'noSyntaxTable'
74
--
75
-- * After the renamer, it takes the form @[(std_name, HsVar actual_name)]@
76 77
--   For example, for the 'return' op of a monad
--
78 79 80 81 82 83 84
--    * 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
85 86 87 88 89 90

noSyntaxTable :: SyntaxTable id
noSyntaxTable = []


-------------------------
91
-- | A Haskell expression.
92
data HsExpr id
93 94 95
  = HsVar     id                        -- ^ variable
  | HsIPVar   (IPName id)               -- ^ implicit parameter
  | HsOverLit (HsOverLit id)            -- ^ Overloaded literals
96

97
  | HsLit     HsLit                     -- ^ Simple (non-overloaded) literals
98

Ian Lynagh's avatar
Ian Lynagh committed
99
  | HsLam     (MatchGroup id)           -- Currently always a single match
100

Ian Lynagh's avatar
Ian Lynagh committed
101
  | HsApp     (LHsExpr id) (LHsExpr id) -- Application
102

103
  -- Operator applications:
104 105
  -- NB Bracketed ops such as (+) come out as Vars.

106 107 108
  -- 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.

Ian Lynagh's avatar
Ian Lynagh committed
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
  | OpApp       (LHsExpr id)    -- left operand
                (LHsExpr id)    -- operator
                Fixity          -- Renamer adds fixity; bottom until then
                (LHsExpr id)    -- right operand

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

  | HsPar       (LHsExpr id)    -- parenthesised expr

  | SectionL    (LHsExpr id)    -- operand
                (LHsExpr id)    -- operator
  | SectionR    (LHsExpr id)    -- operator
                (LHsExpr id)    -- operand

124 125 126 127
  | ExplicitTuple		-- Used for explicit tuples and sections thereof
        [HsTupArg id] 
        Boxity

Ian Lynagh's avatar
Ian Lynagh committed
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
  | HsCase      (LHsExpr id)
                (MatchGroup id)

  | HsIf        (LHsExpr id)    --  predicate
                (LHsExpr id)    --  then part
                (LHsExpr id)    --  else part

  | HsLet       (HsLocalBinds id) -- let(rec)
                (LHsExpr  id)

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

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

  | ExplicitPArr                -- syntactic parallel array: [:e1, ..., en:]
                PostTcType      -- type of elements of the parallel array
                [LHsExpr id]

  -- Record construction
  | RecordCon   (Located id)       -- The constructor.  After type checking
                                   -- it's the dataConWrapId of the constructor
                PostTcExpr         -- Data con Id applied to type args
                (HsRecordBinds id)

  -- Record update
  | RecordUpd   (LHsExpr id)
                (HsRecordBinds id)
163 164
--		(HsMatchGroup Id)  -- Filled in by the type checker to be 
--				   -- a match that does the job
Ian Lynagh's avatar
Ian Lynagh committed
165
                [DataCon]          -- Filled in by the type checker to the
Thomas Schilling's avatar
Thomas Schilling committed
166
                                   -- _non-empty_ list of DataCons that have
Ian Lynagh's avatar
Ian Lynagh committed
167 168 169 170 171 172 173
                                   -- 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

  | ExprWithTySig                       -- e :: type
174
                (LHsExpr id)
Ian Lynagh's avatar
Ian Lynagh committed
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195
                (LHsType id)

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

  | ArithSeq                            -- arithmetic sequence
                PostTcExpr
                (ArithSeqInfo id)

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

  | HsSCC       FastString              -- "set cost centre" SCC pragma
                (LHsExpr id)            -- expr whose cost is to be measured

  | HsCoreAnn   FastString              -- hdaume: core annotation
                (LHsExpr id)

196
  -----------------------------------------------------------
197
  -- MetaHaskell Extensions
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
198

199
  | HsBracket    (HsBracket id)
200

Ian Lynagh's avatar
Ian Lynagh committed
201 202 203
  | HsBracketOut (HsBracket Name)       -- Output of the type checker is
                                        -- the *original*
                 [PendingSplice]        -- renamed expression, plus
Thomas Schilling's avatar
Thomas Schilling committed
204
                                        -- _typechecked_ splices to be
Ian Lynagh's avatar
Ian Lynagh committed
205
                                        -- pasted back in by the desugarer
206

Ian Lynagh's avatar
Ian Lynagh committed
207
  | HsSpliceE (HsSplice id)
208

209 210 211
  | HsQuasiQuoteE (HsQuasiQuote id)
	-- See Note [Quasi-quote overview] in TcSplice

212 213 214
  -----------------------------------------------------------
  -- Arrow notation extension

Ian Lynagh's avatar
Ian Lynagh committed
215 216 217
  | HsProc      (LPat id)               -- arrow abstraction, proc
                (LHsCmdTop id)          -- body of the abstraction
                                        -- always has an empty stack
218 219 220 221

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

Ian Lynagh's avatar
Ian Lynagh committed
222 223 224 225 226 227 228 229
  | HsArrApp            -- Arrow tail, or arrow application (f -< arg)
        (LHsExpr id)    -- arrow expression, f
        (LHsExpr id)    -- input expression, arg
        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)
230

Ian Lynagh's avatar
Ian Lynagh committed
231 232 233 234 235 236 237
  | HsArrForm           -- Command formation,  (| e cmd1 .. cmdn |)
        (LHsExpr id)    -- the operator
                        -- 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
        [LHsCmdTop id]  -- argument commands
238

239

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

Ian Lynagh's avatar
Ian Lynagh committed
243 244
  | HsTick
     Int                                -- module-local tick number
245
     [id]                               -- variables in scope
Ian Lynagh's avatar
Ian Lynagh committed
246
     (LHsExpr id)                       -- sub-expression
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
247 248

  | HsBinTick
Ian Lynagh's avatar
Ian Lynagh committed
249 250 251
     Int                                -- module-local tick number for True
     Int                                -- module-local tick number for False
     (LHsExpr id)                       -- sub-expression
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
252

Ian Lynagh's avatar
Ian Lynagh committed
253 254 255
  | HsTickPragma                        -- A pragma introduced tick
     (FastString,(Int,Int),(Int,Int))   -- external span for this tick
     (LHsExpr id)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
256 257 258 259

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

Ian Lynagh's avatar
Ian Lynagh committed
261
  | EWildPat                 -- wildcard
262

Ian Lynagh's avatar
Ian Lynagh committed
263 264
  | EAsPat      (Located id) -- as pattern
                (LHsExpr id)
265

Ian Lynagh's avatar
Ian Lynagh committed
266 267
  | EViewPat    (LHsExpr id) -- view pattern
                (LHsExpr id)
268

Ian Lynagh's avatar
Ian Lynagh committed
269
  | ELazyPat    (LHsExpr id) -- ~ pattern
270

Ian Lynagh's avatar
Ian Lynagh committed
271
  | HsType      (LHsType id) -- Explicit type argument; e.g  f {| Int |} x y
272

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
273 274
  ---------------------------------------
  -- Finally, HsWrap appears only in typechecker output
275

Ian Lynagh's avatar
Ian Lynagh committed
276 277
  |  HsWrap     HsWrapper    -- TRANSLATION
                (HsExpr id)
278

279 280 281 282 283 284 285 286 287 288 289
-- HsTupArg is used for tuple sections
--  (,a,) is represented by  ExplicitTuple [Mising ty1, Present a, Missing ty3]
--  Which in turn stands for (\x:ty1 \y:ty2. (x,a,y))
data HsTupArg id
  = Present (LHsExpr id)	-- The argument
  | Missing PostTcType		-- The argument is missing, but this is its type

tupArgPresent :: HsTupArg id -> Bool
tupArgPresent (Present {}) = True
tupArgPresent (Missing {}) = False

Ian Lynagh's avatar
Ian Lynagh committed
290 291
type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be
                                        -- pasted back in by the desugarer
292 293 294 295 296 297 298 299 300
\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}
301
instance OutputableBndr id => Outputable (HsExpr id) where
302
    ppr expr = pprExpr expr
303 304 305
\end{code}

\begin{code}
306
-----------------------
Ian Lynagh's avatar
Ian Lynagh committed
307
-- pprExpr, pprLExpr, pprBinds call pprDeeper;
308 309
-- the underscore versions do not
pprLExpr :: OutputableBndr id => LHsExpr id -> SDoc
310 311 312
pprLExpr (L _ e) = pprExpr e

pprExpr :: OutputableBndr id => HsExpr id -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
313 314 315 316 317 318 319 320 321 322 323 324
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
325

Ian Lynagh's avatar
Ian Lynagh committed
326 327
pprBinds :: (OutputableBndr idL, OutputableBndr idR)
         => HsLocalBindsLR idL idR -> SDoc
328
pprBinds b = pprDeeper (ppr b)
329

330
-----------------------
331 332
ppr_lexpr :: OutputableBndr id => LHsExpr id -> SDoc
ppr_lexpr e = ppr_expr (unLoc e)
333

334
ppr_expr :: OutputableBndr id => HsExpr id -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
335
ppr_expr (HsVar v)       = pprHsVar v
336
ppr_expr (HsIPVar v)     = ppr v
337 338
ppr_expr (HsLit lit)     = ppr lit
ppr_expr (HsOverLit lit) = ppr lit
Ian Lynagh's avatar
Ian Lynagh committed
339
ppr_expr (HsPar e)       = parens (ppr_lexpr e)
340 341

ppr_expr (HsCoreAnn s e)
Ian Lynagh's avatar
Ian Lynagh committed
342
  = vcat [ptext (sLit "HsCoreAnn") <+> ftext s, ppr_lexpr e]
343

344 345
ppr_expr (HsApp e1 e2)
  = let (fun, args) = collect_args e1 [e2] in
346
    hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))
347
  where
348 349
    collect_args (L _ (HsApp fun arg)) args = collect_args fun (arg:args)
    collect_args fun args = (fun, args)
350

Ian Lynagh's avatar
Ian Lynagh committed
351
ppr_expr (OpApp e1 op _ e2)
352
  = case unLoc op of
353
      HsVar v -> pp_infixly v
Ian Lynagh's avatar
Ian Lynagh committed
354
      _       -> pp_prefixly
355
  where
Ian Lynagh's avatar
Ian Lynagh committed
356
    pp_e1 = pprDebugParendExpr e1   -- In debug mode, add parens
357
    pp_e2 = pprDebugParendExpr e2   -- to make precedence clear
358 359

    pp_prefixly
360
      = hang (ppr op) 2 (sep [pp_e1, pp_e2])
361 362

    pp_infixly v
363
      = sep [nest 2 pp_e1, pprHsInfix v, nest 2 pp_e2]
364

365
ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
366

367
ppr_expr (SectionL expr op)
368
  = case unLoc op of
369
      HsVar v -> pp_infixly v
Ian Lynagh's avatar
Ian Lynagh committed
370
      _       -> pp_prefixly
371
  where
372
    pp_expr = pprDebugParendExpr expr
373

374
    pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
Ian Lynagh's avatar
Ian Lynagh committed
375
                       4 (hsep [pp_expr, ptext (sLit "x_ )")])
376
    pp_infixly v = (sep [pp_expr, pprHsInfix v])
377

378
ppr_expr (SectionR op expr)
379
  = case unLoc op of
380
      HsVar v -> pp_infixly v
Ian Lynagh's avatar
Ian Lynagh committed
381
      _       -> pp_prefixly
382
  where
383
    pp_expr = pprDebugParendExpr expr
384

Ian Lynagh's avatar
Ian Lynagh committed
385
    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
Ian Lynagh's avatar
Ian Lynagh committed
386
                       4 ((<>) pp_expr rparen)
387
    pp_infixly v
388
      = (sep [pprHsInfix v, pp_expr])
389

390 391 392 393 394
ppr_expr (ExplicitTuple exprs boxity)
  = tupleParens boxity (fcat (ppr_tup_args exprs))
  where
    ppr_tup_args []               = []
    ppr_tup_args (Present e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
395
    ppr_tup_args (Missing _ : es) = punc es : ppr_tup_args es
396 397 398 399 400

    punc (Present {} : _) = comma <> space
    punc (Missing {} : _) = comma
    punc []               = empty

401 402 403 404
--avoid using PatternSignatures for stage1 code portability
ppr_expr exprType@(HsLam matches)
  = pprMatches (LambdaExpr `asTypeOf` idType exprType) matches
 where idType :: HsExpr id -> HsMatchContext id; idType = undefined
405

406
ppr_expr exprType@(HsCase expr matches)
407 408
  = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
          nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches <+> char '}') ]
409
 where idType :: HsExpr id -> HsMatchContext id; idType = undefined
410

411
ppr_expr (HsIf e1 e2 e3)
Ian Lynagh's avatar
Ian Lynagh committed
412
  = sep [hsep [ptext (sLit "if"), nest 2 (ppr e1), ptext (sLit "then")],
Ian Lynagh's avatar
Ian Lynagh committed
413
         nest 4 (ppr e2),
Ian Lynagh's avatar
Ian Lynagh committed
414
         ptext (sLit "else"),
Ian Lynagh's avatar
Ian Lynagh committed
415
         nest 4 (ppr e3)]
416 417

-- special case: let ... in let ...
418
ppr_expr (HsLet binds expr@(L _ (HsLet _ _)))
Ian Lynagh's avatar
Ian Lynagh committed
419
  = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
Ian Lynagh's avatar
Ian Lynagh committed
420
         ppr_lexpr expr]
421

422
ppr_expr (HsLet binds expr)
Ian Lynagh's avatar
Ian Lynagh committed
423 424
  = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
         hang (ptext (sLit "in"))  2 (ppr expr)]
425

426
ppr_expr (HsDo do_or_list_comp stmts body _) = pprDo do_or_list_comp stmts body
427

428
ppr_expr (ExplicitList _ exprs)
429
  = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
430

chak's avatar
chak committed
431
ppr_expr (ExplicitPArr _ exprs)
432
  = pa_brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
chak's avatar
chak committed
433

Ian Lynagh's avatar
Ian Lynagh committed
434
ppr_expr (RecordCon con_id _ rbinds)
435
  = hang (ppr con_id) 2 (ppr rbinds)
436

437
ppr_expr (RecordUpd aexp rbinds _ _ _)
438
  = hang (pprParendExpr aexp) 2 (ppr rbinds)
439 440

ppr_expr (ExprWithTySig expr sig)
441
  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
Ian Lynagh's avatar
Ian Lynagh committed
442
         4 (ppr sig)
443 444
ppr_expr (ExprWithTySigOut expr sig)
  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
Ian Lynagh's avatar
Ian Lynagh committed
445
         4 (ppr sig)
446

Ian Lynagh's avatar
Ian Lynagh committed
447 448
ppr_expr (ArithSeq _ info) = brackets (ppr info)
ppr_expr (PArrSeq  _ info) = pa_brackets (ppr info)
chak's avatar
chak committed
449

Ian Lynagh's avatar
Ian Lynagh committed
450 451 452
ppr_expr EWildPat       = char '_'
ppr_expr (ELazyPat e)   = char '~' <> pprParendExpr e
ppr_expr (EAsPat v e)   = ppr v <> char '@' <> pprParendExpr e
Ian Lynagh's avatar
Ian Lynagh committed
453
ppr_expr (EViewPat p e) = ppr p <+> ptext (sLit "->") <+> ppr e
454 455

ppr_expr (HsSCC lbl expr)
Ian Lynagh's avatar
Ian Lynagh committed
456
  = sep [ ptext (sLit "_scc_") <+> doubleQuotes (ftext lbl),
Ian Lynagh's avatar
Ian Lynagh committed
457
          pprParendExpr expr ]
458

459
ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
Ian Lynagh's avatar
Ian Lynagh committed
460
ppr_expr (HsType id)      = ppr id
chak's avatar
chak committed
461

462 463
ppr_expr (HsSpliceE s)       = pprSplice s
ppr_expr (HsBracket b)       = pprHsBracket b
Ian Lynagh's avatar
Ian Lynagh committed
464
ppr_expr (HsBracketOut e []) = ppr e
Ian Lynagh's avatar
Ian Lynagh committed
465
ppr_expr (HsBracketOut e ps) = ppr e $$ ptext (sLit "pending") <+> ppr ps
466
ppr_expr (HsQuasiQuoteE qq)  = ppr qq
467

468
ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
Ian Lynagh's avatar
Ian Lynagh committed
469
  = hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
470

471
ppr_expr (HsTick tickId vars exp)
472 473 474 475 476 477 478
  = pprTicks (ppr 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
479
ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
480 481
  = pprTicks (ppr exp) $
    hcat [ptext (sLit "bintick<"),
Ian Lynagh's avatar
Ian Lynagh committed
482
          ppr tickIdTrue,
Ian Lynagh's avatar
Ian Lynagh committed
483
          ptext (sLit ","),
Ian Lynagh's avatar
Ian Lynagh committed
484
          ppr tickIdFalse,
Ian Lynagh's avatar
Ian Lynagh committed
485 486
          ptext (sLit ">("),
          ppr exp,ptext (sLit ")")]
andy@galois.com's avatar
andy@galois.com committed
487
ppr_expr (HsTickPragma externalSrcLoc exp)
488 489
  = pprTicks (ppr exp) $
    hcat [ptext (sLit "tickpragma<"),
Ian Lynagh's avatar
Ian Lynagh committed
490
          ppr externalSrcLoc,
Ian Lynagh's avatar
Ian Lynagh committed
491
          ptext (sLit ">("),
Ian Lynagh's avatar
Ian Lynagh committed
492
          ppr exp,
Ian Lynagh's avatar
Ian Lynagh committed
493
          ptext (sLit ")")]
andy@galois.com's avatar
andy@galois.com committed
494

495
ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
Ian Lynagh's avatar
Ian Lynagh committed
496
  = hsep [ppr_lexpr arrow, ptext (sLit "-<"), ppr_lexpr arg]
497
ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
Ian Lynagh's avatar
Ian Lynagh committed
498
  = hsep [ppr_lexpr arg, ptext (sLit ">-"), ppr_lexpr arrow]
499
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
Ian Lynagh's avatar
Ian Lynagh committed
500
  = hsep [ppr_lexpr arrow, ptext (sLit "-<<"), ppr_lexpr arg]
501
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
Ian Lynagh's avatar
Ian Lynagh committed
502
  = hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]
503

504
ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
505
  = sep [pprCmdArg (unLoc arg1), hsep [pprHsInfix v, pprCmdArg (unLoc arg2)]]
506
ppr_expr (HsArrForm op _ args)
Ian Lynagh's avatar
Ian Lynagh committed
507 508
  = hang (ptext (sLit "(|") <> ppr_lexpr op)
         4 (sep (map (pprCmdArg.unLoc) args) <> ptext (sLit "|)"))
509 510

pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
511 512 513 514
pprCmdArg (HsCmdTop cmd@(L _ (HsArrForm _ Nothing [])) _ _ _)
  = ppr_lexpr cmd
pprCmdArg (HsCmdTop cmd _ _ _)
  = parens (ppr_lexpr cmd)
515

Ian Lynagh's avatar
Ian Lynagh committed
516 517 518
instance OutputableBndr id => Outputable (HsCmdTop id) where
    ppr = pprCmdArg

chak's avatar
chak committed
519 520
-- add parallel array brackets around a document
--
521
pa_brackets :: SDoc -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
522
pa_brackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
523 524
\end{code}

525 526 527 528 529 530 531 532 533 534
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.

535
\begin{code}
536 537 538 539
pprDebugParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
pprDebugParendExpr expr
  = getPprStyle (\sty ->
    if debugStyle sty then pprParendExpr expr
Ian Lynagh's avatar
Ian Lynagh committed
540 541
                      else pprLExpr      expr)

542
pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
543
pprParendExpr expr
544
  = let
Ian Lynagh's avatar
Ian Lynagh committed
545 546 547
        pp_as_was = pprLExpr expr
        -- Using pprLExpr makes sure that we go 'deeper'
        -- I think that is usually (always?) right
548
    in
549
    case unLoc expr of
550 551 552 553 554 555 556 557 558 559 560 561
      ArithSeq {}       -> pp_as_was
      PArrSeq {}        -> pp_as_was
      HsLit {}          -> pp_as_was
      HsOverLit {}      -> pp_as_was
      HsVar {}          -> pp_as_was
      HsIPVar {}        -> pp_as_was
      ExplicitTuple {}  -> pp_as_was
      ExplicitList {}   -> pp_as_was
      ExplicitPArr {}   -> pp_as_was
      HsPar {}          -> pp_as_was
      HsBracket {}      -> pp_as_was
      HsBracketOut _ [] -> pp_as_was
562 563
      HsDo sc _ _ _
       | isListCompExpr sc -> pp_as_was
Ian Lynagh's avatar
Ian Lynagh committed
564
      _                    -> parens pp_as_was
565

Ian Lynagh's avatar
Ian Lynagh committed
566
isAtomicHsExpr :: HsExpr id -> Bool -- A single token
567 568 569 570 571 572
isAtomicHsExpr (HsVar {})     = True
isAtomicHsExpr (HsLit {})     = True
isAtomicHsExpr (HsOverLit {}) = True
isAtomicHsExpr (HsIPVar {})   = True
isAtomicHsExpr (HsWrap _ e)   = isAtomicHsExpr e
isAtomicHsExpr (HsPar e)      = isAtomicHsExpr (unLoc e)
Ian Lynagh's avatar
Ian Lynagh committed
573
isAtomicHsExpr _              = False
574 575
\end{code}

576
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
577
%*                                                                      *
578
\subsection{Commands (in arrow abstractions)}
Ian Lynagh's avatar
Ian Lynagh committed
579
%*                                                                      *
580 581 582 583 584 585 586
%************************************************************************

We re-use HsExpr to represent these.

\begin{code}
type HsCmd id = HsExpr id

587 588
type LHsCmd id = LHsExpr id

589 590 591 592 593
data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
\end{code}

The legal constructors for commands are:

Ian Lynagh's avatar
Ian Lynagh committed
594
  = HsArrApp ...                -- as above
595

Ian Lynagh's avatar
Ian Lynagh committed
596
  | HsArrForm ...               -- as above
597

Ian Lynagh's avatar
Ian Lynagh committed
598 599
  | HsApp       (HsCmd id)
                (HsExpr id)
ross's avatar
ross committed
600

Ian Lynagh's avatar
Ian Lynagh committed
601
  | HsLam       (Match  id)     -- kappa
602 603

  -- the renamer turns this one into HsArrForm
Ian Lynagh's avatar
Ian Lynagh committed
604 605 606 607
  | OpApp       (HsExpr id)     -- left operand
                (HsCmd id)      -- operator
                Fixity          -- Renamer adds fixity; bottom until then
                (HsCmd id)      -- right operand
608

Ian Lynagh's avatar
Ian Lynagh committed
609
  | HsPar       (HsCmd id)      -- parenthesised command
610

Ian Lynagh's avatar
Ian Lynagh committed
611 612 613
  | HsCase      (HsExpr id)
                [Match id]      -- bodies are HsCmd's
                SrcLoc
614

Ian Lynagh's avatar
Ian Lynagh committed
615 616 617 618
  | HsIf        (HsExpr id)     --  predicate
                (HsCmd id)      --  then part
                (HsCmd id)      --  else part
                SrcLoc
619

Ian Lynagh's avatar
Ian Lynagh committed
620 621
  | HsLet       (HsLocalBinds id)       -- let(rec)
                (HsCmd  id)
622

Ian Lynagh's avatar
Ian Lynagh committed
623 624 625 626 627 628
  | 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
629 630 631 632 633 634

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}
635 636
type LHsCmdTop id = Located (HsCmdTop id)

637
data HsCmdTop id
Ian Lynagh's avatar
Ian Lynagh committed
638 639 640 641 642
  = HsCmdTop (LHsCmd id)
             [PostTcType]     -- types of inputs on the command's stack
             PostTcType       -- return type of the command
             (SyntaxTable id) -- after type checking:
                              -- names used in the command's desugaring
643 644
\end{code}

645
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
646
%*                                                                      *
647
\subsection{Record binds}
Ian Lynagh's avatar
Ian Lynagh committed
648
%*                                                                      *
649 650 651
%************************************************************************

\begin{code}
652
type HsRecordBinds id = HsRecFields id (LHsExpr id)
653 654
\end{code}

655 656


657
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
658
%*                                                                      *
659
\subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
Ian Lynagh's avatar
Ian Lynagh committed
660
%*                                                                      *
661 662
%************************************************************************

663 664 665 666 667 668 669 670 671 672 673 674 675 676
@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.

677
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
678 679 680 681 682 683
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
684

685 686
type LMatch id = Located (Match id)

687
data Match id
688
  = Match
Ian Lynagh's avatar
Ian Lynagh committed
689 690 691 692
        [LPat id]               -- The patterns
        (Maybe (LHsType id))    -- A type signature for the result of the match
                                -- Nothing after typechecking
        (GRHSs id)
693

694 695 696
isEmptyMatchGroup :: MatchGroup id -> Bool
isEmptyMatchGroup (MatchGroup ms _) = null ms

697
matchGroupArity :: MatchGroup id -> Arity
Ian Lynagh's avatar
Ian Lynagh committed
698
matchGroupArity (MatchGroup [] _)
699
  = panic "matchGroupArity"     -- Precondition: MatchGroup is non-empty
700 701
matchGroupArity (MatchGroup (match:matches) _)
  = ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
Ian Lynagh's avatar
Ian Lynagh committed
702
    -- Assertion just checks that all the matches have the same number of pats
703 704 705 706
    n_pats
  where
    n_pats = length (hsLMatchPats match)

707 708 709
hsLMatchPats :: LMatch id -> [LPat id]
hsLMatchPats (L _ (Match pats _ _)) = pats

710
-- | GRHSs are used both for pattern bindings and for Matches
Ian Lynagh's avatar
Ian Lynagh committed
711
data GRHSs id
712 713 714 715
  = GRHSs {
      grhssGRHSs :: [LGRHS id],  -- ^ Guarded RHSs
      grhssLocalBinds :: (HsLocalBinds id) -- ^ The where clause
    }
716

717
type LGRHS id = Located (GRHS id)
718

719
-- | Guarded Right Hand Side.
Ian Lynagh's avatar
Ian Lynagh committed
720 721
data GRHS id = GRHS [LStmt id]   -- Guards
                    (LHsExpr id) -- Right hand side
722
\end{code}
723

724
We know the list must have at least one @Match@ in it.
725

726
\begin{code}
727
pprMatches :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> MatchGroup idR -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
728 729
pprMatches ctxt (MatchGroup matches _)
    = vcat (map (pprMatch ctxt) (map unLoc matches))
Ian Lynagh's avatar
Ian Lynagh committed
730
      -- Don't print the type; it's only a place-holder before typechecking
731 732

-- Exported to HsBinds, which can't see the defn of HsMatchContext
733
pprFunBind :: (OutputableBndr idL, OutputableBndr idR) => idL -> Bool -> MatchGroup idR -> SDoc
734
pprFunBind fun inf matches = pprMatches (FunRhs fun inf) matches
735 736

-- Exported to HsBinds, which can't see the defn of HsMatchContext
737
pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
Ian Lynagh's avatar
Ian Lynagh committed
738
           => LPat bndr -> GRHSs id -> SDoc
739 740 741 742
pprPatBind pat ty@(grhss)
 = sep [ppr pat, nest 4 (pprGRHSs (PatBindRhs `asTypeOf` idType ty) grhss)]
--avoid using PatternSignatures for stage1 code portability
 where idType :: GRHSs id -> HsMatchContext id; idType = undefined
743 744


745
pprMatch :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> Match idR -> SDoc
746
pprMatch ctxt (Match pats maybe_ty grhss)
747
  = herald <+> sep [sep (map pprParendLPat other_pats),
Ian Lynagh's avatar
Ian Lynagh committed
748 749
                    ppr_maybe_ty,
                    nest 2 (pprGRHSs ctxt grhss)]
750
  where
Ian Lynagh's avatar
Ian Lynagh committed
751 752 753 754 755 756 757 758
    (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

759
                | null pats2 -> (pp_infix, [])
Ian Lynagh's avatar
Ian Lynagh committed
760 761
                        -- x &&& y = e

762
                | otherwise -> (parens pp_infix, pats2)
Ian Lynagh's avatar
Ian Lynagh committed
763 764
                        -- (x &&& y) z = e
                where
765
                  pp_infix = pprParendLPat pat1 <+> ppr fun <+> pprParendLPat pat2
Ian Lynagh's avatar
Ian Lynagh committed
766 767

            LambdaExpr -> (char '\\', pats)
768 769 770
	    
            _  -> ASSERT( null pats1 )
                  (ppr pat1, [])	-- No parens around the single pat
771

772 773
    (pat1:pats1) = pats
    (pat2:pats2) = pats1
774
    ppr_maybe_ty = case maybe_ty of
Ian Lynagh's avatar
Ian Lynagh committed
775 776
                        Just ty -> dcolon <+> ppr ty
                        Nothing -> empty
777 778


Ian Lynagh's avatar
Ian Lynagh committed
779 780
pprGRHSs :: (OutputableBndr idL, OutputableBndr idR)
         => HsMatchContext idL -> GRHSs idR -> SDoc
781
pprGRHSs ctxt (GRHSs grhss binds)
Ian Lynagh's avatar
Ian Lynagh committed
782
  = vcat (map (pprGRHS ctxt . unLoc) grhss)
783 784
 $$ ppUnless (isEmptyLocalBinds binds)
      (text "where" $$ nest 4 (pprBinds binds))
785

Ian Lynagh's avatar
Ian Lynagh committed
786 787
pprGRHS :: (OutputableBndr idL, OutputableBndr idR)
        => HsMatchContext idL -> GRHS idR -> SDoc
788

789
pprGRHS ctxt (GRHS [] expr)
790
 =  pp_rhs ctxt expr
791

792
pprGRHS ctxt (GRHS guards expr)
793
 = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
794

Ian Lynagh's avatar
Ian Lynagh committed
795
pp_rhs :: OutputableBndr idR => HsMatchContext idL -> LHsExpr idR -> SDoc
796
pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
797
\end{code}
798

799
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
800
%*                                                                      *
801
\subsection{Do stmts and list comprehensions}
Ian Lynagh's avatar
Ian Lynagh committed
802
%*                                                                      *
803 804 805
%************************************************************************

\begin{code}
806 807 808 809
type LStmt id = Located (StmtLR id id)
type LStmtLR idL idR = Located (StmtLR idL idR)

type Stmt id = StmtLR id id
810

811 812
-- The SyntaxExprs in here are used *only* for do-notation, which
-- has rebindable syntax.  Otherwise they are unused.
813
data StmtLR idL idR
Ian Lynagh's avatar
Ian Lynagh committed
814 815 816 817 818 819
  = BindStmt (LPat idL)
             (LHsExpr idR)
             (SyntaxExpr idR) -- The (>>=) operator
             (SyntaxExpr idR) -- The fail operator
             -- The fail operator is noSyntaxExpr
             -- if the pattern match can't fail
820

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
821
  | ExprStmt (LHsExpr idR)     -- See Note [ExprStmt]
Ian Lynagh's avatar
Ian Lynagh committed
822 823
             (SyntaxExpr idR) -- The (>>) operator
             PostTcType       -- Element type of the RHS (used for arrows)
824

Ian Lynagh's avatar
Ian Lynagh committed
825
  | LetStmt  (HsLocalBindsLR idL idR)
826

Ian Lynagh's avatar
Ian Lynagh committed
827 828 829 830
  -- ParStmts only occur in a list comprehension
  | ParStmt  [([LStmt idL], [idR])]
  -- After renaming, the ids are the binders bound by the stmts and used
  -- after them
831

832 833 834 835 836 837 838 839 840 841 842
  -- "qs, then f by e" ==> TransformStmt qs binders f (Just e)
  -- "qs, then f"      ==> TransformStmt qs binders f Nothing
  | TransformStmt 
         [LStmt idL]	-- Stmts are the ones to the left of the 'then'

         [idR] 		-- After renaming, the IDs are the binders occurring 
		        -- within this transform statement that are used after it

         (LHsExpr idR)		-- "then f"

         (Maybe (LHsExpr idR))	-- "by e" (optional)
843

844 845 846 847
  | GroupStmt 
         [LStmt idL]      -- Stmts to the *left* of the 'group'
	 	       	  -- which generates the tuples to be grouped

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
848
         [(idR, idR)]	  -- See Note [GroupStmt binder map]
849 850 851 852 853 854 855
				
         (Maybe (LHsExpr idR)) 	-- "by e" (optional)

         (Either		-- "using f"
             (LHsExpr idR)	--   Left f  => explicit "using f"
             (SyntaxExpr idR))	--   Right f => implicit; filled in with 'groupWith'
							
Ian Lynagh's avatar
Ian Lynagh committed
856

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
857
  -- Recursive statement (see Note [How RecStmt works] below)
858 859 860 861 862 863 864 865 866 867 868 869
  | RecStmt
     { recS_stmts :: [LStmtLR idL idR]

        -- The next two fields are only valid after renaming
     , recS_later_ids :: [idR] -- The ids are a subset of the variables bound by the
  		               -- stmts that are used in stmts that follow the RecStmt

     , recS_rec_ids :: [idR]   -- Ditto, but these variables are the "recursive" ones,
                   	       -- that are used before they are bound in the stmts of
                   	       -- the RecStmt. 
	-- An Id can be in both groups
	-- Both sets of Ids are (now) treated monomorphically