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