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