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 )
  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   | HsCoreAnn   FastString      -- hdaume: core annotation
 162                 (HsExpr id)
 163
 164   -- MetaHaskell Extensions
 165   | HsBracket    (HsBracket id) SrcLoc
 166
 167   | HsBracketOut (HsBracket Name)       -- Output of the type checker is the *original*
 168                  [PendingSplice]        -- renamed expression, plus *typechecked* splices
 169                                         -- to be pasted back in by the desugarer
 170
 171   | HsSplice id (HsExpr id) SrcLoc      -- $z  or $(f 4)
 172                                         -- The id is just a unique name to
 173                                         -- identify this splice point
 174
 175   | HsReify (HsReify id)                -- reifyType t, reifyDecl i, reifyFixity
 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 (HsDo do_or_list_comp stmts _ _ _) = pprDo do_or_list_comp stmts
 313
 314 ppr_expr (ExplicitList _ exprs)
 315   = brackets (fsep (punctuate comma (map ppr_expr exprs)))
 316
 317 ppr_expr (ExplicitPArr _ exprs)
 318   = pa_brackets (fsep (punctuate comma (map ppr_expr exprs)))
 319
 320 ppr_expr (ExplicitTuple exprs boxity)
 321   = tupleParens boxity (sep (punctuate comma (map ppr_expr exprs)))
 322
 323 ppr_expr (RecordCon con_id rbinds)
 324   = pp_rbinds (ppr con_id) rbinds
 325 ppr_expr (RecordConOut data_con con rbinds)
 326   = pp_rbinds (ppr con) rbinds
 327
 328 ppr_expr (RecordUpd aexp rbinds)
 329   = pp_rbinds (pprParendExpr aexp) rbinds
 330 ppr_expr (RecordUpdOut aexp _ _ rbinds)
 331   = pp_rbinds (pprParendExpr aexp) rbinds
 332
 333 ppr_expr (ExprWithTySig expr sig)
 334   = hang (nest 2 (ppr_expr expr) <+> dcolon)
 335          4 (ppr sig)
 336
 337 ppr_expr (ArithSeqIn info)
 338   = brackets (ppr info)
 339 ppr_expr (ArithSeqOut expr info)
 340   = brackets (ppr info)
 341
 342 ppr_expr (PArrSeqIn info)
 343   = pa_brackets (ppr info)
 344 ppr_expr (PArrSeqOut expr info)
 345   = pa_brackets (ppr info)
 346
 347 ppr_expr EWildPat = char '_'
 348 ppr_expr (ELazyPat e) = char '~' <> pprParendExpr e
 349 ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e
 350
 351 ppr_expr (HsCCall fun args _ is_asm result_ty)
 352   = hang (if is_asm
 353           then ptext SLIT("_casm_ ``") <> pprCLabelString fun <> ptext SLIT("''")
 354           else ptext SLIT("_ccall_") <+> pprCLabelString fun)
 355        4 (sep (map pprParendExpr args))
 356
 357 ppr_expr (HsSCC lbl expr)
 358   = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ftext lbl), pprParendExpr expr ]
 359
 360 ppr_expr (TyLam tyvars expr)
 361   = hang (hsep [ptext SLIT("/\\"),
 362                 hsep (map (pprBndr LambdaBind) tyvars),
 363                 ptext SLIT("->")])
 364          4 (ppr_expr expr)
 365
 366 ppr_expr (TyApp expr [ty])
 367   = hang (ppr_expr expr) 4 (pprParendType ty)
 368
 369 ppr_expr (TyApp expr tys)
 370   = hang (ppr_expr expr)
 371          4 (brackets (interpp'SP tys))
 372
 373 ppr_expr (DictLam dictvars expr)
 374   = hang (hsep [ptext SLIT("\\{-dict-}"),
 375                 hsep (map (pprBndr LambdaBind) dictvars),
 376                 ptext SLIT("->")])
 377          4 (ppr_expr expr)
 378
 379 ppr_expr (DictApp expr [dname])
 380   = hang (ppr_expr expr) 4 (ppr dname)
 381
 382 ppr_expr (DictApp expr dnames)
 383   = hang (ppr_expr expr)
 384          4 (brackets (interpp'SP dnames))
 385
 386 ppr_expr (HsType id) = ppr id
 387
 388 ppr_expr (HsSplice n e _)    = char '$' <> brackets (ppr n) <> pprParendExpr e
 389 ppr_expr (HsBracket b _)     = pprHsBracket b
 390 ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("where") <+> ppr ps
 391 ppr_expr (HsReify r)         = ppr r
 392
 393 -- add parallel array brackets around a document
 394 --
 395 pa_brackets :: SDoc -> SDoc
 396 pa_brackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
 397 \end{code}
 398
 399 Parenthesize unless very simple:
 400 \begin{code}
 401 pprParendExpr :: OutputableBndr id => HsExpr id -> SDoc
 402
 403 pprParendExpr expr
 404   = let
 405         pp_as_was = pprExpr expr
 406     in
 407     case expr of
 408       HsLit l               -> ppr l
 409       HsOverLit l           -> ppr l
 410
 411       HsVar _               -> pp_as_was
 412       HsIPVar _             -> pp_as_was
 413       ExplicitList _ _      -> pp_as_was
 414       ExplicitPArr _ _      -> pp_as_was
 415       ExplicitTuple _ _     -> pp_as_was
 416       HsPar _               -> pp_as_was
 417
 418       _                     -> parens pp_as_was
 419 \end{code}
 420
 421 %************************************************************************
 422 %*                                                                      *
 423 \subsection{Record binds}
 424 %*                                                                      *
 425 %************************************************************************
 426
 427 \begin{code}
 428 type HsRecordBinds id = [(id, HsExpr id)]
 429
 430 recBindFields :: HsRecordBinds id -> [id]
 431 recBindFields rbinds = [field | (field,_) <- rbinds]
 432
 433 pp_rbinds :: OutputableBndr id => SDoc -> HsRecordBinds id -> SDoc
 434
 435 pp_rbinds thing rbinds
 436   = hang thing
 437          4 (braces (sep (punctuate comma (map (pp_rbind) rbinds))))
 438   where
 439     pp_rbind (v, e) = hsep [pprBndr LetBind v, char '=', ppr e]
 440 \end{code}
 441
 442
 443
 444 %************************************************************************
 445 %*                                                                      *
 446 \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
 447 %*                                                                      *
 448 %************************************************************************
 449
 450 @Match@es are sets of pattern bindings and right hand sides for
 451 functions, patterns or case branches. For example, if a function @g@
 452 is defined as:
 453 \begin{verbatim}
 454 g (x,y) = y
 455 g ((x:ys),y) = y+1,
 456 \end{verbatim}
 457 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
 458
 459 It is always the case that each element of an @[Match]@ list has the
 460 same number of @pats@s inside it.  This corresponds to saying that
 461 a function defined by pattern matching must have the same number of
 462 patterns in each equation.
 463
 464 \begin{code}
 465 data Match id
 466   = Match
 467         [Pat id]                -- The patterns
 468         (Maybe (HsType id))     -- A type signature for the result of the match
 469                                 --      Nothing after typechecking
 470
 471         (GRHSs id)
 472
 473 -- GRHSs are used both for pattern bindings and for Matches
 474 data GRHSs id
 475   = GRHSs [GRHS id]             -- Guarded RHSs
 476           (HsBinds id)          -- The where clause
 477           PostTcType            -- Type of RHS (after type checking)
 478
 479 data GRHS id
 480   = GRHS  [Stmt id]             -- The RHS is the final ResultStmt
 481           SrcLoc
 482
 483 mkSimpleMatch :: [Pat id] -> HsExpr id -> Type -> SrcLoc -> Match id
 484 mkSimpleMatch pats rhs rhs_ty locn
 485   = Match pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds rhs_ty)
 486
 487 unguardedRHS :: HsExpr id -> SrcLoc -> [GRHS id]
 488 unguardedRHS rhs loc = [GRHS [ResultStmt rhs loc] loc]
 489 \end{code}
 490
 491 @getMatchLoc@ takes a @Match@ and returns the
 492 source-location gotten from the GRHS inside.
 493 THis is something of a nuisance, but no more.
 494
 495 \begin{code}
 496 getMatchLoc :: Match id -> SrcLoc
 497 getMatchLoc (Match _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
 498 \end{code}
 499
 500 We know the list must have at least one @Match@ in it.
 501
 502 \begin{code}
 503 pprMatches :: (OutputableBndr id) => HsMatchContext id -> [Match id] -> SDoc
 504 pprMatches ctxt matches = vcat (map (pprMatch ctxt) matches)
 505
 506 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 507 pprFunBind :: (OutputableBndr id) => id -> [Match id] -> SDoc
 508 pprFunBind fun matches = pprMatches (FunRhs fun) matches
 509
 510 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 511 pprPatBind :: (OutputableBndr id)
 512            => Pat id -> GRHSs id -> SDoc
 513 pprPatBind pat grhss = sep [ppr pat, nest 4 (pprGRHSs PatBindRhs grhss)]
 514
 515
 516 pprMatch :: OutputableBndr id => HsMatchContext id -> Match id -> SDoc
 517 pprMatch ctxt (Match pats maybe_ty grhss)
 518   = pp_name ctxt <+> sep [sep (map ppr pats),
 519                      ppr_maybe_ty,
 520                      nest 2 (pprGRHSs ctxt grhss)]
 521   where
 522     pp_name (FunRhs fun) = ppr fun      -- Not pprBndr; the AbsBinds will
 523                                         -- have printed the signature
 524     pp_name LambdaExpr   = char '\\'
 525     pp_name other        = empty
 526
 527     ppr_maybe_ty = case maybe_ty of
 528                         Just ty -> dcolon <+> ppr ty
 529                         Nothing -> empty
 530
 531
 532 pprGRHSs :: OutputableBndr id => HsMatchContext id -> GRHSs id -> SDoc
 533 pprGRHSs ctxt (GRHSs grhss binds ty)
 534   = vcat (map (pprGRHS ctxt) grhss)
 535     $$
 536     (if nullBinds binds then empty
 537      else text "where" $$ nest 4 (pprDeeper (ppr binds)))
 538
 539
 540 pprGRHS :: OutputableBndr id => HsMatchContext id -> GRHS id -> SDoc
 541
 542 pprGRHS ctxt (GRHS [ResultStmt expr _] locn)
 543  =  pp_rhs ctxt expr
 544
 545 pprGRHS ctxt (GRHS guarded locn)
 546  = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
 547  where
 548     ResultStmt expr _ = last guarded    -- Last stmt should be a ResultStmt for guards
 549     guards            = init guarded
 550
 551 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
 552 \end{code}
 553
 554
 555
 556 %************************************************************************
 557 %*                                                                      *
 558 \subsection{Do stmts and list comprehensions}
 559 %*                                                                      *
 560 %************************************************************************
 561
 562 \begin{code}
 563 data Stmt id
 564   = BindStmt    (Pat id) (HsExpr id) SrcLoc
 565   | LetStmt     (HsBinds id)
 566   | ResultStmt  (HsExpr id)     SrcLoc                  -- See notes that follow
 567   | ExprStmt    (HsExpr id)     PostTcType SrcLoc       -- See notes that follow
 568         -- The type is the *element type* of the expression
 569
 570         -- ParStmts only occur in a list comprehension
 571   | ParStmt     [[Stmt id]]             -- List comp only: parallel set of quals
 572   | ParStmtOut  [([id], [Stmt id])]     -- PLC after renaming; the ids are the binders
 573                                         -- bound by the stmts
 574
 575         -- mdo-notation (only exists after renamer)
 576         -- The ids are a subset of the variables bound by the stmts that
 577         -- either (a) are used before they are bound in the stmts
 578         -- or     (b) are used in stmts that follow the RecStmt
 579   | RecStmt  [id]
 580              [Stmt id]
 581              [HsExpr id]        -- Post type-checking only; these expressions correspond
 582                                 -- 1-to-1 with the [id], and are the expresions that should
 583                                 -- be returned by the recursion.  They may not quite be the
 584                                 -- Ids themselves, because the Id may be polymorphic, but
 585                                 -- the returned thing has to be monomorphic.
 586 \end{code}
 587
 588 ExprStmts and ResultStmts are a bit tricky, because what they mean
 589 depends on the context.  Consider the following contexts:
 590
 591         A do expression of type (m res_ty)
 592         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 593         * ExprStmt E any_ty:   do { ....; E; ... }
 594                 E :: m any_ty
 595           Translation: E >> ...
 596
 597         * ResultStmt E:   do { ....; E }
 598                 E :: m res_ty
 599           Translation: E
 600
 601         A list comprehensions of type [elt_ty]
 602         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 603         * ExprStmt E Bool:   [ .. | .... E ]
 604                         [ .. | ..., E, ... ]
 605                         [ .. | .... | ..., E | ... ]
 606                 E :: Bool
 607           Translation: if E then fail else ...
 608
 609         * ResultStmt E:   [ E | ... ]
 610                 E :: elt_ty
 611           Translation: return E
 612
 613         A guard list, guarding a RHS of type rhs_ty
 614         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 615         * ExprStmt E Bool:   f x | ..., E, ... = ...rhs...
 616                 E :: Bool
 617           Translation: if E then fail else ...
 618
 619         * ResultStmt E:   f x | ...guards... = E
 620                 E :: rhs_ty
 621           Translation: E
 622
 623 Array comprehensions are handled like list comprehensions -=chak
 624
 625 \begin{code}
 626 consLetStmt :: HsBinds id -> [Stmt id] -> [Stmt id]
 627 consLetStmt EmptyBinds stmts = stmts
 628 consLetStmt binds      stmts = LetStmt binds : stmts
 629 \end{code}
 630
 631 \begin{code}
 632 instance OutputableBndr id => Outputable (Stmt id) where
 633     ppr stmt = pprStmt stmt
 634
 635 pprStmt (BindStmt pat expr _) = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
 636 pprStmt (LetStmt binds)       = hsep [ptext SLIT("let"), pprBinds binds]
 637 pprStmt (ExprStmt expr _ _)   = ppr expr
 638 pprStmt (ResultStmt expr _)   = ppr expr
 639 pprStmt (ParStmt stmtss)
 640  = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
 641 pprStmt (ParStmtOut stmtss)
 642  = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
 643 pprStmt (RecStmt _ segment _) = vcat (map ppr segment)
 644
 645 pprDo :: OutputableBndr id => HsStmtContext any -> [Stmt id] -> SDoc
 646 pprDo DoExpr stmts   = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts))
 647 pprDo MDoExpr stmts  = hang (ptext SLIT("mdo")) 3 (vcat (map ppr stmts))
 648 pprDo ListComp stmts = pprComp brackets   stmts
 649 pprDo PArrComp stmts = pprComp pa_brackets stmts
 650
 651 pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [Stmt id] -> SDoc
 652 pprComp brack stmts = brack $
 653                       hang (pprExpr expr <+> char '|')
 654                          4 (interpp'SP quals)
 655                     where
 656                       ResultStmt expr _ = last stmts  -- Last stmt should
 657                       quals             = init stmts  -- be an ResultStmt
 658 \end{code}
 659
 660 %************************************************************************
 661 %*                                                                      *
 662                 Template Haskell quotation brackets
 663 %*                                                                      *
 664 %************************************************************************
 665
 666 \begin{code}
 667 data HsBracket id = ExpBr (HsExpr id)
 668                   | PatBr (Pat id)
 669                   | DecBr (HsGroup id)
 670                   | TypBr (HsType id)
 671
 672 instance OutputableBndr id => Outputable (HsBracket id) where
 673   ppr = pprHsBracket
 674
 675
 676 pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
 677 pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
 678 pprHsBracket (DecBr d) = thBrackets (char 'd') (ppr d)
 679 pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
 680
 681
 682 thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
 683                              pp_body <+> ptext SLIT("|]")
 684
 685 data HsReify id = Reify    ReifyFlavour id      -- Pre typechecking
 686                 | ReifyOut ReifyFlavour Name    -- Post typechecking
 687                                                 -- The Name could be the name of
 688                                                 -- an Id, TyCon, or Class
 689
 690 data ReifyFlavour = ReifyDecl | ReifyType | ReifyFixity
 691
 692 instance Outputable id => Outputable (HsReify id) where
 693    ppr (Reify flavour id) = ppr flavour <+> ppr id
 694    ppr (ReifyOut flavour thing) = ppr flavour <+> ppr thing
 695
 696 instance Outputable ReifyFlavour where
 697    ppr ReifyDecl   = ptext SLIT("reifyDecl")
 698    ppr ReifyType   = ptext SLIT("reifyType")
 699    ppr ReifyFixity = ptext SLIT("reifyFixity")
 700 \end{code}
 701
 702 %************************************************************************
 703 %*                                                                      *
 704 \subsection{Enumerations and list comprehensions}
 705 %*                                                                      *
 706 %************************************************************************
 707
 708 \begin{code}
 709 data ArithSeqInfo id
 710   = From            (HsExpr id)
 711   | FromThen        (HsExpr id)
 712                     (HsExpr id)
 713   | FromTo          (HsExpr id)
 714                     (HsExpr id)
 715   | FromThenTo      (HsExpr id)
 716                     (HsExpr id)
 717                     (HsExpr id)
 718 \end{code}
 719
 720 \begin{code}
 721 instance OutputableBndr id => Outputable (ArithSeqInfo id) where
 722     ppr (From e1)               = hcat [ppr e1, pp_dotdot]
 723     ppr (FromThen e1 e2)        = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
 724     ppr (FromTo e1 e3)  = hcat [ppr e1, pp_dotdot, ppr e3]
 725     ppr (FromThenTo e1 e2 e3)
 726       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
 727
 728 pp_dotdot = ptext SLIT(" .. ")
 729 \end{code}
 730
 731
 732 %************************************************************************
 733 %*                                                                      *
 734 \subsection{HsMatchCtxt}
 735 %*                                                                      *
 736 %************************************************************************
 737
 738 \begin{code}
 739 data HsMatchContext id  -- Context of a Match
 740   = FunRhs id                   -- Function binding for f
 741   | CaseAlt                     -- Guard on a case alternative
 742   | LambdaExpr                  -- Pattern of a lambda
 743   | PatBindRhs                  -- Pattern binding
 744   | RecUpd                      -- Record update [used only in DsExpr to tell matchWrapper
 745                                 --      what sort of runtime error message to generate]
 746   | StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
 747   deriving ()
 748
 749 data HsStmtContext id
 750   = ListComp
 751   | DoExpr
 752   | MDoExpr                             -- Recursive do-expression
 753   | PArrComp                            -- Parallel array comprehension
 754   | PatGuard (HsMatchContext id)        -- Pattern guard for specified thing
 755   | ParStmtCtxt (HsStmtContext id)      -- A branch of a parallel stmt
 756 \end{code}
 757
 758 \begin{code}
 759 isDoExpr :: HsStmtContext id -> Bool
 760 isDoExpr DoExpr  = True
 761 isDoExpr MDoExpr = True
 762 isDoExpr other   = False
 763 \end{code}
 764
 765 \begin{code}
 766 matchSeparator (FunRhs _)   = ptext SLIT("=")
 767 matchSeparator CaseAlt      = ptext SLIT("->")
 768 matchSeparator LambdaExpr   = ptext SLIT("->")
 769 matchSeparator PatBindRhs   = ptext SLIT("=")
 770 matchSeparator (StmtCtxt _) = ptext SLIT("<-")
 771 matchSeparator RecUpd       = panic "unused"
 772 \end{code}
 773
 774 \begin{code}
 775 pprMatchContext (FunRhs fun)      = ptext SLIT("the definition of") <+> quotes (ppr fun)
 776 pprMatchContext CaseAlt           = ptext SLIT("a case alternative")
 777 pprMatchContext RecUpd            = ptext SLIT("a record-update construct")
 778 pprMatchContext PatBindRhs        = ptext SLIT("a pattern binding")
 779 pprMatchContext LambdaExpr        = ptext SLIT("a lambda abstraction")
 780 pprMatchContext (StmtCtxt ctxt)   = ptext SLIT("a pattern binding in") $$ pprStmtContext ctxt
 781
 782 pprMatchRhsContext (FunRhs fun) = ptext SLIT("a right-hand side of function") <+> quotes (ppr fun)
 783 pprMatchRhsContext CaseAlt      = ptext SLIT("the body of a case alternative")
 784 pprMatchRhsContext PatBindRhs   = ptext SLIT("the right-hand side of a pattern binding")
 785 pprMatchRhsContext LambdaExpr   = ptext SLIT("the body of a lambda")
 786 pprMatchRhsContext RecUpd       = panic "pprMatchRhsContext"
 787
 788 pprStmtContext (ParStmtCtxt c) = sep [ptext SLIT("a parallel branch of"), pprStmtContext c]
 789 pprStmtContext (PatGuard ctxt) = ptext SLIT("a pattern guard for") $$ pprMatchContext ctxt
 790 pprStmtContext DoExpr          = ptext SLIT("a 'do' expression")
 791 pprStmtContext MDoExpr         = ptext SLIT("an 'mdo' expression")
 792 pprStmtContext ListComp        = ptext SLIT("a list comprehension")
 793 pprStmtContext PArrComp        = ptext SLIT("an array comprehension")
 794
 795 -- Used for the result statement of comprehension
 796 -- e.g. the 'e' in      [ e | ... ]
 797 --      or the 'r' in   f x = r
 798 pprStmtResultContext (PatGuard ctxt) = pprMatchRhsContext ctxt
 799 pprStmtResultContext other           = ptext SLIT("the result of") <+> pprStmtContext other
 800
 801
 802 -- Used to generate the string for a *runtime* error message
 803 matchContextErrString (FunRhs fun)               = "function " ++ showSDoc (ppr fun)
 804 matchContextErrString CaseAlt                    = "case"
 805 matchContextErrString PatBindRhs                 = "pattern binding"
 806 matchContextErrString RecUpd                     = "record update"
 807 matchContextErrString LambdaExpr                 = "lambda"
 808 matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
 809 matchContextErrString (StmtCtxt (PatGuard _))    = "pattern guard"
 810 matchContextErrString (StmtCtxt DoExpr)          = "'do' expression"
 811 matchContextErrString (StmtCtxt MDoExpr)         = "'mdo' expression"
 812 matchContextErrString (StmtCtxt ListComp)        = "list comprehension"
 813 matchContextErrString (StmtCtxt PArrComp)        = "array comprehension"
 814 \end{code}