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