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