compiler/hsSyn/HsExpr.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \begin{code}
   6 {-# LANGUAGE DeriveDataTypeable #-}
   7
   8 -- | Abstract Haskell syntax for expressions.
   9 module HsExpr where
  10
  11 #include "HsVersions.h"
  12
  13 -- friends:
  14 import HsDecls
  15 import HsPat
  16 import HsLit
  17 import HsTypes
  18 import HsBinds
  19
  20 -- others:
  21 import Var
  22 import Name
  23 import BasicTypes
  24 import DataCon
  25 import SrcLoc
  26 import Util( dropTail )
  27 import Outputable
  28 import FastString
  29
  30 -- libraries:
  31 import Data.Data hiding (Fixity)
  32 \end{code}
  33
  34
  35 %************************************************************************
  36 %*                                                                      *
  37 \subsection{Expressions proper}
  38 %*                                                                      *
  39 %************************************************************************
  40
  41 \begin{code}
  42 -- * Expressions proper
  43
  44 type LHsExpr id = Located (HsExpr id)
  45
  46 -------------------------
  47 -- | PostTcExpr is an evidence expression attached to the syntax tree by the
  48 -- type checker (c.f. postTcType).
  49 type PostTcExpr  = HsExpr Id
  50 -- | We use a PostTcTable where there are a bunch of pieces of evidence, more
  51 -- than is convenient to keep individually.
  52 type PostTcTable = [(Name, PostTcExpr)]
  53
  54 noPostTcExpr :: PostTcExpr
  55 noPostTcExpr = HsLit (HsString (fsLit "noPostTcExpr"))
  56
  57 noPostTcTable :: PostTcTable
  58 noPostTcTable = []
  59
  60 -------------------------
  61 -- | SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,
  62 -- by the renamer.  It's used for rebindable syntax.
  63 --
  64 -- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for
  65 --      @(>>=)@, and then instantiated by the type checker with its type args
  66 --      etc
  67
  68 type SyntaxExpr id = HsExpr id
  69
  70 noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
  71                               -- (if the syntax slot makes no sense)
  72 noSyntaxExpr = HsLit (HsString (fsLit "noSyntaxExpr"))
  73
  74
  75 type SyntaxTable id = [(Name, SyntaxExpr id)]
  76 -- ^ Currently used only for 'CmdTop' (sigh)
  77 --
  78 -- * Before the renamer, this list is 'noSyntaxTable'
  79 --
  80 -- * After the renamer, it takes the form @[(std_name, HsVar actual_name)]@
  81 --   For example, for the 'return' op of a monad
  82 --
  83 --    * normal case:            @(GHC.Base.return, HsVar GHC.Base.return)@
  84 --
  85 --    * with rebindable syntax: @(GHC.Base.return, return_22)@
  86 --              where @return_22@ is whatever @return@ is in scope
  87 --
  88 -- * After the type checker, it takes the form @[(std_name, <expression>)]@
  89 --      where @<expression>@ is the evidence for the method
  90
  91 noSyntaxTable :: SyntaxTable id
  92 noSyntaxTable = []
  93
  94
  95 -------------------------
  96 -- | A Haskell expression.
  97 data HsExpr id
  98   = HsVar     id                        -- ^ variable
  99   | HsIPVar   (IPName id)               -- ^ implicit parameter
 100   | HsOverLit (HsOverLit id)            -- ^ Overloaded literals
 101
 102   | HsLit     HsLit                     -- ^ Simple (non-overloaded) literals
 103
 104   | HsLam     (MatchGroup id)           -- Currently always a single match
 105
 106   | HsApp     (LHsExpr id) (LHsExpr id) -- Application
 107
 108   -- Operator applications:
 109   -- NB Bracketed ops such as (+) come out as Vars.
 110
 111   -- NB We need an expr for the operator in an OpApp/Section since
 112   -- the typechecker may need to apply the operator to a few types.
 113
 114   | OpApp       (LHsExpr id)    -- left operand
 115                 (LHsExpr id)    -- operator
 116                 Fixity          -- Renamer adds fixity; bottom until then
 117                 (LHsExpr id)    -- right operand
 118
 119   | NegApp      (LHsExpr id)    -- negated expr
 120                 (SyntaxExpr id) -- Name of 'negate'
 121
 122   | HsPar       (LHsExpr id)    -- parenthesised expr
 123
 124   | SectionL    (LHsExpr id)    -- operand
 125                 (LHsExpr id)    -- operator
 126   | SectionR    (LHsExpr id)    -- operator
 127                 (LHsExpr id)    -- operand
 128
 129   | ExplicitTuple               -- Used for explicit tuples and sections thereof
 130         [HsTupArg id]
 131         Boxity
 132
 133   | HsCase      (LHsExpr id)
 134                 (MatchGroup id)
 135
 136   | HsIf        (Maybe (SyntaxExpr id)) -- cond function
 137                                         -- Nothing => use the built-in 'if'
 138                                         -- See Note [Rebindable if]
 139                 (LHsExpr id)    --  predicate
 140                 (LHsExpr id)    --  then part
 141                 (LHsExpr id)    --  else part
 142
 143   | HsLet       (HsLocalBinds id) -- let(rec)
 144                 (LHsExpr  id)
 145
 146   | HsDo        (HsStmtContext Name) -- The parameterisation is unimportant
 147                                      -- because in this context we never use
 148                                      -- the PatGuard or ParStmt variant
 149                 [LStmt id]           -- "do":one or more stmts
 150                 PostTcType           -- Type of the whole expression
 151
 152   | ExplicitList                -- syntactic list
 153                 PostTcType      -- Gives type of components of list
 154                 [LHsExpr id]
 155
 156   | ExplicitPArr                -- syntactic parallel array: [:e1, ..., en:]
 157                 PostTcType      -- type of elements of the parallel array
 158                 [LHsExpr id]
 159
 160   -- Record construction
 161   | RecordCon   (Located id)       -- The constructor.  After type checking
 162                                    -- it's the dataConWrapId of the constructor
 163                 PostTcExpr         -- Data con Id applied to type args
 164                 (HsRecordBinds id)
 165
 166   -- Record update
 167   | RecordUpd   (LHsExpr id)
 168                 (HsRecordBinds id)
 169 --              (HsMatchGroup Id)  -- Filled in by the type checker to be
 170 --                                 -- a match that does the job
 171                 [DataCon]          -- Filled in by the type checker to the
 172                                    -- _non-empty_ list of DataCons that have
 173                                    -- all the upd'd fields
 174                 [PostTcType]       -- Argument types of *input* record type
 175                 [PostTcType]       --              and  *output* record type
 176   -- For a type family, the arg types are of the *instance* tycon,
 177   -- not the family tycon
 178
 179   | ExprWithTySig                       -- e :: type
 180                 (LHsExpr id)
 181                 (LHsType id)
 182
 183   | ExprWithTySigOut                    -- TRANSLATION
 184                 (LHsExpr id)
 185                 (LHsType Name)          -- Retain the signature for
 186                                         -- round-tripping purposes
 187
 188   | ArithSeq                            -- arithmetic sequence
 189                 PostTcExpr
 190                 (ArithSeqInfo id)
 191
 192   | PArrSeq                             -- arith. sequence for parallel array
 193                 PostTcExpr              -- [:e1..e2:] or [:e1, e2..e3:]
 194                 (ArithSeqInfo id)
 195
 196   | HsSCC       FastString              -- "set cost centre" SCC pragma
 197                 (LHsExpr id)            -- expr whose cost is to be measured
 198
 199   | HsCoreAnn   FastString              -- hdaume: core annotation
 200                 (LHsExpr id)
 201
 202   -----------------------------------------------------------
 203   -- MetaHaskell Extensions
 204
 205   | HsBracket    (HsBracket id)
 206
 207   | HsBracketOut (HsBracket Name)       -- Output of the type checker is
 208                                         -- the *original*
 209                  [PendingSplice]        -- renamed expression, plus
 210                                         -- _typechecked_ splices to be
 211                                         -- pasted back in by the desugarer
 212
 213   | HsSpliceE (HsSplice id)
 214
 215   | HsQuasiQuoteE (HsQuasiQuote id)
 216         -- See Note [Quasi-quote overview] in TcSplice
 217
 218   -----------------------------------------------------------
 219   -- Arrow notation extension
 220
 221   | HsProc      (LPat id)               -- arrow abstraction, proc
 222                 (LHsCmdTop id)          -- body of the abstraction
 223                                         -- always has an empty stack
 224
 225   ---------------------------------------
 226   -- The following are commands, not expressions proper
 227
 228   | HsArrApp            -- Arrow tail, or arrow application (f -< arg)
 229         (LHsExpr id)    -- arrow expression, f
 230         (LHsExpr id)    -- input expression, arg
 231         PostTcType      -- type of the arrow expressions f,
 232                         -- of the form a t t', where arg :: t
 233         HsArrAppType    -- higher-order (-<<) or first-order (-<)
 234         Bool            -- True => right-to-left (f -< arg)
 235                         -- False => left-to-right (arg >- f)
 236
 237   | HsArrForm           -- Command formation,  (| e cmd1 .. cmdn |)
 238         (LHsExpr id)    -- the operator
 239                         -- after type-checking, a type abstraction to be
 240                         -- applied to the type of the local environment tuple
 241         (Maybe Fixity)  -- fixity (filled in by the renamer), for forms that
 242                         -- were converted from OpApp's by the renamer
 243         [LHsCmdTop id]  -- argument commands
 244
 245
 246   ---------------------------------------
 247   -- Haskell program coverage (Hpc) Support
 248
 249   | HsTick
 250      Int                                -- module-local tick number
 251      [id]                               -- variables in scope
 252      (LHsExpr id)                       -- sub-expression
 253
 254   | HsBinTick
 255      Int                                -- module-local tick number for True
 256      Int                                -- module-local tick number for False
 257      (LHsExpr id)                       -- sub-expression
 258
 259   | HsTickPragma                        -- A pragma introduced tick
 260      (FastString,(Int,Int),(Int,Int))   -- external span for this tick
 261      (LHsExpr id)
 262
 263   ---------------------------------------
 264   -- These constructors only appear temporarily in the parser.
 265   -- The renamer translates them into the Right Thing.
 266
 267   | EWildPat                 -- wildcard
 268
 269   | EAsPat      (Located id) -- as pattern
 270                 (LHsExpr id)
 271
 272   | EViewPat    (LHsExpr id) -- view pattern
 273                 (LHsExpr id)
 274
 275   | ELazyPat    (LHsExpr id) -- ~ pattern
 276
 277   | HsType      (LHsType id) -- Explicit type argument; e.g  f {| Int |} x y
 278
 279   ---------------------------------------
 280   -- Finally, HsWrap appears only in typechecker output
 281
 282   |  HsWrap     HsWrapper    -- TRANSLATION
 283                 (HsExpr id)
 284   deriving (Data, Typeable)
 285
 286 -- HsTupArg is used for tuple sections
 287 --  (,a,) is represented by  ExplicitTuple [Mising ty1, Present a, Missing ty3]
 288 --  Which in turn stands for (\x:ty1 \y:ty2. (x,a,y))
 289 data HsTupArg id
 290   = Present (LHsExpr id)        -- The argument
 291   | Missing PostTcType          -- The argument is missing, but this is its type
 292   deriving (Data, Typeable)
 293
 294 tupArgPresent :: HsTupArg id -> Bool
 295 tupArgPresent (Present {}) = True
 296 tupArgPresent (Missing {}) = False
 297
 298 type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be
 299                                         -- pasted back in by the desugarer
 300 \end{code}
 301
 302 Note [Rebindable if]
 303 ~~~~~~~~~~~~~~~~~~~~
 304 The rebindable syntax for 'if' is a bit special, because when
 305 rebindable syntax is *off* we do not want to treat
 306    (if c then t else e)
 307 as if it was an application (ifThenElse c t e).  Why not?
 308 Because we allow an 'if' to return *unboxed* results, thus
 309   if blah then 3# else 4#
 310 whereas that would not be possible using a all to a polymorphic function
 311 (because you can't call a polymorphic function at an unboxed type).
 312
 313 So we use Nothing to mean "use the old built-in typing rule".
 314
 315 \begin{code}
 316 instance OutputableBndr id => Outputable (HsExpr id) where
 317     ppr expr = pprExpr expr
 318 \end{code}
 319
 320 \begin{code}
 321 -----------------------
 322 -- pprExpr, pprLExpr, pprBinds call pprDeeper;
 323 -- the underscore versions do not
 324 pprLExpr :: OutputableBndr id => LHsExpr id -> SDoc
 325 pprLExpr (L _ e) = pprExpr e
 326
 327 pprExpr :: OutputableBndr id => HsExpr id -> SDoc
 328 pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e
 329           | otherwise                           = pprDeeper (ppr_expr e)
 330
 331 isQuietHsExpr :: HsExpr id -> Bool
 332 -- Parentheses do display something, but it gives little info and
 333 -- if we go deeper when we go inside them then we get ugly things
 334 -- like (...)
 335 isQuietHsExpr (HsPar _) = True
 336 -- applications don't display anything themselves
 337 isQuietHsExpr (HsApp _ _) = True
 338 isQuietHsExpr (OpApp _ _ _ _) = True
 339 isQuietHsExpr _ = False
 340
 341 pprBinds :: (OutputableBndr idL, OutputableBndr idR)
 342          => HsLocalBindsLR idL idR -> SDoc
 343 pprBinds b = pprDeeper (ppr b)
 344
 345 -----------------------
 346 ppr_lexpr :: OutputableBndr id => LHsExpr id -> SDoc
 347 ppr_lexpr e = ppr_expr (unLoc e)
 348
 349 ppr_expr :: OutputableBndr id => HsExpr id -> SDoc
 350 ppr_expr (HsVar v)       = pprHsVar v
 351 ppr_expr (HsIPVar v)     = ppr v
 352 ppr_expr (HsLit lit)     = ppr lit
 353 ppr_expr (HsOverLit lit) = ppr lit
 354 ppr_expr (HsPar e)       = parens (ppr_lexpr e)
 355
 356 ppr_expr (HsCoreAnn s e)
 357   = vcat [ptext (sLit "HsCoreAnn") <+> ftext s, ppr_lexpr e]
 358
 359 ppr_expr (HsApp e1 e2)
 360   = let (fun, args) = collect_args e1 [e2] in
 361     hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))
 362   where
 363     collect_args (L _ (HsApp fun arg)) args = collect_args fun (arg:args)
 364     collect_args fun args = (fun, args)
 365
 366 ppr_expr (OpApp e1 op _ e2)
 367   = case unLoc op of
 368       HsVar v -> pp_infixly v
 369       _       -> pp_prefixly
 370   where
 371     pp_e1 = pprDebugParendExpr e1   -- In debug mode, add parens
 372     pp_e2 = pprDebugParendExpr e2   -- to make precedence clear
 373
 374     pp_prefixly
 375       = hang (ppr op) 2 (sep [pp_e1, pp_e2])
 376
 377     pp_infixly v
 378       = sep [nest 2 pp_e1, pprHsInfix v, nest 2 pp_e2]
 379
 380 ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
 381
 382 ppr_expr (SectionL expr op)
 383   = case unLoc op of
 384       HsVar v -> pp_infixly v
 385       _       -> pp_prefixly
 386   where
 387     pp_expr = pprDebugParendExpr expr
 388
 389     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
 390                        4 (hsep [pp_expr, ptext (sLit "x_ )")])
 391     pp_infixly v = (sep [pp_expr, pprHsInfix v])
 392
 393 ppr_expr (SectionR op expr)
 394   = case unLoc op of
 395       HsVar v -> pp_infixly v
 396       _       -> pp_prefixly
 397   where
 398     pp_expr = pprDebugParendExpr expr
 399
 400     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
 401                        4 ((<>) pp_expr rparen)
 402     pp_infixly v
 403       = (sep [pprHsInfix v, pp_expr])
 404
 405 ppr_expr (ExplicitTuple exprs boxity)
 406   = tupleParens boxity (fcat (ppr_tup_args exprs))
 407   where
 408     ppr_tup_args []               = []
 409     ppr_tup_args (Present e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
 410     ppr_tup_args (Missing _ : es) = punc es : ppr_tup_args es
 411
 412     punc (Present {} : _) = comma <> space
 413     punc (Missing {} : _) = comma
 414     punc []               = empty
 415
 416 --avoid using PatternSignatures for stage1 code portability
 417 ppr_expr exprType@(HsLam matches)
 418   = pprMatches (LambdaExpr `asTypeOf` idType exprType) matches
 419  where idType :: HsExpr id -> HsMatchContext id; idType = undefined
 420
 421 ppr_expr exprType@(HsCase expr matches)
 422   = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of {")],
 423           nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches <+> char '}') ]
 424  where idType :: HsExpr id -> HsMatchContext id; idType = undefined
 425
 426 ppr_expr (HsIf _ e1 e2 e3)
 427   = sep [hsep [ptext (sLit "if"), nest 2 (ppr e1), ptext (sLit "then")],
 428          nest 4 (ppr e2),
 429          ptext (sLit "else"),
 430          nest 4 (ppr e3)]
 431
 432 -- special case: let ... in let ...
 433 ppr_expr (HsLet binds expr@(L _ (HsLet _ _)))
 434   = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
 435          ppr_lexpr expr]
 436
 437 ppr_expr (HsLet binds expr)
 438   = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
 439          hang (ptext (sLit "in"))  2 (ppr expr)]
 440
 441 ppr_expr (HsDo do_or_list_comp stmts _) = pprDo do_or_list_comp stmts
 442
 443 ppr_expr (ExplicitList _ exprs)
 444   = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
 445
 446 ppr_expr (ExplicitPArr _ exprs)
 447   = pa_brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
 448
 449 ppr_expr (RecordCon con_id _ rbinds)
 450   = hang (ppr con_id) 2 (ppr rbinds)
 451
 452 ppr_expr (RecordUpd aexp rbinds _ _ _)
 453   = hang (pprParendExpr aexp) 2 (ppr rbinds)
 454
 455 ppr_expr (ExprWithTySig expr sig)
 456   = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
 457          4 (ppr sig)
 458 ppr_expr (ExprWithTySigOut expr sig)
 459   = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
 460          4 (ppr sig)
 461
 462 ppr_expr (ArithSeq _ info) = brackets (ppr info)
 463 ppr_expr (PArrSeq  _ info) = pa_brackets (ppr info)
 464
 465 ppr_expr EWildPat       = char '_'
 466 ppr_expr (ELazyPat e)   = char '~' <> pprParendExpr e
 467 ppr_expr (EAsPat v e)   = ppr v <> char '@' <> pprParendExpr e
 468 ppr_expr (EViewPat p e) = ppr p <+> ptext (sLit "->") <+> ppr e
 469
 470 ppr_expr (HsSCC lbl expr)
 471   = sep [ ptext (sLit "_scc_") <+> doubleQuotes (ftext lbl),
 472           pprParendExpr expr ]
 473
 474 ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
 475 ppr_expr (HsType id)      = ppr id
 476
 477 ppr_expr (HsSpliceE s)       = pprSplice s
 478 ppr_expr (HsBracket b)       = pprHsBracket b
 479 ppr_expr (HsBracketOut e []) = ppr e
 480 ppr_expr (HsBracketOut e ps) = ppr e $$ ptext (sLit "pending") <+> ppr ps
 481 ppr_expr (HsQuasiQuoteE qq)  = ppr qq
 482
 483 ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
 484   = hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
 485
 486 ppr_expr (HsTick tickId vars exp)
 487   = pprTicks (ppr exp) $
 488     hcat [ptext (sLit "tick<"),
 489     ppr tickId,
 490     ptext (sLit ">("),
 491     hsep (map pprHsVar vars),
 492     ppr exp,
 493     ptext (sLit ")")]
 494 ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
 495   = pprTicks (ppr exp) $
 496     hcat [ptext (sLit "bintick<"),
 497           ppr tickIdTrue,
 498           ptext (sLit ","),
 499           ppr tickIdFalse,
 500           ptext (sLit ">("),
 501           ppr exp,ptext (sLit ")")]
 502 ppr_expr (HsTickPragma externalSrcLoc exp)
 503   = pprTicks (ppr exp) $
 504     hcat [ptext (sLit "tickpragma<"),
 505           ppr externalSrcLoc,
 506           ptext (sLit ">("),
 507           ppr exp,
 508           ptext (sLit ")")]
 509
 510 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
 511   = hsep [ppr_lexpr arrow, ptext (sLit "-<"), ppr_lexpr arg]
 512 ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
 513   = hsep [ppr_lexpr arg, ptext (sLit ">-"), ppr_lexpr arrow]
 514 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
 515   = hsep [ppr_lexpr arrow, ptext (sLit "-<<"), ppr_lexpr arg]
 516 ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
 517   = hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]
 518
 519 ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
 520   = sep [pprCmdArg (unLoc arg1), hsep [pprHsInfix v, pprCmdArg (unLoc arg2)]]
 521 ppr_expr (HsArrForm op _ args)
 522   = hang (ptext (sLit "(|") <> ppr_lexpr op)
 523          4 (sep (map (pprCmdArg.unLoc) args) <> ptext (sLit "|)"))
 524
 525 pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
 526 pprCmdArg (HsCmdTop cmd@(L _ (HsArrForm _ Nothing [])) _ _ _)
 527   = ppr_lexpr cmd
 528 pprCmdArg (HsCmdTop cmd _ _ _)
 529   = parens (ppr_lexpr cmd)
 530
 531 instance OutputableBndr id => Outputable (HsCmdTop id) where
 532     ppr = pprCmdArg
 533
 534 -- add parallel array brackets around a document
 535 --
 536 pa_brackets :: SDoc -> SDoc
 537 pa_brackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
 538 \end{code}
 539
 540 HsSyn records exactly where the user put parens, with HsPar.
 541 So generally speaking we print without adding any parens.
 542 However, some code is internally generated, and in some places
 543 parens are absolutely required; so for these places we use
 544 pprParendExpr (but don't print double parens of course).
 545
 546 For operator applications we don't add parens, because the oprerator
 547 fixities should do the job, except in debug mode (-dppr-debug) so we
 548 can see the structure of the parse tree.
 549
 550 \begin{code}
 551 pprDebugParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
 552 pprDebugParendExpr expr
 553   = getPprStyle (\sty ->
 554     if debugStyle sty then pprParendExpr expr
 555                       else pprLExpr      expr)
 556
 557 pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
 558 pprParendExpr expr
 559   = let
 560         pp_as_was = pprLExpr expr
 561         -- Using pprLExpr makes sure that we go 'deeper'
 562         -- I think that is usually (always?) right
 563     in
 564     case unLoc expr of
 565       ArithSeq {}       -> pp_as_was
 566       PArrSeq {}        -> pp_as_was
 567       HsLit {}          -> pp_as_was
 568       HsOverLit {}      -> pp_as_was
 569       HsVar {}          -> pp_as_was
 570       HsIPVar {}        -> pp_as_was
 571       ExplicitTuple {}  -> pp_as_was
 572       ExplicitList {}   -> pp_as_was
 573       ExplicitPArr {}   -> pp_as_was
 574       HsPar {}          -> pp_as_was
 575       HsBracket {}      -> pp_as_was
 576       HsBracketOut _ [] -> pp_as_was
 577       HsDo sc _ _
 578        | isListCompExpr sc -> pp_as_was
 579       _                    -> parens pp_as_was
 580
 581 isAtomicHsExpr :: HsExpr id -> Bool -- A single token
 582 isAtomicHsExpr (HsVar {})     = True
 583 isAtomicHsExpr (HsLit {})     = True
 584 isAtomicHsExpr (HsOverLit {}) = True
 585 isAtomicHsExpr (HsIPVar {})   = True
 586 isAtomicHsExpr (HsWrap _ e)   = isAtomicHsExpr e
 587 isAtomicHsExpr (HsPar e)      = isAtomicHsExpr (unLoc e)
 588 isAtomicHsExpr _              = False
 589 \end{code}
 590
 591 %************************************************************************
 592 %*                                                                      *
 593 \subsection{Commands (in arrow abstractions)}
 594 %*                                                                      *
 595 %************************************************************************
 596
 597 We re-use HsExpr to represent these.
 598
 599 \begin{code}
 600 type HsCmd id = HsExpr id
 601
 602 type LHsCmd id = LHsExpr id
 603
 604 data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
 605   deriving (Data, Typeable)
 606 \end{code}
 607
 608 The legal constructors for commands are:
 609
 610   = HsArrApp ...                -- as above
 611
 612   | HsArrForm ...               -- as above
 613
 614   | HsApp       (HsCmd id)
 615                 (HsExpr id)
 616
 617   | HsLam       (Match  id)     -- kappa
 618
 619   -- the renamer turns this one into HsArrForm
 620   | OpApp       (HsExpr id)     -- left operand
 621                 (HsCmd id)      -- operator
 622                 Fixity          -- Renamer adds fixity; bottom until then
 623                 (HsCmd id)      -- right operand
 624
 625   | HsPar       (HsCmd id)      -- parenthesised command
 626
 627   | HsCase      (HsExpr id)
 628                 [Match id]      -- bodies are HsCmd's
 629                 SrcLoc
 630
 631   | HsIf        (Maybe (SyntaxExpr id)) --  cond function
 632                                          (HsExpr id)     --  predicate
 633                 (HsCmd id)      --  then part
 634                 (HsCmd id)      --  else part
 635                 SrcLoc
 636
 637   | HsLet       (HsLocalBinds id)       -- let(rec)
 638                 (HsCmd  id)
 639
 640   | HsDo        (HsStmtContext Name)    -- The parameterisation is unimportant
 641                                         -- because in this context we never use
 642                                         -- the PatGuard or ParStmt variant
 643                 [Stmt id]       -- HsExpr's are really HsCmd's
 644                 PostTcType      -- Type of the whole expression
 645                 SrcLoc
 646
 647 Top-level command, introducing a new arrow.
 648 This may occur inside a proc (where the stack is empty) or as an
 649 argument of a command-forming operator.
 650
 651 \begin{code}
 652 type LHsCmdTop id = Located (HsCmdTop id)
 653
 654 data HsCmdTop id
 655   = HsCmdTop (LHsCmd id)
 656              [PostTcType]     -- types of inputs on the command's stack
 657              PostTcType       -- return type of the command
 658              (SyntaxTable id) -- after type checking:
 659                               -- names used in the command's desugaring
 660   deriving (Data, Typeable)
 661 \end{code}
 662
 663 %************************************************************************
 664 %*                                                                      *
 665 \subsection{Record binds}
 666 %*                                                                      *
 667 %************************************************************************
 668
 669 \begin{code}
 670 type HsRecordBinds id = HsRecFields id (LHsExpr id)
 671 \end{code}
 672
 673
 674
 675 %************************************************************************
 676 %*                                                                      *
 677 \subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
 678 %*                                                                      *
 679 %************************************************************************
 680
 681 @Match@es are sets of pattern bindings and right hand sides for
 682 functions, patterns or case branches. For example, if a function @g@
 683 is defined as:
 684 \begin{verbatim}
 685 g (x,y) = y
 686 g ((x:ys),y) = y+1,
 687 \end{verbatim}
 688 then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
 689
 690 It is always the case that each element of an @[Match]@ list has the
 691 same number of @pats@s inside it.  This corresponds to saying that
 692 a function defined by pattern matching must have the same number of
 693 patterns in each equation.
 694
 695 \begin{code}
 696 data MatchGroup id
 697   = MatchGroup
 698         [LMatch id]     -- The alternatives
 699         PostTcType      -- The type is the type of the entire group
 700                         --      t1 -> ... -> tn -> tr
 701                         -- where there are n patterns
 702   deriving (Data, Typeable)
 703
 704 type LMatch id = Located (Match id)
 705
 706 data Match id
 707   = Match
 708         [LPat id]               -- The patterns
 709         (Maybe (LHsType id))    -- A type signature for the result of the match
 710                                 -- Nothing after typechecking
 711         (GRHSs id)
 712   deriving (Data, Typeable)
 713
 714 isEmptyMatchGroup :: MatchGroup id -> Bool
 715 isEmptyMatchGroup (MatchGroup ms _) = null ms
 716
 717 matchGroupArity :: MatchGroup id -> Arity
 718 matchGroupArity (MatchGroup [] _)
 719   = panic "matchGroupArity"     -- Precondition: MatchGroup is non-empty
 720 matchGroupArity (MatchGroup (match:matches) _)
 721   = ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
 722     -- Assertion just checks that all the matches have the same number of pats
 723     n_pats
 724   where
 725     n_pats = length (hsLMatchPats match)
 726
 727 hsLMatchPats :: LMatch id -> [LPat id]
 728 hsLMatchPats (L _ (Match pats _ _)) = pats
 729
 730 -- | GRHSs are used both for pattern bindings and for Matches
 731 data GRHSs id
 732   = GRHSs {
 733       grhssGRHSs :: [LGRHS id],  -- ^ Guarded RHSs
 734       grhssLocalBinds :: (HsLocalBinds id) -- ^ The where clause
 735     } deriving (Data, Typeable)
 736
 737 type LGRHS id = Located (GRHS id)
 738
 739 -- | Guarded Right Hand Side.
 740 data GRHS id = GRHS [LStmt id]   -- Guards
 741                     (LHsExpr id) -- Right hand side
 742   deriving (Data, Typeable)
 743 \end{code}
 744
 745 We know the list must have at least one @Match@ in it.
 746
 747 \begin{code}
 748 pprMatches :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> MatchGroup idR -> SDoc
 749 pprMatches ctxt (MatchGroup matches _)
 750     = vcat (map (pprMatch ctxt) (map unLoc matches))
 751       -- Don't print the type; it's only a place-holder before typechecking
 752
 753 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 754 pprFunBind :: (OutputableBndr idL, OutputableBndr idR) => idL -> Bool -> MatchGroup idR -> SDoc
 755 pprFunBind fun inf matches = pprMatches (FunRhs fun inf) matches
 756
 757 -- Exported to HsBinds, which can't see the defn of HsMatchContext
 758 pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
 759            => LPat bndr -> GRHSs id -> SDoc
 760 pprPatBind pat ty@(grhss)
 761  = sep [ppr pat, nest 2 (pprGRHSs (PatBindRhs `asTypeOf` idType ty) grhss)]
 762 --avoid using PatternSignatures for stage1 code portability
 763  where idType :: GRHSs id -> HsMatchContext id; idType = undefined
 764
 765
 766 pprMatch :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> Match idR -> SDoc
 767 pprMatch ctxt (Match pats maybe_ty grhss)
 768   = sep [ sep (herald : map (nest 2 . pprParendLPat) other_pats)
 769         , nest 2 ppr_maybe_ty
 770         , nest 2 (pprGRHSs ctxt grhss) ]
 771   where
 772     (herald, other_pats)
 773         = case ctxt of
 774             FunRhs fun is_infix
 775                 | not is_infix -> (ppr fun, pats)
 776                         -- f x y z = e
 777                         -- Not pprBndr; the AbsBinds will
 778                         -- have printed the signature
 779
 780                 | null pats2 -> (pp_infix, [])
 781                         -- x &&& y = e
 782
 783                 | otherwise -> (parens pp_infix, pats2)
 784                         -- (x &&& y) z = e
 785                 where
 786                   pp_infix = pprParendLPat pat1 <+> ppr fun <+> pprParendLPat pat2
 787
 788             LambdaExpr -> (char '\\', pats)
 789
 790             _  -> ASSERT( null pats1 )
 791                   (ppr pat1, [])        -- No parens around the single pat
 792
 793     (pat1:pats1) = pats
 794     (pat2:pats2) = pats1
 795     ppr_maybe_ty = case maybe_ty of
 796                         Just ty -> dcolon <+> ppr ty
 797                         Nothing -> empty
 798
 799
 800 pprGRHSs :: (OutputableBndr idL, OutputableBndr idR)
 801          => HsMatchContext idL -> GRHSs idR -> SDoc
 802 pprGRHSs ctxt (GRHSs grhss binds)
 803   = vcat (map (pprGRHS ctxt . unLoc) grhss)
 804  $$ ppUnless (isEmptyLocalBinds binds)
 805       (text "where" $$ nest 4 (pprBinds binds))
 806
 807 pprGRHS :: (OutputableBndr idL, OutputableBndr idR)
 808         => HsMatchContext idL -> GRHS idR -> SDoc
 809
 810 pprGRHS ctxt (GRHS [] expr)
 811  =  pp_rhs ctxt expr
 812
 813 pprGRHS ctxt (GRHS guards expr)
 814  = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
 815
 816 pp_rhs :: OutputableBndr idR => HsMatchContext idL -> LHsExpr idR -> SDoc
 817 pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
 818 \end{code}
 819
 820 %************************************************************************
 821 %*                                                                      *
 822 \subsection{Do stmts and list comprehensions}
 823 %*                                                                      *
 824 %************************************************************************
 825
 826 \begin{code}
 827 type LStmt id = Located (StmtLR id id)
 828 type LStmtLR idL idR = Located (StmtLR idL idR)
 829
 830 type Stmt id = StmtLR id id
 831
 832 -- The SyntaxExprs in here are used *only* for do-notation and monad
 833 -- comprehensions, which have rebindable syntax. Otherwise they are unused.
 834 data StmtLR idL idR
 835   = LastStmt  -- Always the last Stmt in ListComp, MonadComp, PArrComp, DoExpr, MDoExpr
 836               -- Not used for GhciStmt, PatGuard, which scope over other stuff
 837                (LHsExpr idR)
 838                (SyntaxExpr idR)   -- The return operator, used only for MonadComp
 839                                   -- See Note [Monad Comprehensions]
 840   | BindStmt (LPat idL)
 841              (LHsExpr idR)
 842              (SyntaxExpr idR) -- The (>>=) operator
 843              (SyntaxExpr idR) -- The fail operator
 844              -- The fail operator is noSyntaxExpr
 845              -- if the pattern match can't fail
 846
 847   | ExprStmt (LHsExpr idR)     -- See Note [ExprStmt]
 848              (SyntaxExpr idR) -- The (>>) operator
 849              (SyntaxExpr idR) -- The `guard` operator
 850                               -- See notes [Monad Comprehensions]
 851              PostTcType       -- Element type of the RHS (used for arrows)
 852
 853   | LetStmt  (HsLocalBindsLR idL idR)
 854
 855   -- ParStmts only occur in a list/monad comprehension
 856   | ParStmt  [([LStmt idL], [idR])]
 857              (SyntaxExpr idR)           -- Polymorphic `mzip` for monad comprehensions
 858              (SyntaxExpr idR)           -- The `>>=` operator
 859              (SyntaxExpr idR)           -- Polymorphic `return` operator
 860                                         -- with type (forall a. a -> m a)
 861                                         -- See notes [Monad Comprehensions]
 862
 863   -- After renaming, the ids are the binders bound by the stmts and used
 864   -- after them
 865
 866   -- "qs, then f by e" ==> TransformStmt qs binders f (Just e) (return) (>>=)
 867   -- "qs, then f"      ==> TransformStmt qs binders f Nothing  (return) (>>=)
 868   | TransformStmt
 869          [LStmt idL]    -- Stmts are the ones to the left of the 'then'
 870
 871          [idR]          -- After renaming, the IDs are the binders occurring
 872                         -- within this transform statement that are used after it
 873
 874          (LHsExpr idR)          -- "then f"
 875
 876          (Maybe (LHsExpr idR))  -- "by e" (optional)
 877
 878          (SyntaxExpr idR)       -- The 'return' function for inner monad
 879                                 -- comprehensions
 880          (SyntaxExpr idR)       -- The '(>>=)' operator.
 881                                 -- See Note [Monad Comprehensions]
 882
 883   | GroupStmt
 884          [LStmt idL]      -- Stmts to the *left* of the 'group'
 885                           -- which generates the tuples to be grouped
 886
 887          [(idR, idR)]     -- See Note [GroupStmt binder map]
 888
 889          (Maybe (LHsExpr idR))  -- "by e" (optional)
 890
 891          (Either                -- "using f"
 892              (LHsExpr idR)      --   Left f  => explicit "using f"
 893              (SyntaxExpr idR))  --   Right f => implicit; filled in with 'groupWith'
 894                                 --     (list comprehensions) or 'groupM' (monad
 895                                 --     comprehensions)
 896
 897          (SyntaxExpr idR)       -- The 'return' function for inner monad
 898                                 -- comprehensions
 899          (SyntaxExpr idR)       -- The '(>>=)' operator
 900          (SyntaxExpr idR)       -- The 'liftM' function from Control.Monad for desugaring
 901                                 -- See Note [Monad Comprehensions]
 902
 903   -- Recursive statement (see Note [How RecStmt works] below)
 904   | RecStmt
 905      { recS_stmts :: [LStmtLR idL idR]
 906
 907         -- The next two fields are only valid after renaming
 908      , recS_later_ids :: [idR] -- The ids are a subset of the variables bound by the
 909                                -- stmts that are used in stmts that follow the RecStmt
 910
 911      , recS_rec_ids :: [idR]   -- Ditto, but these variables are the "recursive" ones,
 912                                -- that are used before they are bound in the stmts of
 913                                -- the RecStmt.
 914         -- An Id can be in both groups
 915         -- Both sets of Ids are (now) treated monomorphically
 916         -- See Note [How RecStmt works] for why they are separate
 917
 918         -- Rebindable syntax
 919      , recS_bind_fn :: SyntaxExpr idR -- The bind function
 920      , recS_ret_fn  :: SyntaxExpr idR -- The return function
 921      , recS_mfix_fn :: SyntaxExpr idR -- The mfix function
 922
 923         -- These fields are only valid after typechecking
 924      , recS_rec_rets :: [PostTcExpr] -- These expressions correspond 1-to-1 with
 925                                      -- recS_rec_ids, and are the
 926                                      -- expressions that should be returned by
 927                                      -- the recursion.
 928                                      -- They may not quite be the Ids themselves,
 929                                      -- because the Id may be *polymorphic*, but
 930                                      -- the returned thing has to be *monomorphic*,
 931                                      -- so they may be type applications
 932
 933       , recS_ret_ty :: PostTcType    -- The type of of do { stmts; return (a,b,c) }
 934                                      -- With rebindable syntax the type might not
 935                                      -- be quite as simple as (m (tya, tyb, tyc)).
 936       }
 937   deriving (Data, Typeable)
 938 \end{code}
 939
 940 Note [GroupStmt binder map]
 941 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
 942 The [(idR,idR)] in a GroupStmt behaves as follows:
 943
 944   * Before renaming: []
 945
 946   * After renaming:
 947           [ (x27,x27), ..., (z35,z35) ]
 948     These are the variables
 949         bound by the stmts to the left of the 'group'
 950        and used either in the 'by' clause,
 951                 or     in the stmts following the 'group'
 952     Each item is a pair of identical variables.
 953
 954   * After typechecking:
 955           [ (x27:Int, x27:[Int]), ..., (z35:Bool, z35:[Bool]) ]
 956     Each pair has the same unique, but different *types*.
 957
 958 Note [ExprStmt]
 959 ~~~~~~~~~~~~~~~
 960 ExprStmts are a bit tricky, because what they mean
 961 depends on the context.  Consider the following contexts:
 962
 963         A do expression of type (m res_ty)
 964         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 965         * ExprStmt E any_ty:   do { ....; E; ... }
 966                 E :: m any_ty
 967           Translation: E >> ...
 968
 969         A list comprehensions of type [elt_ty]
 970         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 971         * ExprStmt E Bool:   [ .. | .... E ]
 972                         [ .. | ..., E, ... ]
 973                         [ .. | .... | ..., E | ... ]
 974                 E :: Bool
 975           Translation: if E then fail else ...
 976
 977         A guard list, guarding a RHS of type rhs_ty
 978         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 979         * ExprStmt E Bool:   f x | ..., E, ... = ...rhs...
 980                 E :: Bool
 981           Translation: if E then fail else ...
 982
 983         A monad comprehension of type (m res_ty)
 984         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 985         * ExprStmt E Bool:   [ .. | .... E ]
 986                 E :: Bool
 987           Translation: guard E >> ...
 988
 989 Array comprehensions are handled like list comprehensions -=chak
 990
 991 Note [How RecStmt works]
 992 ~~~~~~~~~~~~~~~~~~~~~~~~
 993 Example:
 994    HsDo [ BindStmt x ex
 995
 996         , RecStmt { recS_rec_ids   = [a, c]
 997                   , recS_stmts     = [ BindStmt b (return (a,c))
 998                                      , LetStmt a = ...b...
 999                                      , BindStmt c ec ]
1000                   , recS_later_ids = [a, b]
1001
1002         , return (a b) ]
1003
1004 Here, the RecStmt binds a,b,c; but
1005   - Only a,b are used in the stmts *following* the RecStmt,
1006   - Only a,c are used in the stmts *inside* the RecStmt
1007         *before* their bindings
1008
1009 Why do we need *both* rec_ids and later_ids?  For monads they could be
1010 combined into a single set of variables, but not for arrows.  That
1011 follows from the types of the respective feedback operators:
1012
1013         mfix :: MonadFix m => (a -> m a) -> m a
1014         loop :: ArrowLoop a => a (b,d) (c,d) -> a b c
1015
1016 * For mfix, the 'a' covers the union of the later_ids and the rec_ids
1017 * For 'loop', 'c' is the later_ids and 'd' is the rec_ids
1018
1019 Note [Typing a RecStmt]
1020 ~~~~~~~~~~~~~~~~~~~~~~~
1021 A (RecStmt stmts) types as if you had written
1022
1023   (v1,..,vn, _, ..., _) <- mfix (\~(_, ..., _, r1, ..., rm) ->
1024                                  do { stmts
1025                                     ; return (v1,..vn, r1, ..., rm) })
1026
1027 where v1..vn are the later_ids
1028       r1..rm are the rec_ids
1029
1030 Note [Monad Comprehensions]
1031 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
1032 Monad comprehensions require separate functions like 'return' and
1033 '>>=' for desugaring. These functions are stored in the statements
1034 used in monad comprehensions. For example, the 'return' of the 'LastStmt'
1035 expression is used to lift the body of the monad comprehension:
1036
1037   [ body | stmts ]
1038    =>
1039   stmts >>= \bndrs -> return body
1040
1041 In transform and grouping statements ('then ..' and 'then group ..') the
1042 'return' function is required for nested monad comprehensions, for example:
1043
1044   [ body | stmts, then f, rest ]
1045    =>
1046   f [ env | stmts ] >>= \bndrs -> [ body | rest ]
1047
1048 Normal expressions require the 'Control.Monad.guard' function for boolean
1049 expressions:
1050
1051   [ body | exp, stmts ]
1052    =>
1053   guard exp >> [ body | stmts ]
1054
1055 Grouping/parallel statements require the 'Control.Monad.Group.groupM' and
1056 'Control.Monad.Zip.mzip' functions:
1057
1058   [ body | stmts, then group by e, rest]
1059    =>
1060   groupM [ body | stmts ] >>= \bndrs -> [ body | rest ]
1061
1062   [ body | stmts1 | stmts2 | .. ]
1063    =>
1064   mzip stmts1 (mzip stmts2 (..)) >>= \(bndrs1, (bndrs2, ..)) -> return body
1065
1066 In any other context than 'MonadComp', the fields for most of these
1067 'SyntaxExpr's stay bottom.
1068
1069
1070 \begin{code}
1071 instance (OutputableBndr idL, OutputableBndr idR) => Outputable (StmtLR idL idR) where
1072     ppr stmt = pprStmt stmt
1073
1074 pprStmt :: (OutputableBndr idL, OutputableBndr idR) => (StmtLR idL idR) -> SDoc
1075 pprStmt (LastStmt expr _)         = ppr expr
1076 pprStmt (BindStmt pat expr _ _)   = hsep [ppr pat, ptext (sLit "<-"), ppr expr]
1077 pprStmt (LetStmt binds)           = hsep [ptext (sLit "let"), pprBinds binds]
1078 pprStmt (ExprStmt expr _ _ _)     = ppr expr
1079 pprStmt (ParStmt stmtss _ _ _)    = hsep (map doStmts stmtss)
1080   where doStmts stmts = ptext (sLit "| ") <> ppr stmts
1081
1082 pprStmt (TransformStmt stmts bndrs using by _ _)
1083   = sep (ppr_lc_stmts stmts ++ [pprTransformStmt bndrs using by])
1084
1085 pprStmt (GroupStmt stmts _ by using _ _ _)
1086   = sep (ppr_lc_stmts stmts ++ [pprGroupStmt by using])
1087
1088 pprStmt (RecStmt { recS_stmts = segment, recS_rec_ids = rec_ids
1089                  , recS_later_ids = later_ids })
1090   = ptext (sLit "rec") <+>
1091     vcat [ braces (vcat (map ppr segment))
1092          , ifPprDebug (vcat [ ptext (sLit "rec_ids=") <> ppr rec_ids
1093                             , ptext (sLit "later_ids=") <> ppr later_ids])]
1094
1095 pprTransformStmt :: OutputableBndr id => [id] -> LHsExpr id -> Maybe (LHsExpr id) -> SDoc
1096 pprTransformStmt bndrs using by
1097   = sep [ ptext (sLit "then") <+> ifPprDebug (braces (ppr bndrs))
1098         , nest 2 (ppr using)
1099         , nest 2 (pprBy by)]
1100
1101 pprGroupStmt :: OutputableBndr id => Maybe (LHsExpr id)
1102                                   -> Either (LHsExpr id) (SyntaxExpr is)
1103                                   -> SDoc
1104 pprGroupStmt by using
1105   = sep [ ptext (sLit "then group"), nest 2 (pprBy by), nest 2 (ppr_using using)]
1106   where
1107     ppr_using (Right _) = empty
1108     ppr_using (Left e)  = ptext (sLit "using") <+> ppr e
1109
1110 pprBy :: OutputableBndr id => Maybe (LHsExpr id) -> SDoc
1111 pprBy Nothing  = empty
1112 pprBy (Just e) = ptext (sLit "by") <+> ppr e
1113
1114 pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> SDoc
1115 pprDo DoExpr      stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
1116 pprDo GhciStmt    stmts = ptext (sLit "do")  <+> ppr_do_stmts stmts
1117 pprDo MDoExpr     stmts = ptext (sLit "mdo") <+> ppr_do_stmts stmts
1118 pprDo ListComp    stmts = brackets    $ pprComp stmts
1119 pprDo PArrComp    stmts = pa_brackets $ pprComp stmts
1120 pprDo MonadComp   stmts = brackets    $ pprComp stmts
1121 pprDo _           _     = panic "pprDo" -- PatGuard, ParStmtCxt
1122
1123 ppr_do_stmts :: OutputableBndr id => [LStmt id] -> SDoc
1124 -- Print a bunch of do stmts, with explicit braces and semicolons,
1125 -- so that we are not vulnerable to layout bugs
1126 ppr_do_stmts stmts
1127   = lbrace <+> pprDeeperList vcat ([ppr s <> semi | s <- stmts])
1128            <+> rbrace
1129
1130 ppr_lc_stmts :: OutputableBndr id => [LStmt id] -> [SDoc]
1131 ppr_lc_stmts stmts = [ppr s <> comma | s <- stmts]
1132
1133 pprComp :: OutputableBndr id => [LStmt id] -> SDoc
1134 pprComp quals     -- Prints:  body | qual1, ..., qualn
1135   | not (null quals)
1136   , L _ (LastStmt body _) <- last quals
1137   = hang (ppr body <+> char '|') 2 (interpp'SP (dropTail 1 quals))
1138   | otherwise
1139   = pprPanic "pprComp" (interpp'SP quals)
1140 \end{code}
1141
1142 %************************************************************************
1143 %*                                                                      *
1144                 Template Haskell quotation brackets
1145 %*                                                                      *
1146 %************************************************************************
1147
1148 \begin{code}
1149 data HsSplice id  = HsSplice            --  $z  or $(f 4)
1150                         id              -- The id is just a unique name to
1151                         (LHsExpr id)    -- identify this splice point
1152   deriving (Data, Typeable)
1153
1154 instance OutputableBndr id => Outputable (HsSplice id) where
1155   ppr = pprSplice
1156
1157 pprSplice :: OutputableBndr id => HsSplice id -> SDoc
1158 pprSplice (HsSplice n e)
1159     = char '$' <> ifPprDebug (brackets (ppr n)) <> eDoc
1160     where
1161           -- We use pprLExpr to match pprParendExpr:
1162           --     Using pprLExpr makes sure that we go 'deeper'
1163           --     I think that is usually (always?) right
1164           pp_as_was = pprLExpr e
1165           eDoc = case unLoc e of
1166                  HsPar _ -> pp_as_was
1167                  HsVar _ -> pp_as_was
1168                  _ -> parens pp_as_was
1169
1170 data HsBracket id = ExpBr (LHsExpr id)   -- [|  expr  |]
1171                   | PatBr (LPat id)      -- [p| pat   |]
1172                   | DecBrL [LHsDecl id]  -- [d| decls |]; result of parser
1173                   | DecBrG (HsGroup id)  -- [d| decls |]; result of renamer
1174                   | TypBr (LHsType id)   -- [t| type  |]
1175                   | VarBr id             -- 'x, ''T
1176   deriving (Data, Typeable)
1177
1178 instance OutputableBndr id => Outputable (HsBracket id) where
1179   ppr = pprHsBracket
1180
1181
1182 pprHsBracket :: OutputableBndr id => HsBracket id -> SDoc
1183 pprHsBracket (ExpBr e)   = thBrackets empty (ppr e)
1184 pprHsBracket (PatBr p)   = thBrackets (char 'p') (ppr p)
1185 pprHsBracket (DecBrG gp) = thBrackets (char 'd') (ppr gp)
1186 pprHsBracket (DecBrL ds) = thBrackets (char 'd') (vcat (map ppr ds))
1187 pprHsBracket (TypBr t)   = thBrackets (char 't') (ppr t)
1188 pprHsBracket (VarBr n)   = char '\'' <> ppr n
1189 -- Infelicity: can't show ' vs '', because
1190 -- we can't ask n what its OccName is, because the
1191 -- pretty-printer for HsExpr doesn't ask for NamedThings
1192 -- But the pretty-printer for names will show the OccName class
1193
1194 thBrackets :: SDoc -> SDoc -> SDoc
1195 thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+>
1196                              pp_body <+> ptext (sLit "|]")
1197 \end{code}
1198
1199 %************************************************************************
1200 %*                                                                      *
1201 \subsection{Enumerations and list comprehensions}
1202 %*                                                                      *
1203 %************************************************************************
1204
1205 \begin{code}
1206 data ArithSeqInfo id
1207   = From            (LHsExpr id)
1208   | FromThen        (LHsExpr id)
1209                     (LHsExpr id)
1210   | FromTo          (LHsExpr id)
1211                     (LHsExpr id)
1212   | FromThenTo      (LHsExpr id)
1213                     (LHsExpr id)
1214                     (LHsExpr id)
1215   deriving (Data, Typeable)
1216 \end{code}
1217
1218 \begin{code}
1219 instance OutputableBndr id => Outputable (ArithSeqInfo id) where
1220     ppr (From e1)             = hcat [ppr e1, pp_dotdot]
1221     ppr (FromThen e1 e2)      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
1222     ppr (FromTo e1 e3)        = hcat [ppr e1, pp_dotdot, ppr e3]
1223     ppr (FromThenTo e1 e2 e3)
1224       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
1225
1226 pp_dotdot :: SDoc
1227 pp_dotdot = ptext (sLit " .. ")
1228 \end{code}
1229
1230
1231 %************************************************************************
1232 %*                                                                      *
1233 \subsection{HsMatchCtxt}
1234 %*                                                                      *
1235 %************************************************************************
1236
1237 \begin{code}
1238 data HsMatchContext id  -- Context of a Match
1239   = FunRhs id Bool              -- Function binding for f; True <=> written infix
1240   | LambdaExpr                  -- Patterns of a lambda
1241   | CaseAlt                     -- Patterns and guards on a case alternative
1242   | ProcExpr                    -- Patterns of a proc
1243   | PatBindRhs                  -- A pattern binding  eg [y] <- e = e
1244
1245   | RecUpd                      -- Record update [used only in DsExpr to
1246                                 --    tell matchWrapper what sort of
1247                                 --    runtime error message to generate]
1248
1249   | StmtCtxt (HsStmtContext id) -- Pattern of a do-stmt, list comprehension,
1250                                 -- pattern guard, etc
1251
1252   | ThPatQuote                  -- A Template Haskell pattern quotation [p| (a,b) |]
1253   deriving (Data, Typeable)
1254
1255 data HsStmtContext id
1256   = ListComp
1257   | MonadComp
1258   | PArrComp                             -- Parallel array comprehension
1259
1260   | DoExpr                               -- do { ... }
1261   | MDoExpr                              -- mdo { ... }  ie recursive do-expression
1262
1263   | GhciStmt                             -- A command-line Stmt in GHCi pat <- rhs
1264   | PatGuard (HsMatchContext id)         -- Pattern guard for specified thing
1265   | ParStmtCtxt (HsStmtContext id)       -- A branch of a parallel stmt
1266   | TransformStmtCtxt (HsStmtContext id) -- A branch of a transform stmt
1267   deriving (Data, Typeable)
1268 \end{code}
1269
1270 \begin{code}
1271 isDoExpr :: HsStmtContext id -> Bool
1272 isDoExpr DoExpr  = True
1273 isDoExpr MDoExpr = True
1274 isDoExpr _       = False
1275
1276 isListCompExpr :: HsStmtContext id -> Bool
1277 isListCompExpr ListComp  = True
1278 isListCompExpr PArrComp  = True
1279 isListCompExpr MonadComp = True
1280 isListCompExpr _         = False
1281
1282 isMonadCompExpr :: HsStmtContext id -> Bool
1283 isMonadCompExpr MonadComp                = True
1284 isMonadCompExpr (ParStmtCtxt ctxt)       = isMonadCompExpr ctxt
1285 isMonadCompExpr (TransformStmtCtxt ctxt) = isMonadCompExpr ctxt
1286 isMonadCompExpr _                        = False
1287 \end{code}
1288
1289 \begin{code}
1290 matchSeparator :: HsMatchContext id -> SDoc
1291 matchSeparator (FunRhs {})  = ptext (sLit "=")
1292 matchSeparator CaseAlt      = ptext (sLit "->")
1293 matchSeparator LambdaExpr   = ptext (sLit "->")
1294 matchSeparator ProcExpr     = ptext (sLit "->")
1295 matchSeparator PatBindRhs   = ptext (sLit "=")
1296 matchSeparator (StmtCtxt _) = ptext (sLit "<-")
1297 matchSeparator RecUpd       = panic "unused"
1298 matchSeparator ThPatQuote   = panic "unused"
1299 \end{code}
1300
1301 \begin{code}
1302 pprMatchContext :: Outputable id => HsMatchContext id -> SDoc
1303 pprMatchContext ctxt
1304   | want_an ctxt = ptext (sLit "an") <+> pprMatchContextNoun ctxt
1305   | otherwise    = ptext (sLit "a")  <+> pprMatchContextNoun ctxt
1306   where
1307     want_an (FunRhs {}) = True  -- Use "an" in front
1308     want_an ProcExpr    = True
1309     want_an _           = False
1310
1311 pprMatchContextNoun :: Outputable id => HsMatchContext id -> SDoc
1312 pprMatchContextNoun (FunRhs fun _)  = ptext (sLit "equation for")
1313                                       <+> quotes (ppr fun)
1314 pprMatchContextNoun CaseAlt         = ptext (sLit "case alternative")
1315 pprMatchContextNoun RecUpd          = ptext (sLit "record-update construct")
1316 pprMatchContextNoun ThPatQuote      = ptext (sLit "Template Haskell pattern quotation")
1317 pprMatchContextNoun PatBindRhs      = ptext (sLit "pattern binding")
1318 pprMatchContextNoun LambdaExpr      = ptext (sLit "lambda abstraction")
1319 pprMatchContextNoun ProcExpr        = ptext (sLit "arrow abstraction")
1320 pprMatchContextNoun (StmtCtxt ctxt) = ptext (sLit "pattern binding in")
1321                                       $$ pprStmtContext ctxt
1322
1323 pprStmtContext :: Outputable id => HsStmtContext id -> SDoc
1324 pprStmtContext (ParStmtCtxt c)
1325  = sep [ptext (sLit "a parallel branch of"), pprStmtContext c]
1326 pprStmtContext (TransformStmtCtxt c)
1327  = sep [ptext (sLit "a transformed branch of"), pprStmtContext c]
1328 pprStmtContext (PatGuard ctxt)
1329  = ptext (sLit "a pattern guard for") $$ pprMatchContext ctxt
1330 pprStmtContext GhciStmt        = ptext (sLit "an interactive GHCi command")
1331 pprStmtContext DoExpr          = ptext (sLit "a 'do' expression")
1332 pprStmtContext MDoExpr         = ptext (sLit "an 'mdo' expression")
1333 pprStmtContext ListComp        = ptext (sLit "a list comprehension")
1334 pprStmtContext MonadComp       = ptext (sLit "a monad comprehension")
1335 pprStmtContext PArrComp        = ptext (sLit "an array comprehension")
1336
1337 {-
1338 pprMatchRhsContext (FunRhs fun) = ptext (sLit "a right-hand side of function") <+> quotes (ppr fun)
1339 pprMatchRhsContext CaseAlt      = ptext (sLit "the body of a case alternative")
1340 pprMatchRhsContext PatBindRhs   = ptext (sLit "the right-hand side of a pattern binding")
1341 pprMatchRhsContext LambdaExpr   = ptext (sLit "the body of a lambda")
1342 pprMatchRhsContext ProcExpr     = ptext (sLit "the body of a proc")
1343 pprMatchRhsContext other        = panic "pprMatchRhsContext"    -- RecUpd, StmtCtxt
1344
1345 -- Used for the result statement of comprehension
1346 -- e.g. the 'e' in      [ e | ... ]
1347 --      or the 'r' in   f x = r
1348 pprStmtResultContext (PatGuard ctxt) = pprMatchRhsContext ctxt
1349 pprStmtResultContext other           = ptext (sLit "the result of") <+> pprStmtContext other
1350 -}
1351
1352 -- Used to generate the string for a *runtime* error message
1353 matchContextErrString :: Outputable id => HsMatchContext id -> SDoc
1354 matchContextErrString (FunRhs fun _)             = ptext (sLit "function") <+> ppr fun
1355 matchContextErrString CaseAlt                    = ptext (sLit "case")
1356 matchContextErrString PatBindRhs                 = ptext (sLit "pattern binding")
1357 matchContextErrString RecUpd                     = ptext (sLit "record update")
1358 matchContextErrString LambdaExpr                 = ptext (sLit "lambda")
1359 matchContextErrString ProcExpr                   = ptext (sLit "proc")
1360 matchContextErrString ThPatQuote                 = panic "matchContextErrString"  -- Not used at runtime
1361 matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
1362 matchContextErrString (StmtCtxt (TransformStmtCtxt c)) = matchContextErrString (StmtCtxt c)
1363 matchContextErrString (StmtCtxt (PatGuard _))    = ptext (sLit "pattern guard")
1364 matchContextErrString (StmtCtxt GhciStmt)        = ptext (sLit "interactive GHCi command")
1365 matchContextErrString (StmtCtxt DoExpr)          = ptext (sLit "'do' expression")
1366 matchContextErrString (StmtCtxt MDoExpr)         = ptext (sLit "'mdo' expression")
1367 matchContextErrString (StmtCtxt ListComp)        = ptext (sLit "list comprehension")
1368 matchContextErrString (StmtCtxt MonadComp)       = ptext (sLit "monad comprehension")
1369 matchContextErrString (StmtCtxt PArrComp)        = ptext (sLit "array comprehension")
1370 \end{code}
1371
1372 \begin{code}
1373 pprMatchInCtxt :: (OutputableBndr idL, OutputableBndr idR)
1374                => HsMatchContext idL -> Match idR -> SDoc
1375 pprMatchInCtxt ctxt match  = hang (ptext (sLit "In") <+> pprMatchContext ctxt <> colon)
1376                              4 (pprMatch ctxt match)
1377
1378 pprStmtInCtxt :: (OutputableBndr idL, OutputableBndr idR)
1379                => HsStmtContext idL -> StmtLR idL idR -> SDoc
1380 pprStmtInCtxt ctxt stmt = hang (ptext (sLit "In a stmt of") <+> pprStmtContext ctxt <> colon)
1381                           4 (ppr_stmt stmt)
1382   where
1383     -- For Group and Transform Stmts, don't print the nested stmts!
1384     ppr_stmt (GroupStmt _ _ by using _ _ _)       = pprGroupStmt by using
1385     ppr_stmt (TransformStmt _ bndrs using by _ _) = pprTransformStmt bndrs using by
1386     ppr_stmt stmt                                 = pprStmt stmt
1387 \end{code}