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