HsExpr.hs 113 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4 5
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}

6
{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
7 8 9 10 11
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
                                      -- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
12
{-# LANGUAGE ExistentialQuantification #-}
13
{-# LANGUAGE DeriveFunctor #-}
14
{-# LANGUAGE TypeFamilies #-}
15 16

-- | Abstract Haskell syntax for expressions.
17 18
module HsExpr where

19
#include "HsVersions.h"
20 21

-- friends:
22 23
import GhcPrelude

24 25 26
import HsDecls
import HsPat
import HsLit
27 28
import PlaceHolder ( NameOrRdrName )
import HsExtension
29 30
import HsTypes
import HsBinds
31 32

-- others:
33
import TcEvidence
34
import CoreSyn
35
import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )
36
import Name
37
import NameSet
38
import RdrName  ( GlobalRdrEnv )
39
import BasicTypes
Matthew Pickering's avatar
Matthew Pickering committed
40
import ConLike
41
import SrcLoc
42
import Util
Ian Lynagh's avatar
Ian Lynagh committed
43
import Outputable
44
import FastString
45
import Type
46 47
import TcType (TcType)
import {-# SOURCE #-} TcRnTypes (TcLclEnv)
48 49

-- libraries:
50
import Data.Data hiding (Fixity(..))
51
import qualified Data.Data as Data (Fixity(..))
Simon Marlow's avatar
Simon Marlow committed
52
import Data.Maybe (isNothing)
53

54 55 56
import GHCi.RemoteTypes ( ForeignRef )
import qualified Language.Haskell.TH as TH (Q)

Austin Seipp's avatar
Austin Seipp committed
57 58 59
{-
************************************************************************
*                                                                      *
60
\subsection{Expressions proper}
Austin Seipp's avatar
Austin Seipp committed
61 62 63
*                                                                      *
************************************************************************
-}
64

65 66
-- * Expressions proper

67
-- | Located Haskell Expression
68
type LHsExpr p = Located (HsExpr p)
Alan Zimmerman's avatar
Alan Zimmerman committed
69 70
  -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
  --   in a list
71

72 73
  -- For details on above see note [Api annotations] in ApiAnnotation

74
-------------------------
75 76 77
-- | Post-Type checking Expression
--
-- PostTcExpr is an evidence expression attached to the syntax tree by the
78
-- type checker (c.f. postTcType).
79
type PostTcExpr  = HsExpr GhcTc
80 81 82 83

-- | Post-Type checking Table
--
-- We use a PostTcTable where there are a bunch of pieces of evidence, more
84
-- than is convenient to keep individually.
85
type PostTcTable = [(Name, PostTcExpr)]
86 87

-------------------------
88 89 90
-- | Syntax Expression
--
-- SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,
Ian Lynagh's avatar
Ian Lynagh committed
91
-- by the renamer.  It's used for rebindable syntax.
92 93 94
--
-- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for
--      @(>>=)@, and then instantiated by the type checker with its type args
95
--      etc
96 97 98 99 100 101 102
--
-- This should desugar to
--
-- > syn_res_wrap $ syn_expr (syn_arg_wraps[0] arg0)
-- >                         (syn_arg_wraps[1] arg1) ...
--
-- where the actual arguments come from elsewhere in the AST.
103
-- This could be defined using @GhcPass p@ and such, but it's
104 105
-- harder to get it all to work out that way. ('noSyntaxExpr' is hard to
-- write, for example.)
106 107 108
data SyntaxExpr p = SyntaxExpr { syn_expr      :: HsExpr p
                               , syn_arg_wraps :: [HsWrapper]
                               , syn_res_wrap  :: HsWrapper }
109

110 111
-- | This is used for rebindable-syntax pieces that are too polymorphic
-- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
112
noExpr :: HsExpr (GhcPass p)
113
noExpr = HsLit noExt (HsString (SourceText  "noExpr") (fsLit "noExpr"))
114

115
noSyntaxExpr :: SyntaxExpr (GhcPass p)
116
                              -- Before renaming, and sometimes after,
Ian Lynagh's avatar
Ian Lynagh committed
117
                              -- (if the syntax slot makes no sense)
118
noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit noExt (HsString NoSourceText
119
                                                        (fsLit "noSyntaxExpr"))
120 121 122
                          , syn_arg_wraps = []
                          , syn_res_wrap  = WpHole }

123 124 125 126 127 128
-- | Make a 'SyntaxExpr (HsExpr _)', missing its HsWrappers.
mkSyntaxExpr :: HsExpr (GhcPass p) -> SyntaxExpr (GhcPass p)
mkSyntaxExpr expr = SyntaxExpr { syn_expr      = expr
                               , syn_arg_wraps = []
                               , syn_res_wrap  = WpHole }

129 130
-- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the
-- renamer), missing its HsWrappers.
131
mkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn
132
mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExt $ noLoc name
133 134 135
  -- don't care about filling in syn_arg_wraps because we're clearly
  -- not past the typechecker

136 137
instance (p ~ GhcPass pass, OutputableBndrId p)
       => Outputable (SyntaxExpr p) where
138 139 140 141 142 143
  ppr (SyntaxExpr { syn_expr      = expr
                  , syn_arg_wraps = arg_wraps
                  , syn_res_wrap  = res_wrap })
    = sdocWithDynFlags $ \ dflags ->
      getPprStyle $ \s ->
      if debugStyle s || gopt Opt_PrintExplicitCoercions dflags
144 145
      then ppr expr <> braces (pprWithCommas ppr arg_wraps)
                    <> braces (ppr res_wrap)
146 147
      else ppr expr

148
-- | Command Syntax Table (for Arrow syntax)
149
type CmdSyntaxTable p = [(Name, HsExpr p)]
150
-- See Note [CmdSyntaxTable]
151

Austin Seipp's avatar
Austin Seipp committed
152
{-
153 154 155 156 157
Note [CmdSyntaxtable]
~~~~~~~~~~~~~~~~~~~~~
Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps
track of the methods needed for a Cmd.

158
* Before the renamer, this list is an empty list
159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185

* After the renamer, it takes the form @[(std_name, HsVar actual_name)]@
  For example, for the 'arr' method
   * normal case:            (GHC.Control.Arrow.arr, HsVar GHC.Control.Arrow.arr)
   * with rebindable syntax: (GHC.Control.Arrow.arr, arr_22)
             where @arr_22@ is whatever 'arr' is in scope

* After the type checker, it takes the form [(std_name, <expression>)]
  where <expression> is the evidence for the method.  This evidence is
  instantiated with the class, but is still polymorphic in everything
  else.  For example, in the case of 'arr', the evidence has type
         forall b c. (b->c) -> a b c
  where 'a' is the ambient type of the arrow.  This polymorphism is
  important because the desugarer uses the same evidence at multiple
  different types.

This is Less Cool than what we normally do for rebindable syntax, which is to
make fully-instantiated piece of evidence at every use site.  The Cmd way
is Less Cool because
  * The renamer has to predict which methods are needed.
    See the tedious RnExpr.methodNamesCmd.

  * The desugarer has to know the polymorphic type of the instantiated
    method. This is checked by Inst.tcSyntaxName, but is less flexible
    than the rest of rebindable syntax, where the type is less
    pre-ordained.  (And this flexibility is useful; for example we can
    typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.)
Austin Seipp's avatar
Austin Seipp committed
186
-}
187

188 189 190 191 192 193 194 195 196
-- | An unbound variable; used for treating
-- out-of-scope variables as expression holes
--
-- Either "x", "y"     Plain OutOfScope
-- or     "_", "_x"    A TrueExprHole
--
-- Both forms indicate an out-of-scope variable,  but the latter
-- indicates that the user /expects/ it to be out of scope, and
-- just wants GHC to report its type
197 198 199 200 201 202 203 204 205
data UnboundVar
  = OutOfScope OccName GlobalRdrEnv  -- ^ An (unqualified) out-of-scope
                                     -- variable, together with the GlobalRdrEnv
                                     -- with respect to which it is unbound

                                     -- See Note [OutOfScope and GlobalRdrEnv]

  | TrueExprHole OccName             -- ^ A "true" expression hole (_ or _x)

206
  deriving Data
207 208

instance Outputable UnboundVar where
209 210
    ppr (OutOfScope occ _) = text "OutOfScope" <> parens (ppr occ)
    ppr (TrueExprHole occ) = text "ExprHole"   <> parens (ppr occ)
211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285

unboundVarOcc :: UnboundVar -> OccName
unboundVarOcc (OutOfScope occ _) = occ
unboundVarOcc (TrueExprHole occ) = occ

{-
Note [OutOfScope and GlobalRdrEnv]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
To understand why we bundle a GlobalRdrEnv with an out-of-scope variable,
consider the following module:

    module A where

    foo :: ()
    foo = bar

    bat :: [Double]
    bat = [1.2, 3.4]

    $(return [])

    bar = ()
    bad = False

When A is compiled, the renamer determines that `bar` is not in scope in the
declaration of `foo` (since `bar` is declared in the following inter-splice
group).  Once it has finished typechecking the entire module, the typechecker
then generates the associated error message, which specifies both the type of
`bar` and a list of possible in-scope alternatives:

    A.hs:6:7: error:
        • Variable not in scope: bar :: ()
        • ‘bar’ (line 13) is not in scope before the splice on line 11
          Perhaps you meant ‘bat’ (line 9)

When it calls RnEnv.unknownNameSuggestions to identify these alternatives, the
typechecker must provide a GlobalRdrEnv.  If it provided the current one, which
contains top-level declarations for the entire module, the error message would
incorrectly suggest the out-of-scope `bar` and `bad` as possible alternatives
for `bar` (see Trac #11680).  Instead, the typechecker must use the same
GlobalRdrEnv the renamer used when it determined that `bar` is out-of-scope.

To obtain this GlobalRdrEnv, can the typechecker simply use the out-of-scope
`bar`'s location to either reconstruct it (from the current GlobalRdrEnv) or to
look it up in some global store?  Unfortunately, no.  The problem is that
location information is not always sufficient for this task.  This is most
apparent when dealing with the TH function addTopDecls, which adds its
declarations to the FOLLOWING inter-splice group.  Consider these declarations:

    ex9 = cat               -- cat is NOT in scope here

    $(do -------------------------------------------------------------
        ds <- [d| f = cab   -- cat and cap are both in scope here
                  cat = ()
                |]
        addTopDecls ds
        [d| g = cab         -- only cap is in scope here
            cap = True
          |])

    ex10 = cat              -- cat is NOT in scope here

    $(return []) -----------------------------------------------------

    ex11 = cat              -- cat is in scope

Here, both occurrences of `cab` are out-of-scope, and so the typechecker needs
the GlobalRdrEnvs which were used when they were renamed.  These GlobalRdrEnvs
are different (`cat` is present only in the GlobalRdrEnv for f's `cab'), but the
locations of the two `cab`s are the same (they are both created in the same
splice).  Thus, we must include some additional information with each `cab` to
allow the typechecker to obtain the correct GlobalRdrEnv.  Clearly, the simplest
information to use is the GlobalRdrEnv itself.
-}

286
-- | A Haskell expression.
287
data HsExpr p
288 289
  = HsVar     (XVar p)
              (Located (IdP p)) -- ^ Variable
290

291 292
                             -- See Note [Located RdrNames]

293 294
  | HsUnboundVar (XUnboundVar p)
                 UnboundVar  -- ^ Unbound variable; also used for "holes"
295 296 297 298 299 300
                             --   (_ or _x).
                             -- Turned from HsVar to HsUnboundVar by the
                             --   renamer, when it finds an out-of-scope
                             --   variable or hole.
                             -- Turned into HsVar by type checker, to support
                             --   deferred type errors.
301

302 303
  | HsConLikeOut (XConLikeOut p)
                 ConLike     -- ^ After typechecker only; must be different
304 305
                             -- HsVar for pretty printing

306 307
  | HsRecFld  (XRecFld p)
              (AmbiguousFieldOcc p) -- ^ Variable pointing to record selector
308
                                    -- Not in use after typechecking
309

310 311
  | HsOverLabel (XOverLabel p)
                (Maybe (IdP p)) FastString
312 313 314 315
     -- ^ Overloaded label (Note [Overloaded labels] in GHC.OverloadedLabels)
     --   @Just id@ means @RebindableSyntax@ is in use, and gives the id of the
     --   in-scope 'fromLabel'.
     --   NB: Not in use after typechecking
316

317 318 319 320
  | HsIPVar   (XIPVar p)
              HsIPName   -- ^ Implicit parameter (not in use after typechecking)
  | HsOverLit (XOverLitE p)
              (HsOverLit p)  -- ^ Overloaded literals
321

322 323
  | HsLit     (XLitE p)
              (HsLit p)      -- ^ Simple (non-overloaded) literals
324

325 326
  | HsLam     (XLam p)
              (MatchGroup p (LHsExpr p))
327
                       -- ^ Lambda abstraction. Currently always a single match
Alan Zimmerman's avatar
Alan Zimmerman committed
328 329 330
       --
       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
       --       'ApiAnnotation.AnnRarrow',
331

332 333
       -- For details on above see note [Api annotations] in ApiAnnotation

334
  | HsLamCase (XLamCase p) (MatchGroup p (LHsExpr p)) -- ^ Lambda-case
Alan Zimmerman's avatar
Alan Zimmerman committed
335 336 337 338
       --
       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
       --           'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',
       --           'ApiAnnotation.AnnClose'
Alan Zimmerman's avatar
Alan Zimmerman committed
339

340 341
       -- For details on above see note [Api annotations] in ApiAnnotation

342
  | HsApp     (XApp p) (LHsExpr p) (LHsExpr p) -- ^ Application
343

344
  | HsAppType (XAppTypeE p) (LHsExpr p) (LHsWcType (NoGhcTc p))  -- ^ Visible type application
345 346 347 348 349 350
       --
       -- Explicit type argument; e.g  f @Int x y
       -- NB: Has wildcards, but no implicit quantification
       --
       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt',

351
  -- | Operator applications:
352 353
  -- NB Bracketed ops such as (+) come out as Vars.

354 355 356
  -- NB We need an expr for the operator in an OpApp/Section since
  -- the typechecker may need to apply the operator to a few types.

357 358
  | OpApp       (XOpApp p)
                (LHsExpr p)       -- left operand
359 360
                (LHsExpr p)       -- operator
                (LHsExpr p)       -- right operand
Ian Lynagh's avatar
Ian Lynagh committed
361

362
  -- | Negation operator. Contains the negated expression and the name
Alan Zimmerman's avatar
Alan Zimmerman committed
363 364 365
  -- of 'negate'
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'
366 367

  -- For details on above see note [Api annotations] in ApiAnnotation
368 369
  | NegApp      (XNegApp p)
                (LHsExpr p)
370
                (SyntaxExpr p)
Alan Zimmerman's avatar
Alan Zimmerman committed
371

Alan Zimmerman's avatar
Alan Zimmerman committed
372 373
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
  --             'ApiAnnotation.AnnClose' @')'@
374 375

  -- For details on above see note [Api annotations] in ApiAnnotation
376 377
  | HsPar       (XPar p)
                (LHsExpr p)  -- ^ Parenthesised expr; see Note [Parens in HsSyn]
Ian Lynagh's avatar
Ian Lynagh committed
378

379 380
  | SectionL    (XSectionL p)
                (LHsExpr p)    -- operand; see Note [Sections in HsSyn]
381
                (LHsExpr p)    -- operator
382 383
  | SectionR    (XSectionR p)
                (LHsExpr p)    -- operator; see Note [Sections in HsSyn]
384
                (LHsExpr p)    -- operand
Ian Lynagh's avatar
Ian Lynagh committed
385

386
  -- | Used for explicit tuples and sections thereof
Alan Zimmerman's avatar
Alan Zimmerman committed
387 388 389
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
  --         'ApiAnnotation.AnnClose'
390 391

  -- For details on above see note [Api annotations] in ApiAnnotation
392
  | ExplicitTuple
393
        (XExplicitTuple p)
394
        [LHsTupArg p]
395 396
        Boxity

397 398 399 400 401 402 403
  -- | Used for unboxed sum types
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(#'@,
  --          'ApiAnnotation.AnnVbar', 'ApiAnnotation.AnnClose' @'#)'@,
  --
  --  There will be multiple 'ApiAnnotation.AnnVbar', (1 - alternative) before
  --  the expression, (arity - alternative) after it
404
  | ExplicitSum
405
          (XExplicitSum p)
406 407
          ConTag --  Alternative (one-based)
          Arity  --  Sum arity
408
          (LHsExpr p)
409

Alan Zimmerman's avatar
Alan Zimmerman committed
410
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
Alan Zimmerman's avatar
Alan Zimmerman committed
411 412
  --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
  --       'ApiAnnotation.AnnClose' @'}'@
413 414

  -- For details on above see note [Api annotations] in ApiAnnotation
415 416
  | HsCase      (XCase p)
                (LHsExpr p)
417
                (MatchGroup p (LHsExpr p))
Ian Lynagh's avatar
Ian Lynagh committed
418

Alan Zimmerman's avatar
Alan Zimmerman committed
419 420
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
  --       'ApiAnnotation.AnnSemi',
Alan Zimmerman's avatar
Alan Zimmerman committed
421
  --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
Alan Zimmerman's avatar
Alan Zimmerman committed
422
  --       'ApiAnnotation.AnnElse',
423 424

  -- For details on above see note [Api annotations] in ApiAnnotation
425 426
  | HsIf        (XIf p)
                (Maybe (SyntaxExpr p)) -- cond function
427 428
                                        -- Nothing => use the built-in 'if'
                                        -- See Note [Rebindable if]
429 430 431
                (LHsExpr p)    --  predicate
                (LHsExpr p)    --  then part
                (LHsExpr p)    --  else part
Ian Lynagh's avatar
Ian Lynagh committed
432

433
  -- | Multi-way if
Alan Zimmerman's avatar
Alan Zimmerman committed
434 435 436
  --
  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf'
  --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
437 438

  -- For details on above see note [Api annotations] in ApiAnnotation
439
  | HsMultiIf   (XMultiIf p) [LGRHS p (LHsExpr p)]
440

441
  -- | let(rec)
Alan Zimmerman's avatar
Alan Zimmerman committed
442 443
  --
  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
Alan Zimmerman's avatar
Alan Zimmerman committed
444 445
  --       'ApiAnnotation.AnnOpen' @'{'@,
  --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
446 447

  -- For details on above see note [Api annotations] in ApiAnnotation
448 449
  | HsLet       (XLet p)
                (LHsLocalBinds p)
450
                (LHsExpr  p)
Ian Lynagh's avatar
Ian Lynagh committed
451

Alan Zimmerman's avatar
Alan Zimmerman committed
452 453 454 455
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
  --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
  --             'ApiAnnotation.AnnVbar',
  --             'ApiAnnotation.AnnClose'
456 457

  -- For details on above see note [Api annotations] in ApiAnnotation
458 459
  | HsDo        (XDo p)                  -- Type of the whole expression
                (HsStmtContext Name)     -- The parameterisation is unimportant
460 461
                                         -- because in this context we never use
                                         -- the PatGuard or ParStmt variant
462
                (Located [ExprLStmt p]) -- "do":one or more stmts
Ian Lynagh's avatar
Ian Lynagh committed
463

464
  -- | Syntactic list: [a,b,c,...]
Alan Zimmerman's avatar
Alan Zimmerman committed
465
  --
Alan Zimmerman's avatar
Alan Zimmerman committed
466 467
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
  --              'ApiAnnotation.AnnClose' @']'@
468 469

  -- For details on above see note [Api annotations] in ApiAnnotation
470
  | ExplicitList
471
                (XExplicitList p)  -- Gives type of components of list
472 473 474
                (Maybe (SyntaxExpr p))
                                   -- For OverloadedLists, the fromListN witness
                [LHsExpr p]
Ian Lynagh's avatar
Ian Lynagh committed
475

476
  -- | Record construction
Alan Zimmerman's avatar
Alan Zimmerman committed
477
  --
Alan Zimmerman's avatar
Alan Zimmerman committed
478 479
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
  --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
480 481

  -- For details on above see note [Api annotations] in ApiAnnotation
482
  | RecordCon
483 484
      { rcon_ext      :: XRecordCon p
      , rcon_con_name :: Located (IdP p)    -- The constructor name;
485
                                            --  not used after type checking
486
      , rcon_flds     :: HsRecordBinds p }  -- The fields
Ian Lynagh's avatar
Ian Lynagh committed
487

488
  -- | Record update
Alan Zimmerman's avatar
Alan Zimmerman committed
489
  --
Alan Zimmerman's avatar
Alan Zimmerman committed
490 491
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
  --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
492 493

  -- For details on above see note [Api annotations] in ApiAnnotation
494
  | RecordUpd
495 496
      { rupd_ext  :: XRecordUpd p
      , rupd_expr :: LHsExpr p
497
      , rupd_flds :: [LHsRecUpdField p]
498
      }
Ian Lynagh's avatar
Ian Lynagh committed
499 500 501
  -- For a type family, the arg types are of the *instance* tycon,
  -- not the family tycon

Alan Zimmerman's avatar
Alan Zimmerman committed
502 503 504
  -- | Expression with an explicit type signature. @e :: type@
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
505 506

  -- For details on above see note [Api annotations] in ApiAnnotation
Alan Zimmerman's avatar
Alan Zimmerman committed
507
  | ExprWithTySig
508 509
                (XExprWithTySig p)

510
                (LHsExpr p)
511
                (LHsSigWcType (NoGhcTc p))
Ian Lynagh's avatar
Ian Lynagh committed
512

513
  -- | Arithmetic sequence
Alan Zimmerman's avatar
Alan Zimmerman committed
514
  --
Alan Zimmerman's avatar
Alan Zimmerman committed
515 516 517
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
  --              'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',
  --              'ApiAnnotation.AnnClose' @']'@
518 519

  -- For details on above see note [Api annotations] in ApiAnnotation
Alan Zimmerman's avatar
Alan Zimmerman committed
520
  | ArithSeq
521
                (XArithSeq p)
522 523 524
                (Maybe (SyntaxExpr p))
                                  -- For OverloadedLists, the fromList witness
                (ArithSeqInfo p)
Ian Lynagh's avatar
Ian Lynagh committed
525

526
  -- For details on above see note [Api annotations] in ApiAnnotation
527 528
  | HsSCC       (XSCC p)
                SourceText            -- Note [Pragma source text] in BasicTypes
529
                StringLiteral         -- "set cost centre" SCC pragma
530
                (LHsExpr p)           -- expr whose cost is to be measured
Alan Zimmerman's avatar
Alan Zimmerman committed
531 532 533

  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CORE'@,
  --             'ApiAnnotation.AnnVal', 'ApiAnnotation.AnnClose' @'\#-}'@
534 535

  -- For details on above see note [Api annotations] in ApiAnnotation
536 537
  | HsCoreAnn   (XCoreAnn p)
                SourceText            -- Note [Pragma source text] in BasicTypes
538
                StringLiteral         -- hdaume: core annotation
539
                (LHsExpr p)
Ian Lynagh's avatar
Ian Lynagh committed
540

541
  -----------------------------------------------------------
542
  -- MetaHaskell Extensions
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
543

Alan Zimmerman's avatar
Alan Zimmerman committed
544
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
545 546
  --         'ApiAnnotation.AnnOpenE','ApiAnnotation.AnnOpenEQ',
  --         'ApiAnnotation.AnnClose','ApiAnnotation.AnnCloseQ'
547 548

  -- For details on above see note [Api annotations] in ApiAnnotation
549
  | HsBracket    (XBracket p) (HsBracket p)
550

551 552
    -- See Note [Pending Splices]
  | HsRnBracketOut
553
      (XRnBracketOut p)
554
      (HsBracket GhcRn)    -- Output of the renamer is the *original* renamed
555 556
                           -- expression, plus
      [PendingRnSplice]    -- _renamed_ splices to be type checked
gmainland's avatar
gmainland committed
557

558
  | HsTcBracketOut
559
      (XTcBracketOut p)
560
      (HsBracket GhcRn)    -- Output of the type checker is the *original*
561 562 563
                           -- renamed expression, plus
      [PendingTcSplice]    -- _typechecked_ splices to be
                           -- pasted back in by the desugarer
564

Alan Zimmerman's avatar
Alan Zimmerman committed
565 566
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
  --         'ApiAnnotation.AnnClose'
567 568

  -- For details on above see note [Api annotations] in ApiAnnotation
569
  | HsSpliceE  (XSpliceE p) (HsSplice p)
570

571 572 573
  -----------------------------------------------------------
  -- Arrow notation extension

574
  -- | @proc@ notation for Arrows
Alan Zimmerman's avatar
Alan Zimmerman committed
575 576 577
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnProc',
  --          'ApiAnnotation.AnnRarrow'
578 579

  -- For details on above see note [Api annotations] in ApiAnnotation
580 581
  | HsProc      (XProc p)
                (LPat p)               -- arrow abstraction, proc
582 583
                (LHsCmdTop p)          -- body of the abstraction
                                       -- always has an empty stack
584

585 586
  ---------------------------------------
  -- static pointers extension
Alan Zimmerman's avatar
Alan Zimmerman committed
587
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',
588 589

  -- For details on above see note [Api annotations] in ApiAnnotation
590
  | HsStatic (XStatic p) -- Free variables of the body
591
             (LHsExpr p)        -- Body
592

593 594
  ---------------------------------------
  -- The following are commands, not expressions proper
595
  -- They are only used in the parsing stage and are removed
596
  --    immediately in parser.RdrHsSyn.checkCommand
Alan Zimmerman's avatar
Alan Zimmerman committed
597 598 599 600

  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.Annlarrowtail',
  --          'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',
  --          'ApiAnnotation.AnnRarrowtail'
601 602

  -- For details on above see note [Api annotations] in ApiAnnotation
603
  | HsArrApp             -- Arrow tail, or arrow application (f -< arg)
604 605
        (XArrApp p)     -- type of the arrow expressions f,
                        -- of the form a t t', where arg :: t
606 607 608 609 610
        (LHsExpr p)     -- arrow expression, f
        (LHsExpr p)     -- input expression, arg
        HsArrAppType    -- higher-order (-<<) or first-order (-<)
        Bool            -- True => right-to-left (f -< arg)
                        -- False => left-to-right (arg >- f)
611

612 613
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpenB' @'(|'@,
  --         'ApiAnnotation.AnnCloseB' @'|)'@
614 615

  -- For details on above see note [Api annotations] in ApiAnnotation
616
  | HsArrForm            -- Command formation,  (| e cmd1 .. cmdn |)
617
        (XArrForm p)
618
        (LHsExpr p)      -- the operator
619 620 621 622
                         -- after type-checking, a type abstraction to be
                         -- applied to the type of the local environment tuple
        (Maybe Fixity)   -- fixity (filled in by the renamer), for forms that
                         -- were converted from OpApp's by the renamer
623
        [LHsCmdTop p]    -- argument commands
624

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
625 626 627
  ---------------------------------------
  -- Haskell program coverage (Hpc) Support

Ian Lynagh's avatar
Ian Lynagh committed
628
  | HsTick
629
     (XTick p)
630 631
     (Tickish (IdP p))
     (LHsExpr p)                       -- sub-expression
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
632 633

  | HsBinTick
634
     (XBinTick p)
Ian Lynagh's avatar
Ian Lynagh committed
635 636
     Int                                -- module-local tick number for True
     Int                                -- module-local tick number for False
637
     (LHsExpr p)                        -- sub-expression
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
638

Alan Zimmerman's avatar
Alan Zimmerman committed
639
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
Alan Zimmerman's avatar
Alan Zimmerman committed
640 641 642
  --       'ApiAnnotation.AnnOpen' @'{-\# GENERATED'@,
  --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnVal',
  --       'ApiAnnotation.AnnColon','ApiAnnotation.AnnVal',
Alan Zimmerman's avatar
Alan Zimmerman committed
643
  --       'ApiAnnotation.AnnMinus',
Alan Zimmerman's avatar
Alan Zimmerman committed
644 645 646
  --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnColon',
  --       'ApiAnnotation.AnnVal',
  --       'ApiAnnotation.AnnClose' @'\#-}'@
647 648

  -- For details on above see note [Api annotations] in ApiAnnotation
Alan Zimmerman's avatar
Alan Zimmerman committed
649
  | HsTickPragma                      -- A pragma introduced tick
650
     (XTickPragma p)
Alan Zimmerman's avatar
Alan Zimmerman committed
651
     SourceText                       -- Note [Pragma source text] in BasicTypes
652
     (StringLiteral,(Int,Int),(Int,Int))
653
                                      -- external span for this tick
654 655 656
     ((SourceText,SourceText),(SourceText,SourceText))
        -- Source text for the four integers used in the span.
        -- See note [Pragma source text] in BasicTypes
657
     (LHsExpr p)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
658 659 660 661

  ---------------------------------------
  -- These constructors only appear temporarily in the parser.
  -- The renamer translates them into the Right Thing.
662

663
  | EWildPat (XEWildPat p)        -- wildcard
664

Alan Zimmerman's avatar
Alan Zimmerman committed
665
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
666 667

  -- For details on above see note [Api annotations] in ApiAnnotation
668 669
  | EAsPat      (XEAsPat p)
                (Located (IdP p)) -- as pattern
670
                (LHsExpr p)
671

Alan Zimmerman's avatar
Alan Zimmerman committed
672
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
673 674

  -- For details on above see note [Api annotations] in ApiAnnotation
675 676
  | EViewPat    (XEViewPat p)
                (LHsExpr p) -- view pattern
677
                (LHsExpr p)
678

Alan Zimmerman's avatar
Alan Zimmerman committed
679
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
680 681

  -- For details on above see note [Api annotations] in ApiAnnotation
682
  | ELazyPat    (XELazyPat p) (LHsExpr p) -- ~ pattern
683

684

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
685 686
  ---------------------------------------
  -- Finally, HsWrap appears only in typechecker output
687 688 689
  -- The contained Expr is *NOT* itself an HsWrap.
  -- See Note [Detecting forced eta expansion] in DsExpr. This invariant
  -- is maintained by HsUtils.mkHsWrap.
690

691 692
  |  HsWrap     (XWrap p)
                HsWrapper    -- TRANSLATION
693
                (HsExpr p)
694

695 696 697 698 699 700 701
  | XExpr       (XXExpr p) -- Note [Trees that Grow] extension constructor


-- | Extra data fields for a 'RecordCon', added by the type checker
data RecordConTc = RecordConTc
      { rcon_con_like :: ConLike      -- The data constructor or pattern synonym
      , rcon_con_expr :: PostTcExpr   -- Instantiated constructor function
702
      }
703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719

-- | Extra data fields for a 'RecordUpd', added by the type checker
data RecordUpdTc = RecordUpdTc
      { rupd_cons :: [ConLike]
                -- Filled in by the type checker to the
                -- _non-empty_ list of DataCons that have
                -- all the upd'd fields

      , rupd_in_tys  :: [Type] -- Argument types of *input* record type
      , rupd_out_tys :: [Type] --             and  *output* record type
                               -- The original type can be reconstructed
                               -- with conLikeResTy
      , rupd_wrap :: HsWrapper -- See note [Record Update HsWrapper]
      } deriving Data

-- ---------------------------------------------------------------------

720 721 722 723 724 725 726 727 728 729 730
type instance XVar           (GhcPass _) = NoExt
type instance XUnboundVar    (GhcPass _) = NoExt
type instance XConLikeOut    (GhcPass _) = NoExt
type instance XRecFld        (GhcPass _) = NoExt
type instance XOverLabel     (GhcPass _) = NoExt
type instance XIPVar         (GhcPass _) = NoExt
type instance XOverLitE      (GhcPass _) = NoExt
type instance XLitE          (GhcPass _) = NoExt
type instance XLam           (GhcPass _) = NoExt
type instance XLamCase       (GhcPass _) = NoExt
type instance XApp           (GhcPass _) = NoExt
731

732
type instance XAppTypeE      (GhcPass _) = NoExt
733

734
type instance XOpApp         GhcPs = NoExt
735 736 737
type instance XOpApp         GhcRn = Fixity
type instance XOpApp         GhcTc = Fixity

738 739 740 741 742
type instance XNegApp        (GhcPass _) = NoExt
type instance XPar           (GhcPass _) = NoExt
type instance XSectionL      (GhcPass _) = NoExt
type instance XSectionR      (GhcPass _) = NoExt
type instance XExplicitTuple (GhcPass _) = NoExt
743

744 745
type instance XExplicitSum   GhcPs = NoExt
type instance XExplicitSum   GhcRn = NoExt
746 747
type instance XExplicitSum   GhcTc = [Type]

748 749
type instance XCase          (GhcPass _) = NoExt
type instance XIf            (GhcPass _) = NoExt
750

751 752
type instance XMultiIf       GhcPs = NoExt
type instance XMultiIf       GhcRn = NoExt
753 754
type instance XMultiIf       GhcTc = Type

755
type instance XLet           (GhcPass _) = NoExt
756

757 758
type instance XDo            GhcPs = NoExt
type instance XDo            GhcRn = NoExt
759 760
type instance XDo            GhcTc = Type

761 762
type instance XExplicitList  GhcPs = NoExt
type instance XExplicitList  GhcRn = NoExt
763 764
type instance XExplicitList  GhcTc = Type

765 766
type instance XRecordCon     GhcPs = NoExt
type instance XRecordCon     GhcRn = NoExt
767 768
type instance XRecordCon     GhcTc = RecordConTc

769 770
type instance XRecordUpd     GhcPs = NoExt
type instance XRecordUpd     GhcRn = NoExt
771 772
type instance XRecordUpd     GhcTc = RecordUpdTc

773
type instance XExprWithTySig (GhcPass _) = NoExt
774

775 776
type instance XArithSeq      GhcPs = NoExt
type instance XArithSeq      GhcRn = NoExt
777 778
type instance XArithSeq      GhcTc = PostTcExpr

779 780 781
type instance XSCC           (GhcPass _) = NoExt
type instance XCoreAnn       (GhcPass _) = NoExt
type instance XBracket       (GhcPass _) = NoExt
782

783 784
type instance XRnBracketOut  (GhcPass _) = NoExt
type instance XTcBracketOut  (GhcPass _) = NoExt
785

786 787
type instance XSpliceE       (GhcPass _) = NoExt
type instance XProc          (GhcPass _) = NoExt
788

789
type instance XStatic        GhcPs = NoExt
790 791 792
type instance XStatic        GhcRn = NameSet
type instance XStatic        GhcTc = NameSet

793 794
type instance XArrApp        GhcPs = NoExt
type instance XArrApp        GhcRn = NoExt
795 796
type instance XArrApp        GhcTc = Type

797 798 799 800 801 802 803 804 805 806
type instance XArrForm       (GhcPass _) = NoExt
type instance XTick          (GhcPass _) = NoExt
type instance XBinTick       (GhcPass _) = NoExt
type instance XTickPragma    (GhcPass _) = NoExt
type instance XEWildPat      (GhcPass _) = NoExt
type instance XEAsPat        (GhcPass _) = NoExt
type instance XEViewPat      (GhcPass _) = NoExt
type instance XELazyPat      (GhcPass _) = NoExt
type instance XWrap          (GhcPass _) = NoExt
type instance XXExpr         (GhcPass _) = NoExt
807 808

-- ---------------------------------------------------------------------
809

810 811 812 813 814 815
-- | Located Haskell Tuple Argument
--
-- 'HsTupArg' is used for tuple sections
-- @(,a,)@ is represented by
-- @ExplicitTuple [Missing ty1, Present a, Missing ty3]@
-- Which in turn stands for @(\x:ty1 \y:ty2. (x,a,y))@
816
type LHsTupArg id = Located (HsTupArg id)
Alan Zimmerman's avatar
Alan Zimmerman committed
817
-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
818 819

-- For details on above see note [Api annotations] in ApiAnnotation
820 821

-- | Haskell Tuple Argument
822
data HsTupArg id
823 824 825 826
  = Present (XPresent id) (LHsExpr id)     -- ^ The argument
  | Missing (XMissing id)    -- ^ The argument is missing, but this is its type
  | XTupArg (XXTupArg id)    -- ^ Note [Trees that Grow] extension point

827
type instance XPresent         (GhcPass _) = NoExt
828

829 830
type instance XMissing         GhcPs = NoExt
type instance XMissing         GhcRn = NoExt
831 832
type instance XMissing         GhcTc = Type

833
type instance XXTupArg         (GhcPass _) = NoExt
834

835 836 837
tupArgPresent :: LHsTupArg id -> Bool
tupArgPresent (L _ (Present {})) = True
tupArgPresent (L _ (Missing {})) = False
838
tupArgPresent (L _ (XTupArg {})) = False
839

Austin Seipp's avatar
Austin Seipp committed
840
{-
841 842 843 844
Note [Parens in HsSyn]
~~~~~~~~~~~~~~~~~~~~~~
HsPar (and ParPat in patterns, HsParTy in types) is used as follows

845
  * HsPar is required; the pretty printer does not add parens.
846 847 848 849

  * HsPars are respected when rearranging operator fixities.
    So   a * (b + c)  means what it says (where the parens are an HsPar)

850 851 852 853 854 855
  * For ParPat and HsParTy the pretty printer does add parens but this should be
    a no-op for ParsedSource, based on the pretty printer round trip feature
    introduced in
    https://phabricator.haskell.org/rGHC499e43824bda967546ebf95ee33ec1f84a114a7c

  * ParPat and HsParTy are pretty printed as '( .. )' regardless of whether or
James Michael DuPont's avatar
James Michael DuPont committed
856
    not they are strictly necessary. This should be addressed when #13238 is
857 858 859
    completed, to be treated the same as HsPar.


860 861 862
Note [Sections in HsSyn]
~~~~~~~~~~~~~~~~~~~~~~~~
Sections should always appear wrapped in an HsPar, thus
863 864
         HsPar (SectionR ...)
The parser parses sections in a wider variety of situations
865
(See Note [Parsing sections]), but the renamer checks for those
866
parens.  This invariant makes pretty-printing easier; we don't need
867 868
a special case for adding the parens round sections.

869 870 871 872 873 874
Note [Rebindable if]
~~~~~~~~~~~~~~~~~~~~
The rebindable syntax for 'if' is a bit special, because when
rebindable syntax is *off* we do not want to treat
   (if c then t else e)
as if it was an application (ifThenElse c t e).  Why not?
875
Because we allow an 'if' to return *unboxed* results, thus
876 877 878 879 880
  if blah then 3# else 4#
whereas that would not be possible using a all to a polymorphic function
(because you can't call a polymorphic function at an unboxed type).

So we use Nothing to mean "use the old built-in typing rule".
Matthew Pickering's avatar
Matthew Pickering committed
881 882 883

Note [Record Update HsWrapper]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
884 885 886 887
There is a wrapper in RecordUpd which is used for the *required*
constraints for pattern synonyms. This wrapper is created in the
typechecking and is then directly used in the desugaring without
modification.
Matthew Pickering's avatar
Matthew Pickering committed
888 889

For example, if we have the record pattern synonym P,
890 891
  pattern P :: (Show a) => a -> Maybe a
  pattern P{x} = Just x
Matthew Pickering's avatar
Matthew Pickering committed
892

893
  foo = (Just True) { x = False }
Matthew Pickering's avatar
Matthew Pickering committed
894
then `foo` desugars to something like
895 896 897 898
  foo = case Just True of
          P x -> P False
hence we need to provide the correct dictionaries to P's matcher on
the RHS so that we can build the expression.
Matthew Pickering's avatar
Matthew Pickering committed
899

900 901 902 903 904 905 906 907 908 909
Note [Located RdrNames]
~~~~~~~~~~~~~~~~~~~~~~~
A number of syntax elements have seemingly redundant locations attached to them.
This is deliberate, to allow transformations making use of the API Annotations
to easily correlate a Located Name in the RenamedSource with a Located RdrName
in the ParsedSource.

There are unfortunately enough differences between the ParsedSource and the
RenamedSource that the API Annotations cannot be used directly with
RenamedSource, so this allows a simple mapping to be used based on the location.
Austin Seipp's avatar
Austin Seipp committed
910
-}
911

912
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p) where
913
    ppr expr = pprExpr expr
914

915
-----------------------
Ian Lynagh's avatar
Ian Lynagh committed
916
-- pprExpr, pprLExpr, pprBinds call pprDeeper;
917
-- the underscore versions do not
918
pprLExpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
919 920
pprLExpr (L _ e) = pprExpr e

921
pprExpr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
922 923 924 925 926 927 928
pprExpr e | isAtomicHsExpr e || isQuietHsExpr e =            ppr_expr e
          | otherwise                           = pprDeeper (ppr_expr e)

isQuietHsExpr :: HsExpr id -> Bool
-- Parentheses do display something, but it gives little info and
-- if we go deeper when we go inside them then we get ugly things
-- like (...)
929
isQuietHsExpr (HsPar {})        = True
Ian Lynagh's avatar
Ian Lynagh committed
930
-- applications don't display anything themselves
931 932 933
isQuietHsExpr (HsApp {})        = True
isQuietHsExpr (HsAppType {})    = True
isQuietHsExpr (OpApp {})        = True
Ian Lynagh's avatar
Ian Lynagh committed
934
isQuietHsExpr _ = False
935

936 937
pprBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
         => HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
938
pprBinds b = pprDeeper (ppr b)
939

940
-----------------------
941
ppr_lexpr :: (OutputableBndrId (GhcPass p)) => LHsExpr (GhcPass p) -> SDoc
942
ppr_lexpr e = ppr_expr (unLoc e)
943

944 945
ppr_expr :: forall p. (OutputableBndrId (GhcPass p))
         => HsExpr (GhcPass p) -> SDoc
946 947 948 949 950 951 952 953 954 955
ppr_expr (HsVar _ (L _ v))  = pprPrefixOcc v
ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc (unboundVarOcc uv)
ppr_expr (HsConLikeOut _ c) = pprPrefixOcc c
ppr_expr (HsIPVar _ v)      = ppr v
ppr_expr (HsOverLabel _ _ l)= char '#' <> ppr l
ppr_expr (HsLit _ lit)      = ppr lit
ppr_expr (HsOverLit _ lit)  = ppr lit
ppr_expr (HsPar _ e)        = parens (ppr_lexpr e)

ppr_expr (HsCoreAnn _ stc (StringLiteral sta s) e)
956 957 958
  = vcat [pprWithSourceText stc (text "{-# CORE")
          <+> pprWithSourceText sta (doubleQuotes $ ftext s) <+> text "#-}"
         , ppr_lexpr e]
959

960 961
ppr_expr e@(HsApp {})        = ppr_apps e []
ppr_expr e@(HsAppType {})    = ppr_apps e []
962

963
ppr_expr (OpApp _ e1 op e2)
964 965 966 967 968
  | Just pp_op <- should_print_infix (unLoc op)
  = pp_infixly pp_op
  | otherwise
  = pp_prefixly

969
  where
970 971 972 973
    should_print_infix (HsVar _ (L _ v)) = Just (pprInfixOcc v)
    should_print_infix (HsConLikeOut _ c)= Just (pprInfixOcc (conLikeName c))
    should_print_infix (HsRecFld _ f)    = Just (pprInfixOcc f)
    should_print_infix (HsUnboundVar _ h@TrueExprHole{})
974
                                       = Just (pprInfixOcc (unboundVarOcc h))
975 976
    should_print_infix (EWildPat _)    = Just (text "`_`")
    should_print_infix (HsWrap _ _ e)  = should_print_infix e
977 978
    should_print_infix _               = Nothing

979 980
    pp_e1 = pprDebugParendExpr opPrec e1   -- In debug mode, add parens
    pp_e2 = pprDebugParendExpr opPrec e2   -- to make precedence clear
981 982

    pp_prefixly
983
      = hang (ppr op) 2 (sep [pp_e1, pp_e2])
984

985 986
    pp_infixly pp_op
      = hang pp_e1 2 (sep [pp_op, nest 2 pp_e2])
987

988
ppr_expr (NegApp _ e _) = char '-' <+> pprDebugParendExpr appPrec e
989

990
ppr_expr (SectionL _ expr op)
991
  = case unLoc op of
992 993 994 995 996
      HsVar _ (L _ v)  -> pp_infixly v
      HsConLikeOut _ c -> pp_infixly (conLikeName c)
      HsUnboundVar _ h@TrueExprHole{}
                       -> pp_infixly (unboundVarOcc h)
      _                -> pp_prefixly
997
  where
998
    pp_expr = pprDebugParendExpr opPrec expr
999

1000
    pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
1001
                       4 (hsep [pp_expr, text "x_ )"])
1002 1003

    pp_infixly :: forall a. (OutputableBndr a) => a -> SDoc
Ben Gamari's avatar
Ben Gamari committed
1004
    pp_infixly v = (sep [pp_expr, pprInfixOcc v])
1005

1006
ppr_expr (SectionR _ op expr)
1007
  = case unLoc op of
1008 1009 1010 1011 1012
      HsVar _ (L _ v)  -> pp_infixly v
      HsConLikeOut _ c -> pp_infixly (conLikeName c)
      HsUnboundVar _ h@TrueExprHole{}
                       -> pp_infixly (unboundVarOcc h)
      _                -> pp_prefixly
1013
  where
1014
    pp_expr = pprDebugParendExpr opPrec expr
1015

1016
    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, text "x_"])
1017
                       4 (pp_expr <> rparen)
1018 1019