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