ghc/compiler/hsSyn/HsExpr.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[HsExpr]{Abstract Haskell syntax: expressions}
   5
   6 \begin{code}
   7 module HsExpr where
   8
   9 #include "HsVersions.h"
  10
  11 -- friends:
  12 import HsDecls          ( HsDecl )
  13 import HsBinds          ( HsBinds(..), nullBinds )
  14 import HsPat            ( Pat )
  15 import HsLit            ( HsLit, HsOverLit )
  16 import HsTypes          ( HsType, PostTcType, SyntaxName )
  17 import HsImpExp         ( isOperator, pprHsVar )
  18
  19 -- others:
  20 import ForeignCall      ( Safety )
  21 import PprType          ( pprParendType )
  22 import Type             ( Type )
  23 import Var              ( TyVar, Id )
  24 import Name             ( Name )
  25 import DataCon          ( DataCon )
  26 import CStrings         ( CLabelString, pprCLabelString )
  27 import BasicTypes       ( IPName, Boxity, tupleParens, Fixity(..) )
  28 import SrcLoc           ( SrcLoc )
  29 import Outputable
  30 import FastString
  31 \end{code}
  32
  33 %************************************************************************
  34 %*                                                                      *
  35 \subsection{Expressions proper}
  36 %*                                                                      *
  37 %************************************************************************
  38
  39 \begin{code}
  40 data HsExpr id
  41   = HsVar       id              -- variable
  42   | HsIPVar     (IPName id)     -- implicit parameter
  43   | HsOverLit   HsOverLit       -- Overloaded literals; eliminated by type checker
  44   | HsLit       HsLit           -- Simple (non-overloaded) literals
  45
  46   | HsLam       (Match  id)     -- lambda
  47   | HsApp       (HsExpr id)     -- application
  48                 (HsExpr id)
  49
  50   -- Operator applications:
  51   -- NB Bracketed ops such as (+) come out as Vars.
  52
  53   -- NB We need an expr for the operator in an OpApp/Section since
  54   -- the typechecker may need to apply the operator to a few types.
  55
  56   | OpApp       (HsExpr id)     -- left operand
  57                 (HsExpr id)     -- operator
  58                 Fixity                          -- Renamer adds fixity; bottom until then
  59                 (HsExpr id)     -- right operand
  60
  61   -- We preserve prefix negation and parenthesis for the precedence parser.
  62   -- They are eventually removed by the type checker.
  63
  64   | NegApp      (HsExpr id)     -- negated expr
  65                 SyntaxName      -- Name of 'negate' (see RnEnv.lookupSyntaxName)
  66
  67   | HsPar       (HsExpr id)     -- parenthesised expr
  68
  69   | SectionL    (HsExpr id)     -- operand
  70                 (HsExpr id)     -- operator
  71   | SectionR    (HsExpr id)     -- operator
  72                 (HsExpr id)     -- operand
  73
  74   | HsCase      (HsExpr id)
  75                 [Match id]
  76                 SrcLoc
  77
  78   | HsIf        (HsExpr id)     --  predicate
  79                 (HsExpr id)     --  then part
  80                 (HsExpr id)     --  else part
  81                 SrcLoc
  82
  83   | HsLet       (HsBinds id)    -- let(rec)
  84                 (HsExpr  id)
  85
  86   | HsWith      (HsExpr id)     -- implicit parameter binding
  87                 [(IPName id, HsExpr id)]
  88                 Bool            -- True <=> this was a 'with' binding
  89                                 --  (tmp, until 'with' is removed)
  90
  91   | HsDo        (HsStmtContext Name)    -- The parameterisation is unimportant
  92                                         -- because in this context we never use
  93                                         -- the FunRhs variant
  94                 [Stmt id]       -- "do":one or more stmts
  95                 [id]            -- Ids for [return,fail,>>=,>>]
  96                                 --      Brutal but simple
  97                                 -- Before type checking, used for rebindable syntax
  98                 PostTcType      -- Type of the whole expression
  99                 SrcLoc
 100
 101   | ExplicitList                -- syntactic list
 102                 PostTcType      -- Gives type of components of list
 103                 [HsExpr id]
 104
 105   | ExplicitPArr                -- syntactic parallel array: [:e1, ..., en:]
 106                 PostTcType      -- type of elements of the parallel array
 107                 [HsExpr id]
 108
 109   | ExplicitTuple               -- tuple
 110                 [HsExpr id]
 111                                 -- NB: Unit is ExplicitTuple []
 112                                 -- for tuples, we can get the types
 113                                 -- direct from the components
 114                 Boxity
 115
 116
 117         -- Record construction
 118   | RecordCon   id                              -- The constructor
 119                 (HsRecordBinds id)
 120
 121   | RecordConOut DataCon
 122                 (HsExpr id)             -- Data con Id applied to type args
 123                 (HsRecordBinds id)
 124
 125
 126         -- Record update
 127   | RecordUpd   (HsExpr id)
 128                 (HsRecordBinds id)
 129
 130   | RecordUpdOut (HsExpr id)    -- TRANSLATION
 131                  Type                   -- Type of *input* record
 132                  Type                   -- Type of *result* record (may differ from
 133                                         --      type of input record)
 134                  (HsRecordBinds id)
 135
 136   | ExprWithTySig                       -- signature binding
 137                 (HsExpr id)
 138                 (HsType id)
 139   | ArithSeqIn                          -- arithmetic sequence
 140                 (ArithSeqInfo id)
 141   | ArithSeqOut
 142                 (HsExpr id)             -- (typechecked, of course)
 143                 (ArithSeqInfo id)
 144   | PArrSeqIn                           -- arith. sequence for parallel array
 145                 (ArithSeqInfo id)       -- [:e1..e2:] or [:e1, e2..e3:]
 146   | PArrSeqOut
 147                 (HsExpr id)             -- (typechecked, of course)
 148                 (ArithSeqInfo id)
 149
 150   | HsCCall     CLabelString    -- call into the C world; string is
 151                 [HsExpr id]     -- the C function; exprs are the
 152                                 -- arguments to pass.
 153                 Safety          -- True <=> might cause Haskell
 154                                 -- garbage-collection (must generate
 155                                 -- more paranoid code)
 156                 Bool            -- True <=> it's really a "casm"
 157                                 -- NOTE: this CCall is the *boxed*
 158                                 -- version; the desugarer will convert
 159                                 -- it into the unboxed "ccall#".
 160                 PostTcType      -- The result type; will be *bottom*
 161                                 -- until the typechecker gets ahold of it
 162
 163   | HsSCC       FastString      -- "set cost centre" (_scc_) annotation
 164                 (HsExpr id)     -- expr whose cost is to be measured
 165
 166   -- MetaHaskell Extensions
 167   | HsBracket    (HsBracket id)
 168
 169   | HsBracketOut (HsBracket Name)       -- Output of the type checker is the *original*
 170                  [PendingSplice]        -- renamed expression, plus *typechecked* splices
 171                                         -- to be pasted back in by the desugarer
 172
 173   | HsSplice id (HsExpr id )            -- $z  or $(f 4)
 174                                         -- The id is just a unique name to
 175                                         -- identify this splice point
 176 \end{code}
 177
 178
 179 These constructors only appear temporarily in the parser.
 180 The renamer translates them into the Right Thing.
 181
 182 \begin{code}
 183   | EWildPat                    -- wildcard
 184
 185   | EAsPat      id              -- as pattern
 186                 (HsExpr id)
 187
 188   | ELazyPat    (HsExpr id) -- ~ pattern
 189
 190   | HsType      (HsType id)     -- Explicit type argument; e.g  f {| Int |} x y
 191 \end{code}
 192
 193 Everything from here on appears only in typechecker output.
 194
 195 \begin{code}
 196   | TyLam                       -- TRANSLATION
 197                 [TyVar]
 198                 (HsExpr id)
 199   | TyApp                       -- TRANSLATION
 200                 (HsExpr id) -- generated by Spec
 201                 [Type]
 202
 203   -- DictLam and DictApp are "inverses"
 204   |  DictLam
 205                 [id]
 206                 (HsExpr id)
 207   |  DictApp
 208                 (HsExpr id)
 209                 [id]
 210
 211 type PendingSplice = (Name, HsExpr Id)  -- Typechecked splices, waiting to be
 212                                         -- pasted back in by the desugarer
 213 \end{code}
 214
 215
 216 A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
 217 @ClassDictLam dictvars methods expr@ is, therefore:
 218 \begin{verbatim}
 219 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
 220 \end{verbatim}
 221
 222 \begin{code}
 223 instance OutputableBndr id => Outputable (HsExpr id) where
 224     ppr expr = pprExpr expr
 225 \end{code}
 226
 227 \begin{code}
 228 pprExpr :: OutputableBndr id => HsExpr id -> SDoc
 229
 230 pprExpr  e = pprDeeper (ppr_expr e)
 231 pprBinds b = pprDeeper (ppr b)
 232
 233 ppr_expr (HsVar v)       = pprHsVar v
 234 ppr_expr (HsIPVar v)     = ppr v
 235 ppr_expr (HsLit lit)     = ppr lit
 236 ppr_expr (HsOverLit lit) = ppr lit
 237
 238 ppr_expr (HsLam match) = pprMatch LambdaExpr match
 239
 240 ppr_expr expr@(HsApp e1 e2)
 241   = let (fun, args) = collect_args expr [] in
 242     (ppr_expr fun) <+> (sep (map ppr_expr args))
 243   where
 244     collect_args (HsApp fun arg) args = collect_args fun (arg:args)
 245     collect_args fun             args = (fun, args)
 246
 247 ppr_expr (OpApp e1 op fixity e2)
 248   = case op of
 249       HsVar v -> pp_infixly v
 250       _       -> pp_prefixly
 251   where
 252     pp_e1 = pprParendExpr e1            -- Add parens to make precedence clear
 253     pp_e2 = pprParendExpr e2
 254
 255     pp_prefixly
 256       = hang (pprExpr op) 4 (sep [pp_e1, pp_e2])
 257
 258     pp_infixly v
 259       = sep [pp_e1, hsep [pp_v_op, pp_e2]]
 260       where
 261         ppr_v = ppr v
 262         pp_v_op | isOperator ppr_v = ppr_v
 263                 | otherwise        = char '`' <> ppr_v <> char '`'
 264                 -- Put it in backquotes if it's not an operator already
 265
 266 ppr_expr (NegApp e _) = char '-' <+> pprParendExpr e
 267
 268 ppr_expr (HsPar e) = parens (ppr_expr e)
 269
 270 ppr_expr (SectionL expr op)
 271   = case op of
 272       HsVar v -> pp_infixly v
 273       _       -> pp_prefixly
 274   where
 275     pp_expr = pprParendExpr expr
 276
 277     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
 278                        4 (hsep [pp_expr, ptext SLIT("x_ )")])
 279     pp_infixly v = parens (sep [pp_expr, ppr v])
 280
 281 ppr_expr (SectionR op expr)
 282   = case op of
 283       HsVar v -> pp_infixly v
 284       _       -> pp_prefixly
 285   where
 286     pp_expr = pprParendExpr expr
 287
 288     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext SLIT("x_")])
 289                        4 ((<>) pp_expr rparen)
 290     pp_infixly v
 291       = parens (sep [ppr v, pp_expr])
 292
 293 ppr_expr (HsCase expr matches _)
 294   = sep [ sep [ptext SLIT("case"), nest 4 (pprExpr expr), ptext SLIT("of")],
 295             nest 2 (pprMatches CaseAlt matches) ]
 296
 297 ppr_expr (HsIf e1 e2 e3 _)
 298   = sep [hsep [ptext SLIT("if"), nest 2 (pprExpr e1), ptext SLIT("then")],
 299            nest 4 (pprExpr e2),
 300            ptext SLIT("else"),
 301            nest 4 (pprExpr e3)]
 302
 303 -- special case: let ... in let ...
 304 ppr_expr (HsLet binds expr@(HsLet _ _))
 305   = sep [hang (ptext SLIT("let")) 2 (hsep [pprBinds binds, ptext SLIT("in")]),
 306          pprExpr expr]
 307
 308 ppr_expr (HsLet binds expr)
 309   = sep [hang (ptext SLIT("let")) 2 (pprBinds binds),
 310          hang (ptext SLIT("in"))  2 (ppr expr)]
 311
 312 ppr_expr (HsWith expr binds is_with)
 313   = sep [hang (ptext SLIT("let")) 2 (pp_ipbinds binds),
 314          hang (ptext SLIT("in"))  2 (ppr expr)]
 315
 316 ppr_expr (HsDo do_or_list_comp stmts _ _ _) = pprDo do_or_list_comp stmts
 317
 318 ppr_expr (ExplicitList _ exprs)
 319   = brackets (fsep (punctuate comma (map ppr_expr exprs)))
 320
 321 ppr_expr (ExplicitPArr _ exprs)
 322   = pa_brackets (fsep (punctuate comma (map ppr_expr exprs)))
 323
 324 ppr_expr (ExplicitTuple exprs boxity)
 325   = tupleParens boxity (sep (punctuate comma (map ppr_expr exprs)))
 326
 327 ppr_expr (RecordCon con_id rbinds)
 328   = pp_rbinds (ppr con_id) rbinds
 329 ppr_expr (RecordConOut data_con con rbinds)
 330   = pp_rbinds (ppr con) rbinds
 331
 332 ppr_expr (RecordUpd aexp rbinds)
 333   = pp_rbinds (pprParendExpr aexp) rbinds
 334 ppr_expr (RecordUpdOut aexp _ _ rbinds)
 335   = pp_rbinds (pprParendExpr aexp) rbinds
 336
 337 ppr_expr (ExprWithTySig expr sig)
 338   = hang (nest 2 (ppr_expr expr) <+> dcolon)
 339          4 (ppr sig)
 340
 341 ppr_expr (ArithSeqIn info)
 342   = brackets (ppr info)
 343 ppr_expr (ArithSeqOut expr info)
 344   = brackets (ppr info)
 345
 346 ppr_expr (PArrSeqIn info)
 347   = pa_brackets (ppr info)
 348 ppr_expr (PArrSeqOut expr info)
 349   = pa_brackets (ppr info)
 350
 351 ppr_expr EWildPat = char '_'
 352 ppr_expr (ELazyPat e) = char '~' <> pprParendExpr e
 353 ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e
 354
 355 ppr_expr (HsCCall fun args _ is_asm result_ty)
 356   = hang (if is_asm
 357           then ptext SLIT("_casm_ ``") <> pprCLabelString fun <> ptext SLIT("''")
 358           else ptext SLIT("_ccall_") <+> pprCLabelString fun)
 359        4 (sep (map pprParendExpr args))
 360
 361 ppr_expr (HsSCC lbl expr)
 362   = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ftext lbl), pprParendExpr expr ]
 363
 364 ppr_expr (TyLam tyvars expr)
 365   = hang (hsep [ptext SLIT("/\\"),
 366                 hsep (map (pprBndr LambdaBind) tyvars),
 367                 ptext SLIT("->")])
 368          4 (ppr_expr expr)
 369
 370 ppr_expr (TyApp expr [ty])
 371   = hang (ppr_expr expr) 4 (pprParendType ty)
 372
 373 ppr_expr (TyApp expr tys)
 374   = hang (ppr_expr expr)
 375          4 (brackets (interpp'SP tys))
 376
 377 ppr_expr (DictLam dictvars expr)
 378   = hang (hsep [ptext SLIT("\\{-dict-}"),
 379                 hsep (map (pprBndr LambdaBind) dictvars),
 380                 ptext SLIT("->")])
 381          4 (ppr_expr expr)
 382
 383 ppr_expr (DictApp expr [dname])
 384   = hang (ppr_expr expr) 4 (ppr dname)
 385
 386 ppr_expr (DictApp expr dnames)
 387   = hang (ppr_expr expr)
 388          4 (brackets (interpp'SP dnames))
 389
 390 ppr_expr (HsType id) = ppr id
 391
 392 ppr_expr (HsSplice n e)      = char '$' <> brackets (ppr n) <> pprParendExpr e
 393 ppr_expr (HsBracket b)       = pprHsBracket b
 394 ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("where") <+> ppr ps
 395
 396 -- add parallel array brackets around a document
 397 --
 398 pa_brackets :: SDoc -> SDoc
 399 pa_brackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
 400 \end{code}
 401
 402 Parenthesize unless very simple:
 403 \begin{code}
 404 pprParendExpr :: OutputableBndr id => HsExpr id -> SDoc
 405
 406 pprParendExpr expr
 407   = let
 408         pp_as_was = pprExpr expr
 409     in
 410     case expr of
 411       HsLit l               -> ppr l
 412       HsOverLit l           -> ppr l
 413
 414       HsVar _               -> pp_as_was
 415       HsIPVar _             -> pp_as_was
 416       ExplicitList _ _      -> pp_as_was
 417       ExplicitPArr _ _      -> pp_as_was
 418       ExplicitTuple _ _     -> pp_as_was
 419       HsPar _               -> pp_as_was
 420
 421       _                     -> parens pp_as_was
 422 \end{code}
 423
 424 %************************************************************************
 425 %*                                                                      *
 426 \subsection{Record binds}
 427 %*                                                                      *
 428 %************************************************************************
 429
 430 \begin{code}
 431 type HsRecordBinds id = [(id, HsExpr id)]
 432
 433 recBindFields :: HsRecordBinds id -> [id]
 434 recBindFields rbinds = [field | (field,_) <- rbinds]
 435
 436 pp_rbinds :: OutputableBndr id => SDoc -> HsRecordBinds id -> SDoc
 437
 438 pp_rbinds thing rbinds
 439   = hang thing
 440          4 (braces (sep (punctuate comma (map (pp_rbind) rbinds))))
 441   where
 442     pp_rbind (v, e) = hsep [pprBndr LetBind v, char '=', ppr e]
 443 \end{code}
 444
 445 \begin{code}
 446 pp_ipbinds :: OutputableBndr id => [(IPName id, HsExpr id)] -> SDoc
 447 pp_ipbinds pairs = hsep (punctuate semi (map pp_item pairs))
 448                  where
 449                    pp_item (id,rhs) = pprBndr LetBind id <+> equals <+> ppr_expr rhs
 450 \end{code}
 451
 452
 453 %************************************************************************
 454 %*                                                                      *
 455 \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
 456 %*                                                                      *
 457 %************************************************************************
 458
 459 @Match@es are sets of pattern bindings and right hand sides for
 460 functions, patterns or case branches. For example, if a function @g@
 461 is defined as:
 462 \begin{verbatim}
 463 g (x,y) = y
 464 g ((x:ys),y) = y+1,
 465 \end{verbatim}
 466 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
 467
 468 It is always the case that each element of an @[Match]@ list has the
 469 same number of @pats@s inside it.  This corresponds to saying that
 470 a function defined by pattern matching must have the same number of
 471 patterns in each equation.
 472
 473 \begin{code}
 474 data Match id
 475   = Match
 476         [Pat id]                -- The patterns
 477         (Maybe (HsType id))     -- A type signature for the result of the match
 478                                 --      Nothing after typechecking
 479
 480         (GRHSs id)
 481
 482 -- GRHSs are used both for pattern bindings and for Matches
 483 data GRHSs id
 484   = GRHSs [GRHS id]             -- Guarded RHSs
 485           (HsBinds id)          -- The where clause
 486           PostTcType            -- Type of RHS (after type checking)
 487
 488 data GRHS id
 489   = GRHS  [Stmt id]             -- The RHS is the final ResultStmt
 490           SrcLoc
 491
 492 mkSimpleMatch :: [Pat id] -> HsExpr id -> Type -> SrcLoc -> Match id
 493 mkSimpleMatch pats rhs rhs_ty locn
 494   = Match pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds rhs_ty)
 495
 496 unguardedRHS :: HsExpr id -> SrcLoc -> [GRHS id]
 497 unguardedRHS rhs loc = [GRHS [ResultStmt rhs loc] loc]
 498 \end{code}
 499
 500 @getMatchLoc@ takes a @Match@ and returns the
 501 source-location gotten from the GRHS inside.
 502 THis is something of a nuisance, but no more.
 503
 504 \begin{code}
 505 getMatchLoc :: Match id -> SrcLoc
 506 getMatchLoc (Match _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
 507 \end{code}
 508
 509 We know the list must have at least one @Match@ in it.
 510
 511 \begin{code}
 512 pprMatches :: (OutputableBndr id) => HsMatchContext id -> [Match id] -> SDoc
 513 pprMatches ctxt matches = vcat (map (pprMatch ctxt) matches)
 514
 515 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 516 pprFunBind :: (OutputableBndr id) => id -> [Match id] -> SDoc
 517 pprFunBind fun matches = pprMatches (FunRhs fun) matches
 518
 519 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 520 pprPatBind :: (OutputableBndr id)
 521            => Pat id -> GRHSs id -> SDoc
 522 pprPatBind pat grhss = sep [ppr pat, nest 4 (pprGRHSs PatBindRhs grhss)]
 523
 524
 525 pprMatch :: OutputableBndr id => HsMatchContext id -> Match id -> SDoc
 526 pprMatch ctxt (Match pats maybe_ty grhss)
 527   = pp_name ctxt <+> sep [sep (map ppr pats),
 528                      ppr_maybe_ty,
 529                      nest 2 (pprGRHSs ctxt grhss)]
 530   where
 531     pp_name (FunRhs fun) = ppr fun      -- Not pprBndr; the AbsBinds will
 532                                         -- have printed the signature
 533     pp_name LambdaExpr   = char '\\'
 534     pp_name other        = empty
 535
 536     ppr_maybe_ty = case maybe_ty of
 537                         Just ty -> dcolon <+> ppr ty
 538                         Nothing -> empty
 539
 540
 541 pprGRHSs :: OutputableBndr id => HsMatchContext id -> GRHSs id -> SDoc
 542 pprGRHSs ctxt (GRHSs grhss binds ty)
 543   = vcat (map (pprGRHS ctxt) grhss)
 544     $$
 545     (if nullBinds binds then empty
 546      else text "where" $$ nest 4 (pprDeeper (ppr binds)))
 547
 548
 549 pprGRHS :: OutputableBndr id => HsMatchContext id -> GRHS id -> SDoc
 550
 551 pprGRHS ctxt (GRHS [ResultStmt expr _] locn)
 552  =  pp_rhs ctxt expr
 553
 554 pprGRHS ctxt (GRHS guarded locn)
 555  = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
 556  where
 557     ResultStmt expr _ = last guarded    -- Last stmt should be a ResultStmt for guards
 558     guards            = init guarded
 559
 560 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
 561 \end{code}
 562
 563
 564
 565 %************************************************************************
 566 %*                                                                      *
 567 \subsection{Do stmts and list comprehensions}
 568 %*                                                                      *
 569 %************************************************************************
 570
 571 \begin{code}
 572 data Stmt id
 573   = BindStmt    (Pat id) (HsExpr id) SrcLoc
 574   | LetStmt     (HsBinds id)
 575   | ResultStmt  (HsExpr id)     SrcLoc                  -- See notes that follow
 576   | ExprStmt    (HsExpr id)     PostTcType SrcLoc       -- See notes that follow
 577         -- The type is the *element type* of the expression
 578
 579         -- ParStmts only occur in a list comprehension
 580   | ParStmt     [[Stmt id]]             -- List comp only: parallel set of quals
 581   | ParStmtOut  [([id], [Stmt id])]     -- PLC after renaming; the ids are the binders
 582                                         -- bound by the stmts
 583
 584         -- mdo-notation (only exists after renamer)
 585         -- The ids are a subset of the variables bound by the stmts that
 586         -- either (a) are used before they are bound in the stmts
 587         -- or     (b) are used in stmts that follow the RecStmt
 588   | RecStmt  [id]
 589              [Stmt id]
 590 \end{code}
 591
 592 ExprStmts and ResultStmts are a bit tricky, because what they mean
 593 depends on the context.  Consider the following contexts:
 594
 595         A do expression of type (m res_ty)
 596         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 597         * ExprStmt E any_ty:   do { ....; E; ... }
 598                 E :: m any_ty
 599           Translation: E >> ...
 600
 601         * ResultStmt E:   do { ....; E }
 602                 E :: m res_ty
 603           Translation: E
 604
 605         A list comprehensions of type [elt_ty]
 606         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 607         * ExprStmt E Bool:   [ .. | .... E ]
 608                         [ .. | ..., E, ... ]
 609                         [ .. | .... | ..., E | ... ]
 610                 E :: Bool
 611           Translation: if E then fail else ...
 612
 613         * ResultStmt E:   [ E | ... ]
 614                 E :: elt_ty
 615           Translation: return E
 616
 617         A guard list, guarding a RHS of type rhs_ty
 618         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 619         * ExprStmt E Bool:   f x | ..., E, ... = ...rhs...
 620                 E :: Bool
 621           Translation: if E then fail else ...
 622
 623         * ResultStmt E:   f x | ...guards... = E
 624                 E :: rhs_ty
 625           Translation: E
 626
 627 Array comprehensions are handled like list comprehensions -=chak
 628
 629 \begin{code}
 630 consLetStmt :: HsBinds id -> [Stmt id] -> [Stmt id]
 631 consLetStmt EmptyBinds stmts = stmts
 632 consLetStmt binds      stmts = LetStmt binds : stmts
 633 \end{code}
 634
 635 \begin{code}
 636 instance OutputableBndr id => Outputable (Stmt id) where
 637     ppr stmt = pprStmt stmt
 638
 639 pprStmt (BindStmt pat expr _) = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
 640 pprStmt (LetStmt binds)       = hsep [ptext SLIT("let"), pprBinds binds]
 641 pprStmt (ExprStmt expr _ _)   = ppr expr
 642 pprStmt (ResultStmt expr _)   = ppr expr
 643 pprStmt (ParStmt stmtss)
 644  = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
 645 pprStmt (ParStmtOut stmtss)
 646  = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
 647 pprStmt (RecStmt _ segment) = vcat (map ppr segment)
 648
 649 pprDo :: OutputableBndr id => HsStmtContext any -> [Stmt id] -> SDoc
 650 pprDo DoExpr stmts   = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts))
 651 pprDo MDoExpr stmts  = hang (ptext SLIT("mdo")) 3 (vcat (map ppr stmts))
 652 pprDo ListComp stmts = pprComp brackets   stmts
 653 pprDo PArrComp stmts = pprComp pa_brackets stmts
 654
 655 pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [Stmt id] -> SDoc
 656 pprComp brack stmts = brack $
 657                       hang (pprExpr expr <+> char '|')
 658                          4 (interpp'SP quals)
 659                     where
 660                       ResultStmt expr _ = last stmts  -- Last stmt should
 661                       quals             = init stmts  -- be an ResultStmt
 662 \end{code}
 663
 664 %************************************************************************
 665 %*                                                                      *
 666                 Template Haskell quotation brackets
 667 %*                                                                      *
 668 %************************************************************************
 669
 670 \begin{code}
 671 data HsBracket id = ExpBr (HsExpr id)
 672                   | PatBr (Pat id)
 673                   | DecBr [HsDecl id]
 674                   | TypBr (HsType id)
 675
 676 instance OutputableBndr id => Outputable (HsBracket id) where
 677   ppr = pprHsBracket
 678
 679
 680 pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
 681 pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
 682 pprHsBracket (DecBr d) = thBrackets (char 'd') (vcat (map ppr d))
 683 pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
 684
 685
 686 thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
 687                              pp_body <+> ptext SLIT("|]")
 688 \end{code}
 689
 690 %************************************************************************
 691 %*                                                                      *
 692 \subsection{Enumerations and list comprehensions}
 693 %*                                                                      *
 694 %************************************************************************
 695
 696 \begin{code}
 697 data ArithSeqInfo id
 698   = From            (HsExpr id)
 699   | FromThen        (HsExpr id)
 700                     (HsExpr id)
 701   | FromTo          (HsExpr id)
 702                     (HsExpr id)
 703   | FromThenTo      (HsExpr id)
 704                     (HsExpr id)
 705                     (HsExpr id)
 706 \end{code}
 707
 708 \begin{code}
 709 instance OutputableBndr id => Outputable (ArithSeqInfo id) where
 710     ppr (From e1)               = hcat [ppr e1, pp_dotdot]
 711     ppr (FromThen e1 e2)        = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
 712     ppr (FromTo e1 e3)  = hcat [ppr e1, pp_dotdot, ppr e3]
 713     ppr (FromThenTo e1 e2 e3)
 714       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
 715
 716 pp_dotdot = ptext SLIT(" .. ")
 717 \end{code}
 718
 719
 720 %************************************************************************
 721 %*                                                                      *
 722 \subsection{HsMatchCtxt}
 723 %*                                                                      *
 724 %************************************************************************
 725
 726 \begin{code}
 727 data HsMatchContext id  -- Context of a Match
 728   = FunRhs id                   -- Function binding for f
 729   | CaseAlt                     -- Guard on a case alternative
 730   | LambdaExpr                  -- Pattern of a lambda
 731   | PatBindRhs                  -- Pattern binding
 732   | RecUpd                      -- Record update [used only in DsExpr to tell matchWrapper
 733                                 --      what sort of runtime error message to generate]
 734   | StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
 735   deriving ()
 736
 737 data HsStmtContext id
 738   = ListComp
 739   | DoExpr
 740   | MDoExpr                             -- Recursive do-expression
 741   | PArrComp                            -- Parallel array comprehension
 742   | PatGuard (HsMatchContext id)        -- Pattern guard for specified thing
 743 \end{code}
 744
 745 \begin{code}
 746 isDoExpr :: HsStmtContext id -> Bool
 747 isDoExpr DoExpr  = True
 748 isDoExpr MDoExpr = True
 749 isDoExpr other   = False
 750 \end{code}
 751
 752 \begin{code}
 753 matchSeparator (FunRhs _)   = ptext SLIT("=")
 754 matchSeparator CaseAlt      = ptext SLIT("->")
 755 matchSeparator LambdaExpr   = ptext SLIT("->")
 756 matchSeparator PatBindRhs   = ptext SLIT("=")
 757 matchSeparator (StmtCtxt _) = ptext SLIT("<-")
 758 matchSeparator RecUpd       = panic "unused"
 759 \end{code}
 760
 761 \begin{code}
 762 pprMatchContext (FunRhs fun)      = ptext SLIT("the definition of") <+> quotes (ppr fun)
 763 pprMatchContext CaseAlt           = ptext SLIT("a case alternative")
 764 pprMatchContext RecUpd            = ptext SLIT("a record-update construct")
 765 pprMatchContext PatBindRhs        = ptext SLIT("a pattern binding")
 766 pprMatchContext LambdaExpr        = ptext SLIT("a lambda abstraction")
 767 pprMatchContext (StmtCtxt ctxt)   = ptext SLIT("a pattern binding in") $$ pprStmtContext ctxt
 768
 769 pprMatchRhsContext (FunRhs fun) = ptext SLIT("a right-hand side of function") <+> quotes (ppr fun)
 770 pprMatchRhsContext CaseAlt      = ptext SLIT("the body of a case alternative")
 771 pprMatchRhsContext PatBindRhs   = ptext SLIT("the right-hand side of a pattern binding")
 772 pprMatchRhsContext LambdaExpr   = ptext SLIT("the body of a lambda")
 773 pprMatchRhsContext RecUpd       = panic "pprMatchRhsContext"
 774
 775 pprStmtContext (PatGuard ctxt) = ptext SLIT("a pattern guard for") $$ pprMatchContext ctxt
 776 pprStmtContext DoExpr          = ptext SLIT("a 'do' expression")
 777 pprStmtContext MDoExpr         = ptext SLIT("an 'mdo' expression")
 778 pprStmtContext ListComp        = ptext SLIT("a list comprehension")
 779 pprStmtContext PArrComp        = ptext SLIT("an array comprehension")
 780
 781 -- Used for the result statement of comprehension
 782 -- e.g. the 'e' in      [ e | ... ]
 783 --      or the 'r' in   f x = r
 784 pprStmtResultContext (PatGuard ctxt) = pprMatchRhsContext ctxt
 785 pprStmtResultContext other           = ptext SLIT("the result of") <+> pprStmtContext other
 786
 787
 788 -- Used to generate the string for a *runtime* error message
 789 matchContextErrString (FunRhs fun)            = "function " ++ showSDoc (ppr fun)
 790 matchContextErrString CaseAlt                 = "case"
 791 matchContextErrString PatBindRhs              = "pattern binding"
 792 matchContextErrString RecUpd                  = "record update"
 793 matchContextErrString LambdaExpr              = "lambda"
 794 matchContextErrString (StmtCtxt (PatGuard _)) = "pattern gaurd"
 795 matchContextErrString (StmtCtxt DoExpr)       = "'do' expression"
 796 matchContextErrString (StmtCtxt MDoExpr)      = "'mdo' expression"
 797 matchContextErrString (StmtCtxt ListComp)     = "list comprehension"
 798 matchContextErrString (StmtCtxt PArrComp)     = "array comprehension"
 799 \end{code}