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(..), HsConDetails(..) )
  15 import HsLit            ( HsLit(..), HsOverLit )
  16 import HsTypes          ( HsType, PostTcType, SyntaxName, placeHolderType )
  17 import HsImpExp         ( isOperator, pprHsVar )
  18
  19 -- others:
  20 import PprType          ( pprParendType )
  21 import Type             ( Type )
  22 import Var              ( TyVar, Id )
  23 import Name             ( Name )
  24 import DataCon          ( DataCon )
  25 import BasicTypes       ( IPName, Boxity, tupleParens, Fixity(..) )
  26 import SrcLoc           ( SrcLoc, generatedSrcLoc )
  27 import Outputable
  28 import FastString
  29 \end{code}
  30
  31
  32 %************************************************************************
  33 %*                                                                      *
  34         Some useful helpers for constructing expressions
  35 %*                                                                      *
  36 %************************************************************************
  37
  38 \begin{code}
  39 mkHsApps    f xs = foldl HsApp (HsVar f) xs
  40 mkHsVarApps f xs = foldl HsApp (HsVar f) (map HsVar xs)
  41
  42 mkHsIntLit n = HsLit (HsInt n)
  43 mkHsString s = HsString (mkFastString s)
  44
  45 mkConPat con vars   = ConPatIn con (PrefixCon (map VarPat vars))
  46 mkNullaryConPat con = ConPatIn con (PrefixCon [])
  47
  48 mkSimpleHsAlt :: Pat id -> HsExpr id -> Match id
  49 -- A simple lambda with a single pattern, no binds, no guards; pre-typechecking
  50 mkSimpleHsAlt pat expr
  51   = mkSimpleMatch [pat] expr placeHolderType generatedSrcLoc
  52
  53 mkSimpleMatch :: [Pat id] -> HsExpr id -> Type -> SrcLoc -> Match id
  54 mkSimpleMatch pats rhs rhs_ty locn
  55   = Match pats Nothing (GRHSs (unguardedRHS rhs locn) EmptyBinds rhs_ty)
  56
  57 unguardedRHS :: HsExpr id -> SrcLoc -> [GRHS id]
  58 unguardedRHS rhs loc = [GRHS [ResultStmt rhs loc] loc]
  59
  60 glueBindsOnGRHSs :: HsBinds id -> GRHSs id -> GRHSs id
  61 glueBindsOnGRHSs EmptyBinds grhss = grhss
  62 glueBindsOnGRHSs binds1 (GRHSs grhss binds2 ty)
  63   = GRHSs grhss (binds1 `ThenBinds` binds2) ty
  64 \end{code}
  65
  66
  67 %************************************************************************
  68 %*                                                                      *
  69 \subsection{Expressions proper}
  70 %*                                                                      *
  71 %************************************************************************
  72
  73 \begin{code}
  74 data HsExpr id
  75   = HsVar       id              -- variable
  76   | HsIPVar     (IPName id)     -- implicit parameter
  77   | HsOverLit   HsOverLit       -- Overloaded literals; eliminated by type checker
  78   | HsLit       HsLit           -- Simple (non-overloaded) literals
  79
  80   | HsLam       (Match  id)     -- lambda
  81   | HsApp       (HsExpr id)     -- application
  82                 (HsExpr id)
  83
  84   -- Operator applications:
  85   -- NB Bracketed ops such as (+) come out as Vars.
  86
  87   -- NB We need an expr for the operator in an OpApp/Section since
  88   -- the typechecker may need to apply the operator to a few types.
  89
  90   | OpApp       (HsExpr id)     -- left operand
  91                 (HsExpr id)     -- operator
  92                 Fixity          -- Renamer adds fixity; bottom until then
  93                 (HsExpr id)     -- right operand
  94
  95   -- We preserve prefix negation and parenthesis for the precedence parser.
  96   -- They are eventually removed by the type checker.
  97
  98   | NegApp      (HsExpr id)     -- negated expr
  99                 SyntaxName      -- Name of 'negate' (see RnEnv.lookupSyntaxName)
 100
 101   | HsPar       (HsExpr id)     -- parenthesised expr
 102
 103   | SectionL    (HsExpr id)     -- operand
 104                 (HsExpr id)     -- operator
 105   | SectionR    (HsExpr id)     -- operator
 106                 (HsExpr id)     -- operand
 107
 108   | HsCase      (HsExpr id)
 109                 [Match id]
 110                 SrcLoc
 111
 112   | HsIf        (HsExpr id)     --  predicate
 113                 (HsExpr id)     --  then part
 114                 (HsExpr id)     --  else part
 115                 SrcLoc
 116
 117   | HsLet       (HsBinds id)    -- let(rec)
 118                 (HsExpr  id)
 119
 120   | HsDo        (HsStmtContext Name)    -- The parameterisation is unimportant
 121                                         -- because in this context we never use
 122                                         -- the PatGuard or ParStmt variant
 123                 [Stmt id]               -- "do":one or more stmts
 124                 (ReboundNames id)       -- Ids for [return,fail,>>=,>>]
 125                         PostTcType      -- Type of the whole expression
 126                 SrcLoc
 127
 128   | ExplicitList                -- syntactic list
 129                 PostTcType      -- Gives type of components of list
 130                 [HsExpr id]
 131
 132   | ExplicitPArr                -- syntactic parallel array: [:e1, ..., en:]
 133                 PostTcType      -- type of elements of the parallel array
 134                 [HsExpr id]
 135
 136   | ExplicitTuple               -- tuple
 137                 [HsExpr id]
 138                                 -- NB: Unit is ExplicitTuple []
 139                                 -- for tuples, we can get the types
 140                                 -- direct from the components
 141                 Boxity
 142
 143
 144         -- Record construction
 145   | RecordCon   id                              -- The constructor
 146                 (HsRecordBinds id)
 147
 148   | RecordConOut DataCon
 149                 (HsExpr id)             -- Data con Id applied to type args
 150                 (HsRecordBinds id)
 151
 152
 153         -- Record update
 154   | RecordUpd   (HsExpr id)
 155                 (HsRecordBinds id)
 156
 157   | RecordUpdOut (HsExpr id)    -- TRANSLATION
 158                  Type                   -- Type of *input* record
 159                  Type                   -- Type of *result* record (may differ from
 160                                         --      type of input record)
 161                  (HsRecordBinds id)
 162
 163   | ExprWithTySig                       -- signature binding
 164                 (HsExpr id)
 165                 (HsType id)
 166   | ArithSeqIn                          -- arithmetic sequence
 167                 (ArithSeqInfo id)
 168   | ArithSeqOut
 169                 (HsExpr id)             -- (typechecked, of course)
 170                 (ArithSeqInfo id)
 171   | PArrSeqIn                           -- arith. sequence for parallel array
 172                 (ArithSeqInfo id)       -- [:e1..e2:] or [:e1, e2..e3:]
 173   | PArrSeqOut
 174                 (HsExpr id)             -- (typechecked, of course)
 175                 (ArithSeqInfo id)
 176
 177   | HsSCC       FastString      -- "set cost centre" (_scc_) annotation
 178                 (HsExpr id)     -- expr whose cost is to be measured
 179
 180   | HsCoreAnn   FastString      -- hdaume: core annotation
 181                 (HsExpr id)
 182
 183   -----------------------------------------------------------
 184   -- MetaHaskell Extensions
 185   | HsBracket    (HsBracket id) SrcLoc
 186
 187   | HsBracketOut (HsBracket Name)       -- Output of the type checker is the *original*
 188                  [PendingSplice]        -- renamed expression, plus *typechecked* splices
 189                                         -- to be pasted back in by the desugarer
 190
 191   | HsSplice id (HsExpr id) SrcLoc      -- $z  or $(f 4)
 192                                         -- The id is just a unique name to
 193                                         -- identify this splice point
 194
 195   | HsReify (HsReify id)                -- reifyType t, reifyDecl i, reifyFixity
 196
 197   -----------------------------------------------------------
 198   -- Arrow notation extension
 199
 200   | HsProc      (Pat id)                -- arrow abstraction, proc
 201                 (HsCmdTop id)           -- body of the abstraction
 202                                         -- always has an empty stack
 203                 SrcLoc
 204
 205   ---------------------------------------
 206   -- The following are commands, not expressions proper
 207
 208   | HsArrApp    -- Arrow tail, or arrow application (f -< arg)
 209         (HsExpr id)     -- arrow expression, f
 210         (HsExpr id)     -- input expression, arg
 211         PostTcType      -- type of the arrow expressions f,
 212                         -- of the form a t t', where arg :: t
 213         HsArrAppType    -- higher-order (-<<) or first-order (-<)
 214         Bool            -- True => right-to-left (f -< arg)
 215                         -- False => left-to-right (arg >- f)
 216         SrcLoc
 217
 218   | HsArrForm   -- Command formation,  (| e cmd1 .. cmdn |)
 219         (HsExpr id)     -- the operator
 220                         -- after type-checking, a type abstraction to be
 221                         -- applied to the type of the local environment tuple
 222         (Maybe Fixity)  -- fixity (filled in by the renamer), for forms that
 223                         -- were converted from OpApp's by the renamer
 224         [HsCmdTop id]   -- argument commands
 225         SrcLoc
 226
 227 \end{code}
 228
 229
 230 These constructors only appear temporarily in the parser.
 231 The renamer translates them into the Right Thing.
 232
 233 \begin{code}
 234   | EWildPat                    -- wildcard
 235
 236   | EAsPat      id              -- as pattern
 237                 (HsExpr id)
 238
 239   | ELazyPat    (HsExpr id) -- ~ pattern
 240
 241   | HsType      (HsType id)     -- Explicit type argument; e.g  f {| Int |} x y
 242 \end{code}
 243
 244 Everything from here on appears only in typechecker output.
 245
 246 \begin{code}
 247   | TyLam                       -- TRANSLATION
 248                 [TyVar]
 249                 (HsExpr id)
 250   | TyApp                       -- TRANSLATION
 251                 (HsExpr id) -- generated by Spec
 252                 [Type]
 253
 254   -- DictLam and DictApp are "inverses"
 255   |  DictLam
 256                 [id]
 257                 (HsExpr id)
 258   |  DictApp
 259                 (HsExpr id)
 260                 [id]
 261
 262 type PendingSplice = (Name, HsExpr Id)  -- Typechecked splices, waiting to be
 263                                         -- pasted back in by the desugarer
 264 \end{code}
 265
 266 Table of bindings of names used in rebindable syntax.
 267 This gets filled in by the renamer.
 268
 269 \begin{code}
 270 type ReboundNames id = [(Name, HsExpr id)]
 271 -- * Before the renamer, this list is empty
 272 --
 273 -- * After the renamer, it takes the form [(std_name, HsVar actual_name)]
 274 --   For example, for the 'return' op of a monad
 275 --      normal case:            (GHC.Base.return, HsVar GHC.Base.return)
 276 --      with rebindable syntax: (GHC.Base.return, return_22)
 277 --              where return_22 is whatever "return" is in scope
 278 --
 279 -- * After the type checker, it takes the form [(std_name, <expression>)]
 280 --      where <expression> is the evidence for the method
 281 \end{code}
 282
 283 A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
 284 @ClassDictLam dictvars methods expr@ is, therefore:
 285 \begin{verbatim}
 286 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
 287 \end{verbatim}
 288
 289 \begin{code}
 290 instance OutputableBndr id => Outputable (HsExpr id) where
 291     ppr expr = pprExpr expr
 292 \end{code}
 293
 294 \begin{code}
 295 pprExpr :: OutputableBndr id => HsExpr id -> SDoc
 296
 297 pprExpr  e = pprDeeper (ppr_expr e)
 298 pprBinds b = pprDeeper (ppr b)
 299
 300 ppr_expr (HsVar v)       = pprHsVar v
 301 ppr_expr (HsIPVar v)     = ppr v
 302 ppr_expr (HsLit lit)     = ppr lit
 303 ppr_expr (HsOverLit lit) = ppr lit
 304
 305 ppr_expr (HsLam match) = pprMatch LambdaExpr match
 306
 307 ppr_expr expr@(HsApp e1 e2)
 308   = let (fun, args) = collect_args expr [] in
 309     (ppr_expr fun) <+> (sep (map pprParendExpr args))
 310   where
 311     collect_args (HsApp fun arg) args = collect_args fun (arg:args)
 312     collect_args fun             args = (fun, args)
 313
 314 ppr_expr (OpApp e1 op fixity e2)
 315   = case op of
 316       HsVar v -> pp_infixly v
 317       _       -> pp_prefixly
 318   where
 319     pp_e1 = pprParendExpr e1            -- Add parens to make precedence clear
 320     pp_e2 = pprParendExpr e2
 321
 322     pp_prefixly
 323       = hang (ppr_expr op) 4 (sep [pp_e1, pp_e2])
 324
 325     pp_infixly v
 326       = sep [pp_e1, hsep [pprInfix v, pp_e2]]
 327
 328 ppr_expr (NegApp e _) = char '-' <+> pprParendExpr e
 329
 330 ppr_expr (HsPar e) = parens (ppr_expr e)
 331
 332 ppr_expr (SectionL expr op)
 333   = case op of
 334       HsVar v -> pp_infixly v
 335       _       -> pp_prefixly
 336   where
 337     pp_expr = pprParendExpr expr
 338
 339     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
 340                        4 (hsep [pp_expr, ptext SLIT("x_ )")])
 341     pp_infixly v = parens (sep [pp_expr, ppr v])
 342
 343 ppr_expr (SectionR op expr)
 344   = case op of
 345       HsVar v -> pp_infixly v
 346       _       -> pp_prefixly
 347   where
 348     pp_expr = pprParendExpr expr
 349
 350     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext SLIT("x_")])
 351                        4 ((<>) pp_expr rparen)
 352     pp_infixly v
 353       = parens (sep [ppr v, pp_expr])
 354
 355 ppr_expr (HsCase expr matches _)
 356   = sep [ sep [ptext SLIT("case"), nest 4 (pprExpr expr), ptext SLIT("of")],
 357             nest 2 (pprMatches CaseAlt matches) ]
 358
 359 ppr_expr (HsIf e1 e2 e3 _)
 360   = sep [hsep [ptext SLIT("if"), nest 2 (pprExpr e1), ptext SLIT("then")],
 361            nest 4 (pprExpr e2),
 362            ptext SLIT("else"),
 363            nest 4 (pprExpr e3)]
 364
 365 -- special case: let ... in let ...
 366 ppr_expr (HsLet binds expr@(HsLet _ _))
 367   = sep [hang (ptext SLIT("let")) 2 (hsep [pprBinds binds, ptext SLIT("in")]),
 368          ppr_expr expr]
 369
 370 ppr_expr (HsLet binds expr)
 371   = sep [hang (ptext SLIT("let")) 2 (pprBinds binds),
 372          hang (ptext SLIT("in"))  2 (ppr expr)]
 373
 374 ppr_expr (HsDo do_or_list_comp stmts _ _ _) = pprDo do_or_list_comp stmts
 375
 376 ppr_expr (ExplicitList _ exprs)
 377   = brackets (fsep (punctuate comma (map ppr_expr exprs)))
 378
 379 ppr_expr (ExplicitPArr _ exprs)
 380   = pa_brackets (fsep (punctuate comma (map ppr_expr exprs)))
 381
 382 ppr_expr (ExplicitTuple exprs boxity)
 383   = tupleParens boxity (sep (punctuate comma (map ppr_expr exprs)))
 384
 385 ppr_expr (RecordCon con_id rbinds)
 386   = pp_rbinds (ppr con_id) rbinds
 387 ppr_expr (RecordConOut data_con con rbinds)
 388   = pp_rbinds (ppr con) rbinds
 389
 390 ppr_expr (RecordUpd aexp rbinds)
 391   = pp_rbinds (pprParendExpr aexp) rbinds
 392 ppr_expr (RecordUpdOut aexp _ _ rbinds)
 393   = pp_rbinds (pprParendExpr aexp) rbinds
 394
 395 ppr_expr (ExprWithTySig expr sig)
 396   = hang (nest 2 (ppr_expr expr) <+> dcolon)
 397          4 (ppr sig)
 398
 399 ppr_expr (ArithSeqIn info)
 400   = brackets (ppr info)
 401 ppr_expr (ArithSeqOut expr info)
 402   = brackets (ppr info)
 403
 404 ppr_expr (PArrSeqIn info)
 405   = pa_brackets (ppr info)
 406 ppr_expr (PArrSeqOut expr info)
 407   = pa_brackets (ppr info)
 408
 409 ppr_expr EWildPat = char '_'
 410 ppr_expr (ELazyPat e) = char '~' <> pprParendExpr e
 411 ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e
 412
 413 ppr_expr (HsSCC lbl expr)
 414   = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ftext lbl), pprParendExpr expr ]
 415
 416 ppr_expr (TyLam tyvars expr)
 417   = hang (hsep [ptext SLIT("/\\"),
 418                 hsep (map (pprBndr LambdaBind) tyvars),
 419                 ptext SLIT("->")])
 420          4 (ppr_expr expr)
 421
 422 ppr_expr (TyApp expr [ty])
 423   = hang (ppr_expr expr) 4 (pprParendType ty)
 424
 425 ppr_expr (TyApp expr tys)
 426   = hang (ppr_expr expr)
 427          4 (brackets (interpp'SP tys))
 428
 429 ppr_expr (DictLam dictvars expr)
 430   = hang (hsep [ptext SLIT("\\{-dict-}"),
 431                 hsep (map (pprBndr LambdaBind) dictvars),
 432                 ptext SLIT("->")])
 433          4 (ppr_expr expr)
 434
 435 ppr_expr (DictApp expr [dname])
 436   = hang (ppr_expr expr) 4 (ppr dname)
 437
 438 ppr_expr (DictApp expr dnames)
 439   = hang (ppr_expr expr)
 440          4 (brackets (interpp'SP dnames))
 441
 442 ppr_expr (HsType id) = ppr id
 443
 444 ppr_expr (HsSplice n e _)    = char '$' <> brackets (ppr n) <> pprParendExpr e
 445 ppr_expr (HsBracket b _)     = pprHsBracket b
 446 ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("where") <+> ppr ps
 447 ppr_expr (HsReify r)         = ppr r
 448
 449 ppr_expr (HsProc pat (HsCmdTop cmd _ _ _) _)
 450   = hsep [ptext SLIT("proc"), ppr pat, ptext SLIT("->"), pprExpr cmd]
 451
 452 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True _)
 453   = hsep [ppr_expr arrow, ptext SLIT("-<"), ppr_expr arg]
 454 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False _)
 455   = hsep [ppr_expr arg, ptext SLIT(">-"), ppr_expr arrow]
 456 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True _)
 457   = hsep [ppr_expr arrow, ptext SLIT("-<<"), ppr_expr arg]
 458 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False _)
 459   = hsep [ppr_expr arg, ptext SLIT(">>-"), ppr_expr arrow]
 460
 461 ppr_expr (HsArrForm (HsVar v) (Just _) [arg1, arg2] _)
 462   = sep [pprCmdArg arg1, hsep [pprInfix v, pprCmdArg arg2]]
 463 ppr_expr (HsArrForm op _ args _)
 464   = hang (ptext SLIT("(|") <> ppr_expr op)
 465          4 (sep (map pprCmdArg args) <> ptext SLIT("|)"))
 466
 467 pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
 468 pprCmdArg (HsCmdTop cmd@(HsArrForm _ Nothing [] _) _ _ _) = ppr_expr cmd
 469 pprCmdArg (HsCmdTop cmd _ _ _) = parens (ppr_expr cmd)
 470
 471 -- Put a var in backquotes if it's not an operator already
 472 pprInfix :: Outputable name => name -> SDoc
 473 pprInfix v | isOperator ppr_v = ppr_v
 474            | otherwise        = char '`' <> ppr_v <> char '`'
 475            where
 476              ppr_v = ppr v
 477
 478 -- add parallel array brackets around a document
 479 --
 480 pa_brackets :: SDoc -> SDoc
 481 pa_brackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
 482 \end{code}
 483
 484 Parenthesize unless very simple:
 485 \begin{code}
 486 pprParendExpr :: OutputableBndr id => HsExpr id -> SDoc
 487
 488 pprParendExpr expr
 489   = let
 490         pp_as_was = ppr_expr expr
 491         -- Using ppr_expr here avoids the call to 'deeper'
 492         -- Not sure if that's always right.
 493     in
 494     case expr of
 495       HsLit l           -> ppr l
 496       HsOverLit l       -> ppr l
 497
 498       HsVar _           -> pp_as_was
 499       HsIPVar _         -> pp_as_was
 500       ExplicitList _ _  -> pp_as_was
 501       ExplicitPArr _ _  -> pp_as_was
 502       ExplicitTuple _ _ -> pp_as_was
 503       HsPar _           -> pp_as_was
 504
 505       _                 -> parens pp_as_was
 506 \end{code}
 507
 508 %************************************************************************
 509 %*                                                                      *
 510 \subsection{Commands (in arrow abstractions)}
 511 %*                                                                      *
 512 %************************************************************************
 513
 514 We re-use HsExpr to represent these.
 515
 516 \begin{code}
 517 type HsCmd id = HsExpr id
 518
 519 data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
 520 \end{code}
 521
 522 The legal constructors for commands are:
 523
 524   = HsArrApp ...                -- as above
 525
 526   | HsArrForm ...               -- as above
 527
 528   | HsApp       (HsCmd id)
 529                 (HsExpr id)
 530
 531   | HsLam       (Match  id)     -- kappa
 532
 533   -- the renamer turns this one into HsArrForm
 534   | OpApp       (HsExpr id)     -- left operand
 535                 (HsCmd id)      -- operator
 536                 Fixity          -- Renamer adds fixity; bottom until then
 537                 (HsCmd id)      -- right operand
 538
 539   | HsPar       (HsCmd id)      -- parenthesised command
 540
 541   | HsCase      (HsExpr id)
 542                 [Match id]      -- bodies are HsCmd's
 543                 SrcLoc
 544
 545   | HsIf        (HsExpr id)     --  predicate
 546                 (HsCmd id)      --  then part
 547                 (HsCmd id)      --  else part
 548                 SrcLoc
 549
 550   | HsLet       (HsBinds id)    -- let(rec)
 551                 (HsCmd  id)
 552
 553   | HsDo        (HsStmtContext Name)    -- The parameterisation is unimportant
 554                                         -- because in this context we never use
 555                                         -- the PatGuard or ParStmt variant
 556                 [Stmt id]       -- HsExpr's are really HsCmd's
 557                 (ReboundNames id)
 558                 PostTcType      -- Type of the whole expression
 559                 SrcLoc
 560
 561 Top-level command, introducing a new arrow.
 562 This may occur inside a proc (where the stack is empty) or as an
 563 argument of a command-forming operator.
 564
 565 \begin{code}
 566 data HsCmdTop id
 567   = HsCmdTop    (HsCmd id)
 568                 [PostTcType]    -- types of inputs on the command's stack
 569                 PostTcType      -- return type of the command
 570                 (ReboundNames id)
 571                                 -- after type checking:
 572                                 -- names used in the command's desugaring
 573 \end{code}
 574
 575 %************************************************************************
 576 %*                                                                      *
 577 \subsection{Record binds}
 578 %*                                                                      *
 579 %************************************************************************
 580
 581 \begin{code}
 582 type HsRecordBinds id = [(id, HsExpr id)]
 583
 584 recBindFields :: HsRecordBinds id -> [id]
 585 recBindFields rbinds = [field | (field,_) <- rbinds]
 586
 587 pp_rbinds :: OutputableBndr id => SDoc -> HsRecordBinds id -> SDoc
 588
 589 pp_rbinds thing rbinds
 590   = hang thing
 591          4 (braces (sep (punctuate comma (map (pp_rbind) rbinds))))
 592   where
 593     pp_rbind (v, e) = hsep [pprBndr LetBind v, char '=', ppr e]
 594 \end{code}
 595
 596
 597
 598 %************************************************************************
 599 %*                                                                      *
 600 \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
 601 %*                                                                      *
 602 %************************************************************************
 603
 604 @Match@es are sets of pattern bindings and right hand sides for
 605 functions, patterns or case branches. For example, if a function @g@
 606 is defined as:
 607 \begin{verbatim}
 608 g (x,y) = y
 609 g ((x:ys),y) = y+1,
 610 \end{verbatim}
 611 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
 612
 613 It is always the case that each element of an @[Match]@ list has the
 614 same number of @pats@s inside it.  This corresponds to saying that
 615 a function defined by pattern matching must have the same number of
 616 patterns in each equation.
 617
 618 \begin{code}
 619 data Match id
 620   = Match
 621         [Pat id]                -- The patterns
 622         (Maybe (HsType id))     -- A type signature for the result of the match
 623                                 --      Nothing after typechecking
 624
 625         (GRHSs id)
 626
 627 -- GRHSs are used both for pattern bindings and for Matches
 628 data GRHSs id
 629   = GRHSs [GRHS id]             -- Guarded RHSs
 630           (HsBinds id)          -- The where clause
 631           PostTcType            -- Type of RHS (after type checking)
 632
 633 data GRHS id
 634   = GRHS  [Stmt id]             -- The RHS is the final ResultStmt
 635           SrcLoc
 636 \end{code}
 637
 638 @getMatchLoc@ takes a @Match@ and returns the
 639 source-location gotten from the GRHS inside.
 640 THis is something of a nuisance, but no more.
 641
 642 \begin{code}
 643 getMatchLoc :: Match id -> SrcLoc
 644 getMatchLoc (Match _ _ (GRHSs (GRHS _ loc : _) _ _)) = loc
 645 \end{code}
 646
 647 We know the list must have at least one @Match@ in it.
 648
 649 \begin{code}
 650 pprMatches :: (OutputableBndr id) => HsMatchContext id -> [Match id] -> SDoc
 651 pprMatches ctxt matches = vcat (map (pprMatch ctxt) matches)
 652
 653 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 654 pprFunBind :: (OutputableBndr id) => id -> [Match id] -> SDoc
 655 pprFunBind fun matches = pprMatches (FunRhs fun) matches
 656
 657 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 658 pprPatBind :: (OutputableBndr id)
 659            => Pat id -> GRHSs id -> SDoc
 660 pprPatBind pat grhss = sep [ppr pat, nest 4 (pprGRHSs PatBindRhs grhss)]
 661
 662
 663 pprMatch :: OutputableBndr id => HsMatchContext id -> Match id -> SDoc
 664 pprMatch ctxt (Match pats maybe_ty grhss)
 665   = pp_name ctxt <+> sep [sep (map ppr pats),
 666                      ppr_maybe_ty,
 667                      nest 2 (pprGRHSs ctxt grhss)]
 668   where
 669     pp_name (FunRhs fun) = ppr fun      -- Not pprBndr; the AbsBinds will
 670                                         -- have printed the signature
 671     pp_name LambdaExpr   = char '\\'
 672     pp_name other        = empty
 673
 674     ppr_maybe_ty = case maybe_ty of
 675                         Just ty -> dcolon <+> ppr ty
 676                         Nothing -> empty
 677
 678
 679 pprGRHSs :: OutputableBndr id => HsMatchContext id -> GRHSs id -> SDoc
 680 pprGRHSs ctxt (GRHSs grhss binds ty)
 681   = vcat (map (pprGRHS ctxt) grhss)
 682     $$
 683     (if nullBinds binds then empty
 684      else text "where" $$ nest 4 (pprDeeper (ppr binds)))
 685
 686
 687 pprGRHS :: OutputableBndr id => HsMatchContext id -> GRHS id -> SDoc
 688
 689 pprGRHS ctxt (GRHS [ResultStmt expr _] locn)
 690  =  pp_rhs ctxt expr
 691
 692 pprGRHS ctxt (GRHS guarded locn)
 693  = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
 694  where
 695     ResultStmt expr _ = last guarded    -- Last stmt should be a ResultStmt for guards
 696     guards            = init guarded
 697
 698 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
 699 \end{code}
 700
 701
 702
 703 %************************************************************************
 704 %*                                                                      *
 705 \subsection{Do stmts and list comprehensions}
 706 %*                                                                      *
 707 %************************************************************************
 708
 709 \begin{code}
 710 data Stmt id
 711   = BindStmt    (Pat id) (HsExpr id) SrcLoc
 712   | LetStmt     (HsBinds id)
 713   | ResultStmt  (HsExpr id)     SrcLoc                  -- See notes that follow
 714   | ExprStmt    (HsExpr id)     PostTcType SrcLoc       -- See notes that follow
 715         -- The type is the *element type* of the expression
 716
 717         -- ParStmts only occur in a list comprehension
 718   | ParStmt     [([Stmt id], [id])]     -- After remaing, the ids are the binders
 719                                         -- bound by the stmts and used subsequently
 720
 721         -- Recursive statement
 722   | RecStmt  [Stmt id]
 723                 --- The next two fields are only valid after renaming
 724              [id]       -- The ids are a subset of the variables bound by the stmts
 725                         -- that are used in stmts that follow the RecStmt
 726
 727              [id]       -- Ditto, but these variables are the "recursive" ones, that
 728                         -- are used before they are bound in the stmts of the RecStmt
 729                         -- From a type-checking point of view, these ones have to be monomorphic
 730
 731                 --- This field is only valid after typechecking
 732              [HsExpr id]        -- These expressions correspond
 733                                 -- 1-to-1 with the "recursive" [id], and are the expresions that
 734                                 -- should be returned by the recursion.  They may not quite be the
 735                                 -- Ids themselves, because the Id may be *polymorphic*, but
 736                                 -- the returned thing has to be *monomorphic*.
 737 \end{code}
 738
 739 ExprStmts and ResultStmts are a bit tricky, because what they mean
 740 depends on the context.  Consider the following contexts:
 741
 742         A do expression of type (m res_ty)
 743         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 744         * ExprStmt E any_ty:   do { ....; E; ... }
 745                 E :: m any_ty
 746           Translation: E >> ...
 747
 748         * ResultStmt E:   do { ....; E }
 749                 E :: m res_ty
 750           Translation: E
 751
 752         A list comprehensions of type [elt_ty]
 753         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 754         * ExprStmt E Bool:   [ .. | .... E ]
 755                         [ .. | ..., E, ... ]
 756                         [ .. | .... | ..., E | ... ]
 757                 E :: Bool
 758           Translation: if E then fail else ...
 759
 760         * ResultStmt E:   [ E | ... ]
 761                 E :: elt_ty
 762           Translation: return E
 763
 764         A guard list, guarding a RHS of type rhs_ty
 765         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 766         * ExprStmt E Bool:   f x | ..., E, ... = ...rhs...
 767                 E :: Bool
 768           Translation: if E then fail else ...
 769
 770         * ResultStmt E:   f x | ...guards... = E
 771                 E :: rhs_ty
 772           Translation: E
 773
 774 Array comprehensions are handled like list comprehensions -=chak
 775
 776 \begin{code}
 777 consLetStmt :: HsBinds id -> [Stmt id] -> [Stmt id]
 778 consLetStmt EmptyBinds stmts = stmts
 779 consLetStmt binds      stmts = LetStmt binds : stmts
 780 \end{code}
 781
 782 \begin{code}
 783 instance OutputableBndr id => Outputable (Stmt id) where
 784     ppr stmt = pprStmt stmt
 785
 786 pprStmt (BindStmt pat expr _)   = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
 787 pprStmt (LetStmt binds)         = hsep [ptext SLIT("let"), pprBinds binds]
 788 pprStmt (ExprStmt expr _ _)     = ppr expr
 789 pprStmt (ResultStmt expr _)     = ppr expr
 790 pprStmt (ParStmt stmtss)        = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
 791 pprStmt (RecStmt segment _ _ _) = ptext SLIT("rec") <+> braces (vcat (map ppr segment))
 792
 793 pprDo :: OutputableBndr id => HsStmtContext any -> [Stmt id] -> SDoc
 794 pprDo DoExpr stmts   = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts))
 795 pprDo MDoExpr stmts  = hang (ptext SLIT("mdo")) 3 (vcat (map ppr stmts))
 796 pprDo ListComp stmts = pprComp brackets   stmts
 797 pprDo PArrComp stmts = pprComp pa_brackets stmts
 798
 799 pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [Stmt id] -> SDoc
 800 pprComp brack stmts = brack $
 801                       hang (pprExpr expr <+> char '|')
 802                          4 (interpp'SP quals)
 803                     where
 804                       ResultStmt expr _ = last stmts  -- Last stmt should
 805                       quals             = init stmts  -- be an ResultStmt
 806 \end{code}
 807
 808 %************************************************************************
 809 %*                                                                      *
 810                 Template Haskell quotation brackets
 811 %*                                                                      *
 812 %************************************************************************
 813
 814 \begin{code}
 815 data HsBracket id = ExpBr (HsExpr id)
 816                   | PatBr (Pat id)
 817                   | DecBr (HsGroup id)
 818                   | TypBr (HsType id)
 819
 820 instance OutputableBndr id => Outputable (HsBracket id) where
 821   ppr = pprHsBracket
 822
 823
 824 pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
 825 pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
 826 pprHsBracket (DecBr d) = thBrackets (char 'd') (ppr d)
 827 pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
 828
 829
 830 thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
 831                              pp_body <+> ptext SLIT("|]")
 832
 833 data HsReify id = Reify    ReifyFlavour id      -- Pre typechecking
 834                 | ReifyOut ReifyFlavour Name    -- Post typechecking
 835                                                 -- The Name could be the name of
 836                                                 -- an Id, TyCon, or Class
 837
 838 data ReifyFlavour = ReifyDecl | ReifyType | ReifyFixity
 839
 840 instance Outputable id => Outputable (HsReify id) where
 841    ppr (Reify flavour id) = ppr flavour <+> ppr id
 842    ppr (ReifyOut flavour thing) = ppr flavour <+> ppr thing
 843
 844 instance Outputable ReifyFlavour where
 845    ppr ReifyDecl   = ptext SLIT("reifyDecl")
 846    ppr ReifyType   = ptext SLIT("reifyType")
 847    ppr ReifyFixity = ptext SLIT("reifyFixity")
 848 \end{code}
 849
 850 %************************************************************************
 851 %*                                                                      *
 852 \subsection{Enumerations and list comprehensions}
 853 %*                                                                      *
 854 %************************************************************************
 855
 856 \begin{code}
 857 data ArithSeqInfo id
 858   = From            (HsExpr id)
 859   | FromThen        (HsExpr id)
 860                     (HsExpr id)
 861   | FromTo          (HsExpr id)
 862                     (HsExpr id)
 863   | FromThenTo      (HsExpr id)
 864                     (HsExpr id)
 865                     (HsExpr id)
 866 \end{code}
 867
 868 \begin{code}
 869 instance OutputableBndr id => Outputable (ArithSeqInfo id) where
 870     ppr (From e1)               = hcat [ppr e1, pp_dotdot]
 871     ppr (FromThen e1 e2)        = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
 872     ppr (FromTo e1 e3)  = hcat [ppr e1, pp_dotdot, ppr e3]
 873     ppr (FromThenTo e1 e2 e3)
 874       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
 875
 876 pp_dotdot = ptext SLIT(" .. ")
 877 \end{code}
 878
 879
 880 %************************************************************************
 881 %*                                                                      *
 882 \subsection{HsMatchCtxt}
 883 %*                                                                      *
 884 %************************************************************************
 885
 886 \begin{code}
 887 data HsMatchContext id  -- Context of a Match
 888   = FunRhs id                   -- Function binding for f
 889   | CaseAlt                     -- Guard on a case alternative
 890   | LambdaExpr                  -- Pattern of a lambda
 891   | ProcExpr                    -- Pattern of a proc
 892   | PatBindRhs                  -- Pattern binding
 893   | RecUpd                      -- Record update [used only in DsExpr to tell matchWrapper
 894                                 --      what sort of runtime error message to generate]
 895   | StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt or list comprehension
 896   deriving ()
 897
 898 data HsStmtContext id
 899   = ListComp
 900   | DoExpr
 901   | MDoExpr                             -- Recursive do-expression
 902   | PArrComp                            -- Parallel array comprehension
 903   | PatGuard (HsMatchContext id)        -- Pattern guard for specified thing
 904   | ParStmtCtxt (HsStmtContext id)      -- A branch of a parallel stmt
 905 \end{code}
 906
 907 \begin{code}
 908 isDoExpr :: HsStmtContext id -> Bool
 909 isDoExpr DoExpr  = True
 910 isDoExpr MDoExpr = True
 911 isDoExpr other   = False
 912 \end{code}
 913
 914 \begin{code}
 915 matchSeparator (FunRhs _)   = ptext SLIT("=")
 916 matchSeparator CaseAlt      = ptext SLIT("->")
 917 matchSeparator LambdaExpr   = ptext SLIT("->")
 918 matchSeparator ProcExpr     = ptext SLIT("->")
 919 matchSeparator PatBindRhs   = ptext SLIT("=")
 920 matchSeparator (StmtCtxt _) = ptext SLIT("<-")
 921 matchSeparator RecUpd       = panic "unused"
 922 \end{code}
 923
 924 \begin{code}
 925 pprMatchContext (FunRhs fun)      = ptext SLIT("the definition of") <+> quotes (ppr fun)
 926 pprMatchContext CaseAlt           = ptext SLIT("a case alternative")
 927 pprMatchContext RecUpd            = ptext SLIT("a record-update construct")
 928 pprMatchContext PatBindRhs        = ptext SLIT("a pattern binding")
 929 pprMatchContext LambdaExpr        = ptext SLIT("a lambda abstraction")
 930 pprMatchContext ProcExpr          = ptext SLIT("an arrow abstraction")
 931 pprMatchContext (StmtCtxt ctxt)   = ptext SLIT("a pattern binding in") $$ pprStmtContext ctxt
 932
 933 pprMatchRhsContext (FunRhs fun) = ptext SLIT("a right-hand side of function") <+> quotes (ppr fun)
 934 pprMatchRhsContext CaseAlt      = ptext SLIT("the body of a case alternative")
 935 pprMatchRhsContext PatBindRhs   = ptext SLIT("the right-hand side of a pattern binding")
 936 pprMatchRhsContext LambdaExpr   = ptext SLIT("the body of a lambda")
 937 pprMatchRhsContext ProcExpr     = ptext SLIT("the body of a proc")
 938 pprMatchRhsContext RecUpd       = panic "pprMatchRhsContext"
 939
 940 pprStmtContext (ParStmtCtxt c) = sep [ptext SLIT("a parallel branch of"), pprStmtContext c]
 941 pprStmtContext (PatGuard ctxt) = ptext SLIT("a pattern guard for") $$ pprMatchContext ctxt
 942 pprStmtContext DoExpr          = ptext SLIT("a 'do' expression")
 943 pprStmtContext MDoExpr         = ptext SLIT("an 'mdo' expression")
 944 pprStmtContext ListComp        = ptext SLIT("a list comprehension")
 945 pprStmtContext PArrComp        = ptext SLIT("an array comprehension")
 946
 947 -- Used for the result statement of comprehension
 948 -- e.g. the 'e' in      [ e | ... ]
 949 --      or the 'r' in   f x = r
 950 pprStmtResultContext (PatGuard ctxt) = pprMatchRhsContext ctxt
 951 pprStmtResultContext other           = ptext SLIT("the result of") <+> pprStmtContext other
 952
 953
 954 -- Used to generate the string for a *runtime* error message
 955 matchContextErrString (FunRhs fun)               = "function " ++ showSDoc (ppr fun)
 956 matchContextErrString CaseAlt                    = "case"
 957 matchContextErrString PatBindRhs                 = "pattern binding"
 958 matchContextErrString RecUpd                     = "record update"
 959 matchContextErrString LambdaExpr                 = "lambda"
 960 matchContextErrString ProcExpr                   = "proc"
 961 matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
 962 matchContextErrString (StmtCtxt (PatGuard _))    = "pattern guard"
 963 matchContextErrString (StmtCtxt DoExpr)          = "'do' expression"
 964 matchContextErrString (StmtCtxt MDoExpr)         = "'mdo' expression"
 965 matchContextErrString (StmtCtxt ListComp)        = "list comprehension"
 966 matchContextErrString (StmtCtxt PArrComp)        = "array comprehension"
 967 \end{code}