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