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