HsExpr.hs 85.7 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
14

-- | Abstract Haskell syntax for expressions.
15
16
module HsExpr where

17
#include "HsVersions.h"
18
19

-- friends:
20
21
22
import HsDecls
import HsPat
import HsLit
23
import PlaceHolder ( PostTc,PostRn,DataId )
24
25
import HsTypes
import HsBinds
26
27

-- others:
28
import TcEvidence
29
import CoreSyn
30
import Var
31
import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )
32
33
import Name
import BasicTypes
Matthew Pickering's avatar
Matthew Pickering committed
34
import ConLike
35
import SrcLoc
36
import Util
37
import StaticFlags( opt_PprStyle_Debug )
Ian Lynagh's avatar
Ian Lynagh committed
38
import Outputable
39
import FastString
40
import Type
41
42
43

-- libraries:
import Data.Data hiding (Fixity)
Simon Marlow's avatar
Simon Marlow committed
44
import Data.Maybe (isNothing)
45

Austin Seipp's avatar
Austin Seipp committed
46
47
48
{-
************************************************************************
*                                                                      *
49
\subsection{Expressions proper}
Austin Seipp's avatar
Austin Seipp committed
50
51
52
*                                                                      *
************************************************************************
-}
53

54
55
-- * Expressions proper

56
type LHsExpr id = Located (HsExpr id)
Alan Zimmerman's avatar
Alan Zimmerman committed
57
58
  -- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma' when
  --   in a list
59

60
61
  -- For details on above see note [Api annotations] in ApiAnnotation

62
-------------------------
63
64
-- | PostTcExpr is an evidence expression attached to the syntax tree by the
-- type checker (c.f. postTcType).
65
type PostTcExpr  = HsExpr Id
66
67
-- | We use a PostTcTable where there are a bunch of pieces of evidence, more
-- than is convenient to keep individually.
68
type PostTcTable = [(Name, PostTcExpr)]
69
70

noPostTcExpr :: PostTcExpr
71
noPostTcExpr = HsLit (HsString "" (fsLit "noPostTcExpr"))
72
73
74
75
76

noPostTcTable :: PostTcTable
noPostTcTable = []

-------------------------
77
-- | SyntaxExpr is like 'PostTcExpr', but it's filled in a little earlier,
Ian Lynagh's avatar
Ian Lynagh committed
78
-- by the renamer.  It's used for rebindable syntax.
79
80
81
--
-- E.g. @(>>=)@ is filled in before the renamer by the appropriate 'Name' for
--      @(>>=)@, and then instantiated by the type checker with its type args
82
--      etc
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
--
-- 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.
-- This could be defined using @PostRn@ and @PostTc@ and such, but it's
-- harder to get it all to work out that way. ('noSyntaxExpr' is hard to
-- write, for example.)
data SyntaxExpr id = SyntaxExpr { syn_expr      :: HsExpr id
                                , syn_arg_wraps :: [HsWrapper]
                                , syn_res_wrap  :: HsWrapper }
  deriving (Typeable)
deriving instance (DataId id) => Data (SyntaxExpr id)
98

99
100
101
102
-- | This is used for rebindable-syntax pieces that are too polymorphic
-- for tcSyntaxOp (trS_fmap and the mzip in ParStmt)
noExpr :: HsExpr id
noExpr = HsLit (HsString "" (fsLit "noExpr"))
103

Ian Lynagh's avatar
Ian Lynagh committed
104
105
noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
                              -- (if the syntax slot makes no sense)
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit (HsString "" (fsLit "noSyntaxExpr"))
                          , syn_arg_wraps = []
                          , syn_res_wrap  = WpHole }

-- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the
-- renamer), missing its HsWrappers.
mkRnSyntaxExpr :: Name -> SyntaxExpr Name
mkRnSyntaxExpr name = SyntaxExpr { syn_expr      = HsVar $ noLoc name
                                 , syn_arg_wraps = []
                                 , syn_res_wrap  = WpHole }
  -- don't care about filling in syn_arg_wraps because we're clearly
  -- not past the typechecker

instance OutputableBndr id => Outputable (SyntaxExpr id) where
  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
126
127
      then ppr expr <> braces (pprWithCommas ppr arg_wraps)
                    <> braces (ppr res_wrap)
128
129
130
      else ppr expr

type CmdSyntaxTable id = [(Name, HsExpr id)]
131
-- See Note [CmdSyntaxTable]
132

Austin Seipp's avatar
Austin Seipp committed
133
{-
134
135
136
137
138
Note [CmdSyntaxtable]
~~~~~~~~~~~~~~~~~~~~~
Used only for arrow-syntax stuff (HsCmdTop), the CmdSyntaxTable keeps
track of the methods needed for a Cmd.

139
* Before the renamer, this list is an empty list
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166

* 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
167
-}
168

169
-- | A Haskell expression.
170
data HsExpr id
171
  = HsVar     (Located id)   -- ^ Variable
172

173
174
                             -- See Note [Located RdrNames]

175
176
177
178
179
180
  | HsUnboundVar OccName     -- ^ Unbound variable; also used for "holes" _, or _x.
                             -- Turned from HsVar to HsUnboundVar by the renamer, when
                             --   it finds an out-of-scope variable
                             -- Turned into HsVar by type checker, to support deferred
                             --   type errors.  (The HsUnboundVar only has an OccName.)

181
  | HsRecFld (AmbiguousFieldOcc id) -- ^ Variable pointing to record selector
Adam Gundry's avatar
Adam Gundry committed
182

Adam Gundry's avatar
Adam Gundry committed
183
184
  | HsOverLabel FastString   -- ^ Overloaded label (See Note [Overloaded labels]
                             --   in GHC.OverloadedLabels)
185
186
187
188
  | HsIPVar   HsIPName       -- ^ Implicit parameter
  | HsOverLit (HsOverLit id) -- ^ Overloaded literals

  | HsLit     HsLit          -- ^ Simple (non-overloaded) literals
189

190
  | HsLam     (MatchGroup id (LHsExpr id)) -- ^ Lambda abstraction. Currently always a single match
Alan Zimmerman's avatar
Alan Zimmerman committed
191
192
193
       --
       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
       --       'ApiAnnotation.AnnRarrow',
194

195
196
       -- For details on above see note [Api annotations] in ApiAnnotation

197
  | HsLamCase (PostTc id Type) (MatchGroup id (LHsExpr id)) -- ^ Lambda-case
Alan Zimmerman's avatar
Alan Zimmerman committed
198
199
200
201
       --
       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLam',
       --           'ApiAnnotation.AnnCase','ApiAnnotation.AnnOpen',
       --           'ApiAnnotation.AnnClose'
Alan Zimmerman's avatar
Alan Zimmerman committed
202

203
204
       -- For details on above see note [Api annotations] in ApiAnnotation

205
  | HsApp     (LHsExpr id) (LHsExpr id) -- ^ Application
206

207
208
209
210
211
212
213
214
215
216
  | HsAppType (LHsExpr id) (LHsWcType id) -- ^ Visible type application
       --
       -- Explicit type argument; e.g  f @Int x y
       -- NB: Has wildcards, but no implicit quantification
       --
       -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt',

  | HsAppTypeOut (LHsExpr id) (LHsWcType Name) -- just for pretty-printing


217
  -- | Operator applications:
218
219
  -- NB Bracketed ops such as (+) come out as Vars.

220
221
222
  -- 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.

Ian Lynagh's avatar
Ian Lynagh committed
223
224
  | OpApp       (LHsExpr id)    -- left operand
                (LHsExpr id)    -- operator
225
                (PostRn id Fixity) -- Renamer adds fixity; bottom until then
Ian Lynagh's avatar
Ian Lynagh committed
226
227
                (LHsExpr id)    -- right operand

228
  -- | Negation operator. Contains the negated expression and the name
Alan Zimmerman's avatar
Alan Zimmerman committed
229
230
231
  -- of 'negate'
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnMinus'
232
233

  -- For details on above see note [Api annotations] in ApiAnnotation
Alan Zimmerman's avatar
Alan Zimmerman committed
234
235
236
  | NegApp      (LHsExpr id)
                (SyntaxExpr id)

Alan Zimmerman's avatar
Alan Zimmerman committed
237
238
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
  --             'ApiAnnotation.AnnClose' @')'@
239
240

  -- For details on above see note [Api annotations] in ApiAnnotation
241
  | HsPar       (LHsExpr id)    -- ^ Parenthesised expr; see Note [Parens in HsSyn]
Ian Lynagh's avatar
Ian Lynagh committed
242

243
  | SectionL    (LHsExpr id)    -- operand; see Note [Sections in HsSyn]
Ian Lynagh's avatar
Ian Lynagh committed
244
                (LHsExpr id)    -- operator
245
  | SectionR    (LHsExpr id)    -- operator; see Note [Sections in HsSyn]
Ian Lynagh's avatar
Ian Lynagh committed
246
247
                (LHsExpr id)    -- operand

248
  -- | Used for explicit tuples and sections thereof
Alan Zimmerman's avatar
Alan Zimmerman committed
249
250
251
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
  --         'ApiAnnotation.AnnClose'
252
253

  -- For details on above see note [Api annotations] in ApiAnnotation
254
255
  | ExplicitTuple
        [LHsTupArg id]
256
257
        Boxity

Alan Zimmerman's avatar
Alan Zimmerman committed
258
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnCase',
Alan Zimmerman's avatar
Alan Zimmerman committed
259
260
  --       'ApiAnnotation.AnnOf','ApiAnnotation.AnnOpen' @'{'@,
  --       'ApiAnnotation.AnnClose' @'}'@
261
262

  -- For details on above see note [Api annotations] in ApiAnnotation
Ian Lynagh's avatar
Ian Lynagh committed
263
  | HsCase      (LHsExpr id)
264
                (MatchGroup id (LHsExpr id))
Ian Lynagh's avatar
Ian Lynagh committed
265

Alan Zimmerman's avatar
Alan Zimmerman committed
266
267
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf',
  --       'ApiAnnotation.AnnSemi',
Alan Zimmerman's avatar
Alan Zimmerman committed
268
  --       'ApiAnnotation.AnnThen','ApiAnnotation.AnnSemi',
Alan Zimmerman's avatar
Alan Zimmerman committed
269
  --       'ApiAnnotation.AnnElse',
270
271

  -- For details on above see note [Api annotations] in ApiAnnotation
272
  | HsIf        (Maybe (SyntaxExpr id)) -- cond function
273
274
                                        -- Nothing => use the built-in 'if'
                                        -- See Note [Rebindable if]
275
                (LHsExpr id)    --  predicate
Ian Lynagh's avatar
Ian Lynagh committed
276
277
278
                (LHsExpr id)    --  then part
                (LHsExpr id)    --  else part

279
  -- | Multi-way if
Alan Zimmerman's avatar
Alan Zimmerman committed
280
281
282
  --
  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnIf'
  --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
283
284

  -- For details on above see note [Api annotations] in ApiAnnotation
285
  | HsMultiIf   (PostTc id Type) [LGRHS id (LHsExpr id)]
286

287
  -- | let(rec)
Alan Zimmerman's avatar
Alan Zimmerman committed
288
289
  --
  -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLet',
Alan Zimmerman's avatar
Alan Zimmerman committed
290
291
  --       'ApiAnnotation.AnnOpen' @'{'@,
  --       'ApiAnnotation.AnnClose' @'}'@,'ApiAnnotation.AnnIn'
292
293

  -- For details on above see note [Api annotations] in ApiAnnotation
294
  | HsLet       (Located (HsLocalBinds id))
Ian Lynagh's avatar
Ian Lynagh committed
295
296
                (LHsExpr  id)

Alan Zimmerman's avatar
Alan Zimmerman committed
297
298
299
300
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDo',
  --             'ApiAnnotation.AnnOpen', 'ApiAnnotation.AnnSemi',
  --             'ApiAnnotation.AnnVbar',
  --             'ApiAnnotation.AnnClose'
301
302

  -- For details on above see note [Api annotations] in ApiAnnotation
303
304
305
306
307
  | HsDo        (HsStmtContext Name)     -- The parameterisation is unimportant
                                         -- because in this context we never use
                                         -- the PatGuard or ParStmt variant
                (Located [ExprLStmt id]) -- "do":one or more stmts
                (PostTc id Type)         -- Type of the whole expression
Ian Lynagh's avatar
Ian Lynagh committed
308

309
  -- | Syntactic list: [a,b,c,...]
Alan Zimmerman's avatar
Alan Zimmerman committed
310
  --
Alan Zimmerman's avatar
Alan Zimmerman committed
311
312
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
  --              'ApiAnnotation.AnnClose' @']'@
313
314

  -- For details on above see note [Api annotations] in ApiAnnotation
315
316
  | ExplicitList
                (PostTc id Type)        -- Gives type of components of list
317
                (Maybe (SyntaxExpr id)) -- For OverloadedLists, the fromListN witness
Ian Lynagh's avatar
Ian Lynagh committed
318
319
                [LHsExpr id]

320
  -- | Syntactic parallel array: [:e1, ..., en:]
Alan Zimmerman's avatar
Alan Zimmerman committed
321
  --
Alan Zimmerman's avatar
Alan Zimmerman committed
322
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
Alan Zimmerman's avatar
Alan Zimmerman committed
323
324
  --              'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnComma',
  --              'ApiAnnotation.AnnVbar'
Alan Zimmerman's avatar
Alan Zimmerman committed
325
  --              'ApiAnnotation.AnnClose' @':]'@
326
327

  -- For details on above see note [Api annotations] in ApiAnnotation
328
329
  | ExplicitPArr
                (PostTc id Type)   -- type of elements of the parallel array
Ian Lynagh's avatar
Ian Lynagh committed
330
331
                [LHsExpr id]

332
  -- | Record construction
Alan Zimmerman's avatar
Alan Zimmerman committed
333
  --
Alan Zimmerman's avatar
Alan Zimmerman committed
334
335
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
  --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
336
337

  -- For details on above see note [Api annotations] in ApiAnnotation
338
339
340
341
342
343
  | RecordCon
      { rcon_con_name :: Located id         -- The constructor name;
                                            --  not used after type checking
      , rcon_con_like :: PostTc id ConLike  -- The data constructor or pattern synonym
      , rcon_con_expr :: PostTcExpr         -- Instantiated constructor function
      , rcon_flds     :: HsRecordBinds id } -- The fields
Ian Lynagh's avatar
Ian Lynagh committed
344

345
  -- | Record update
Alan Zimmerman's avatar
Alan Zimmerman committed
346
  --
Alan Zimmerman's avatar
Alan Zimmerman committed
347
348
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{'@,
  --         'ApiAnnotation.AnnDotdot','ApiAnnotation.AnnClose' @'}'@
349
350

  -- For details on above see note [Api annotations] in ApiAnnotation
351
352
353
354
  | RecordUpd
      { rupd_expr :: LHsExpr id
      , rupd_flds :: [LHsRecUpdField id]
      , rupd_cons :: PostTc id [ConLike]
355
356
357
                -- Filled in by the type checker to the
                -- _non-empty_ list of DataCons that have
                -- all the upd'd fields
358
359
360
361
362
363
364

      , rupd_in_tys  :: PostTc id [Type]  -- Argument types of *input* record type
      , rupd_out_tys :: PostTc id [Type]  --              and  *output* record type
                                          -- The original type can be reconstructed
                                          -- with conLikeResTy
      , rupd_wrap :: PostTc id HsWrapper  -- See note [Record Update HsWrapper]
      }
Ian Lynagh's avatar
Ian Lynagh committed
365
366
367
  -- For a type family, the arg types are of the *instance* tycon,
  -- not the family tycon

Alan Zimmerman's avatar
Alan Zimmerman committed
368
369
370
  -- | Expression with an explicit type signature. @e :: type@
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon'
371
372

  -- For details on above see note [Api annotations] in ApiAnnotation
Alan Zimmerman's avatar
Alan Zimmerman committed
373
  | ExprWithTySig
374
                (LHsExpr id)
375
                (LHsSigWcType id)
Ian Lynagh's avatar
Ian Lynagh committed
376

377
  | ExprWithTySigOut              -- Post typechecking
Ian Lynagh's avatar
Ian Lynagh committed
378
                (LHsExpr id)
379
380
381
                (LHsSigWcType Name)  -- Retain the signature,
                                     -- as HsSigType Name, for
                                     -- round-tripping purposes
Ian Lynagh's avatar
Ian Lynagh committed
382

383
  -- | Arithmetic sequence
Alan Zimmerman's avatar
Alan Zimmerman committed
384
  --
Alan Zimmerman's avatar
Alan Zimmerman committed
385
386
387
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'['@,
  --              'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',
  --              'ApiAnnotation.AnnClose' @']'@
388
389

  -- For details on above see note [Api annotations] in ApiAnnotation
Alan Zimmerman's avatar
Alan Zimmerman committed
390
  | ArithSeq
Ian Lynagh's avatar
Ian Lynagh committed
391
                PostTcExpr
392
                (Maybe (SyntaxExpr id))   -- For OverloadedLists, the fromList witness
Ian Lynagh's avatar
Ian Lynagh committed
393
394
                (ArithSeqInfo id)

395
  -- | Arithmetic sequence for parallel array
Alan Zimmerman's avatar
Alan Zimmerman committed
396
397
398
399
400
401
402
  --
  -- > [:e1..e2:] or [:e1, e2..e3:]
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'[:'@,
  --              'ApiAnnotation.AnnComma','ApiAnnotation.AnnDotdot',
  --              'ApiAnnotation.AnnVbar',
  --              'ApiAnnotation.AnnClose' @':]'@
403
404

  -- For details on above see note [Api annotations] in ApiAnnotation
Austin Seipp's avatar
Austin Seipp committed
405
  | PArrSeq
Alan Zimmerman's avatar
Alan Zimmerman committed
406
                PostTcExpr
Ian Lynagh's avatar
Ian Lynagh committed
407
408
                (ArithSeqInfo id)

Alan Zimmerman's avatar
Alan Zimmerman committed
409
410
411
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# SCC'@,
  --             'ApiAnnotation.AnnVal' or 'ApiAnnotation.AnnValStr',
  --              'ApiAnnotation.AnnClose' @'\#-}'@
412
413

  -- For details on above see note [Api annotations] in ApiAnnotation
Alan Zimmerman's avatar
Alan Zimmerman committed
414
  | HsSCC       SourceText            -- Note [Pragma source text] in BasicTypes
415
416
                StringLiteral         -- "set cost centre" SCC pragma
                (LHsExpr id)          -- expr whose cost is to be measured
Alan Zimmerman's avatar
Alan Zimmerman committed
417
418
419

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

  -- For details on above see note [Api annotations] in ApiAnnotation
Alan Zimmerman's avatar
Alan Zimmerman committed
422
  | HsCoreAnn   SourceText            -- Note [Pragma source text] in BasicTypes
423
                StringLiteral         -- hdaume: core annotation
Ian Lynagh's avatar
Ian Lynagh committed
424
425
                (LHsExpr id)

426
  -----------------------------------------------------------
427
  -- MetaHaskell Extensions
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
428

Alan Zimmerman's avatar
Alan Zimmerman committed
429
430
431
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
  --         'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
  --         'ApiAnnotation.AnnClose'
432
433

  -- For details on above see note [Api annotations] in ApiAnnotation
434
  | HsBracket    (HsBracket id)
435

436
437
438
439
440
    -- See Note [Pending Splices]
  | HsRnBracketOut
      (HsBracket Name)     -- Output of the renamer is the *original* renamed
                           -- expression, plus
      [PendingRnSplice]    -- _renamed_ splices to be type checked
gmainland's avatar
gmainland committed
441

442
443
444
445
446
  | HsTcBracketOut
      (HsBracket Name)     -- Output of the type checker is the *original*
                           -- renamed expression, plus
      [PendingTcSplice]    -- _typechecked_ splices to be
                           -- pasted back in by the desugarer
447

Alan Zimmerman's avatar
Alan Zimmerman committed
448
449
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
  --         'ApiAnnotation.AnnClose'
450
451

  -- For details on above see note [Api annotations] in ApiAnnotation
452
  | HsSpliceE  (HsSplice id)
453

454
455
456
  -----------------------------------------------------------
  -- Arrow notation extension

457
  -- | @proc@ notation for Arrows
Alan Zimmerman's avatar
Alan Zimmerman committed
458
459
460
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnProc',
  --          'ApiAnnotation.AnnRarrow'
461
462

  -- For details on above see note [Api annotations] in ApiAnnotation
Ian Lynagh's avatar
Ian Lynagh committed
463
464
465
  | HsProc      (LPat id)               -- arrow abstraction, proc
                (LHsCmdTop id)          -- body of the abstraction
                                        -- always has an empty stack
466

Facundo Domínguez's avatar
Facundo Domínguez committed
467
468
  ---------------------------------------
  -- static pointers extension
Alan Zimmerman's avatar
Alan Zimmerman committed
469
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnStatic',
470
471

  -- For details on above see note [Api annotations] in ApiAnnotation
Facundo Domínguez's avatar
Facundo Domínguez committed
472
473
  | HsStatic    (LHsExpr id)

474
475
  ---------------------------------------
  -- The following are commands, not expressions proper
476
  -- They are only used in the parsing stage and are removed
477
  --    immediately in parser.RdrHsSyn.checkCommand
Alan Zimmerman's avatar
Alan Zimmerman committed
478
479
480
481

  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.Annlarrowtail',
  --          'ApiAnnotation.Annrarrowtail','ApiAnnotation.AnnLarrowtail',
  --          'ApiAnnotation.AnnRarrowtail'
482
483

  -- For details on above see note [Api annotations] in ApiAnnotation
484
485
486
487
488
489
490
491
492
  | HsArrApp             -- Arrow tail, or arrow application (f -< arg)
        (LHsExpr id)     -- arrow expression, f
        (LHsExpr id)     -- input expression, arg
        (PostTc id Type) -- type of the arrow expressions f,
                         -- of the form a t t', where arg :: t
        HsArrAppType     -- higher-order (-<<) or first-order (-<)
        Bool             -- True => right-to-left (f -< arg)
                         -- False => left-to-right (arg >- f)

Alan Zimmerman's avatar
Alan Zimmerman committed
493
494
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'(|'@,
  --         'ApiAnnotation.AnnClose' @'|)'@
495
496

  -- For details on above see note [Api annotations] in ApiAnnotation
497
498
499
500
501
502
503
  | HsArrForm            -- Command formation,  (| e cmd1 .. cmdn |)
        (LHsExpr id)     -- the operator
                         -- 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
        [LHsCmdTop id]   -- argument commands
504

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
505
506
507
  ---------------------------------------
  -- Haskell program coverage (Hpc) Support

Ian Lynagh's avatar
Ian Lynagh committed
508
  | HsTick
509
     (Tickish id)
Ian Lynagh's avatar
Ian Lynagh committed
510
     (LHsExpr id)                       -- sub-expression
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
511
512

  | HsBinTick
Ian Lynagh's avatar
Ian Lynagh committed
513
514
515
     Int                                -- module-local tick number for True
     Int                                -- module-local tick number for False
     (LHsExpr id)                       -- sub-expression
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
516

Alan Zimmerman's avatar
Alan Zimmerman committed
517
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
Alan Zimmerman's avatar
Alan Zimmerman committed
518
519
520
  --       'ApiAnnotation.AnnOpen' @'{-\# GENERATED'@,
  --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnVal',
  --       'ApiAnnotation.AnnColon','ApiAnnotation.AnnVal',
Alan Zimmerman's avatar
Alan Zimmerman committed
521
  --       'ApiAnnotation.AnnMinus',
Alan Zimmerman's avatar
Alan Zimmerman committed
522
523
524
  --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnColon',
  --       'ApiAnnotation.AnnVal',
  --       'ApiAnnotation.AnnClose' @'\#-}'@
525
526

  -- For details on above see note [Api annotations] in ApiAnnotation
Alan Zimmerman's avatar
Alan Zimmerman committed
527
528
  | HsTickPragma                      -- A pragma introduced tick
     SourceText                       -- Note [Pragma source text] in BasicTypes
529
     (StringLiteral,(Int,Int),(Int,Int))
530
                                      -- external span for this tick
531
532
533
     ((SourceText,SourceText),(SourceText,SourceText))
        -- Source text for the four integers used in the span.
        -- See note [Pragma source text] in BasicTypes
Ian Lynagh's avatar
Ian Lynagh committed
534
     (LHsExpr id)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
535
536
537
538

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

Ian Lynagh's avatar
Ian Lynagh committed
540
  | EWildPat                 -- wildcard
541

Alan Zimmerman's avatar
Alan Zimmerman committed
542
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnAt'
543
544

  -- For details on above see note [Api annotations] in ApiAnnotation
Ian Lynagh's avatar
Ian Lynagh committed
545
546
  | EAsPat      (Located id) -- as pattern
                (LHsExpr id)
547

Alan Zimmerman's avatar
Alan Zimmerman committed
548
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnRarrow'
549
550

  -- For details on above see note [Api annotations] in ApiAnnotation
Ian Lynagh's avatar
Ian Lynagh committed
551
552
  | EViewPat    (LHsExpr id) -- view pattern
                (LHsExpr id)
553

Alan Zimmerman's avatar
Alan Zimmerman committed
554
  -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
555
556

  -- For details on above see note [Api annotations] in ApiAnnotation
Ian Lynagh's avatar
Ian Lynagh committed
557
  | ELazyPat    (LHsExpr id) -- ~ pattern
558

559

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
560
561
  ---------------------------------------
  -- Finally, HsWrap appears only in typechecker output
562

Ian Lynagh's avatar
Ian Lynagh committed
563
564
  |  HsWrap     HsWrapper    -- TRANSLATION
                (HsExpr id)
565

566
567
  deriving (Typeable)
deriving instance (DataId id) => Data (HsExpr id)
568

569
-- | HsTupArg is used for tuple sections
570
--  (,a,) is represented by  ExplicitTuple [Missing ty1, Present a, Missing ty3]
571
--  Which in turn stands for (\x:ty1 \y:ty2. (x,a,y))
572
type LHsTupArg id = Located (HsTupArg id)
Alan Zimmerman's avatar
Alan Zimmerman committed
573
-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnComma'
574
575

-- For details on above see note [Api annotations] in ApiAnnotation
576
data HsTupArg id
577
578
579
580
  = Present (LHsExpr id)     -- ^ The argument
  | Missing (PostTc id Type) -- ^ The argument is missing, but this is its type
  deriving (Typeable)
deriving instance (DataId id) => Data (HsTupArg id)
581

582
583
584
tupArgPresent :: LHsTupArg id -> Bool
tupArgPresent (L _ (Present {})) = True
tupArgPresent (L _ (Missing {})) = False
585

Austin Seipp's avatar
Austin Seipp committed
586
{-
587
588
589
590
591
592
593
Note [Parens in HsSyn]
~~~~~~~~~~~~~~~~~~~~~~
HsPar (and ParPat in patterns, HsParTy in types) is used as follows

  * Generally HsPar is optional; the pretty printer adds parens where
    necessary.  Eg (HsApp f (HsApp g x)) is fine, and prints 'f (g x)'

594
  * HsPars are pretty printed as '( .. )' regardless of whether
595
596
597
598
599
600
601
602
    or not they are strictly necssary

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

Note [Sections in HsSyn]
~~~~~~~~~~~~~~~~~~~~~~~~
Sections should always appear wrapped in an HsPar, thus
603
604
         HsPar (SectionR ...)
The parser parses sections in a wider variety of situations
605
(See Note [Parsing sections]), but the renamer checks for those
606
parens.  This invariant makes pretty-printing easier; we don't need
607
608
a special case for adding the parens round sections.

609
610
611
612
613
614
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?
615
Because we allow an 'if' to return *unboxed* results, thus
616
617
618
619
620
  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
621
622
623

Note [Record Update HsWrapper]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
624
625
626
627
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
628
629

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

633
  foo = (Just True) { x = False }
Matthew Pickering's avatar
Matthew Pickering committed
634
then `foo` desugars to something like
635
636
637
638
  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
639

640
641
642
643
644
645
646
647
648
649
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
650
-}
651

652
instance OutputableBndr id => Outputable (HsExpr id) where
653
    ppr expr = pprExpr expr
654

655
-----------------------
Ian Lynagh's avatar
Ian Lynagh committed
656
-- pprExpr, pprLExpr, pprBinds call pprDeeper;
657
658
-- the underscore versions do not
pprLExpr :: OutputableBndr id => LHsExpr id -> SDoc
659
660
661
pprLExpr (L _ e) = pprExpr e

pprExpr :: OutputableBndr id => HsExpr id -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
662
663
664
665
666
667
668
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 (...)
669
isQuietHsExpr (HsPar _)          = True
Ian Lynagh's avatar
Ian Lynagh committed
670
-- applications don't display anything themselves
671
672
673
674
isQuietHsExpr (HsApp _ _)        = True
isQuietHsExpr (HsAppType _ _)    = True
isQuietHsExpr (HsAppTypeOut _ _) = True
isQuietHsExpr (OpApp _ _ _ _)    = True
Ian Lynagh's avatar
Ian Lynagh committed
675
isQuietHsExpr _ = False
676

Ian Lynagh's avatar
Ian Lynagh committed
677
678
pprBinds :: (OutputableBndr idL, OutputableBndr idR)
         => HsLocalBindsLR idL idR -> SDoc
679
pprBinds b = pprDeeper (ppr b)
680

681
-----------------------
682
683
ppr_lexpr :: OutputableBndr id => LHsExpr id -> SDoc
ppr_lexpr e = ppr_expr (unLoc e)
684

685
ppr_expr :: forall id. OutputableBndr id => HsExpr id -> SDoc
686
ppr_expr (HsVar (L _ v))  = pprPrefixOcc v
687
688
ppr_expr (HsUnboundVar v) = pprPrefixOcc v
ppr_expr (HsIPVar v)      = ppr v
Adam Gundry's avatar
Adam Gundry committed
689
ppr_expr (HsOverLabel l)  = char '#' <> ppr l
690
691
692
ppr_expr (HsLit lit)      = ppr lit
ppr_expr (HsOverLit lit)  = ppr lit
ppr_expr (HsPar e)        = parens (ppr_lexpr e)
693

694
ppr_expr (HsCoreAnn _ (StringLiteral _ s) e)
695
  = vcat [text "HsCoreAnn" <+> ftext s, ppr_lexpr e]
696

697
698
699
ppr_expr e@(HsApp {})        = ppr_apps e []
ppr_expr e@(HsAppType {})    = ppr_apps e []
ppr_expr e@(HsAppTypeOut {}) = ppr_apps e []
700

Ian Lynagh's avatar
Ian Lynagh committed
701
ppr_expr (OpApp e1 op _ e2)
702
  = case unLoc op of
703
      HsVar (L _ v) -> pp_infixly v
704
      HsRecFld f    -> pp_infixly f
705
      _             -> pp_prefixly
706
  where
Ian Lynagh's avatar
Ian Lynagh committed
707
    pp_e1 = pprDebugParendExpr e1   -- In debug mode, add parens
708
    pp_e2 = pprDebugParendExpr e2   -- to make precedence clear
709
710

    pp_prefixly
711
      = hang (ppr op) 2 (sep [pp_e1, pp_e2])
712
713

    pp_infixly v
714
      = sep [pp_e1, sep [pprInfixOcc v, nest 2 pp_e2]]
715

716
ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
717

718
ppr_expr (SectionL expr op)
719
  = case unLoc op of
720
721
      HsVar (L _ v) -> pp_infixly v
      _             -> pp_prefixly
722
  where
723
    pp_expr = pprDebugParendExpr expr
724

725
    pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
726
                       4 (hsep [pp_expr, text "x_ )"])
727
    pp_infixly v = (sep [pp_expr, pprInfixOcc v])
728

729
ppr_expr (SectionR op expr)
730
  = case unLoc op of
731
732
      HsVar (L _ v) -> pp_infixly v
      _             -> pp_prefixly
733
  where
734
    pp_expr = pprDebugParendExpr expr
735

736
    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, text "x_"])
737
                       4 (pp_expr <> rparen)
738
    pp_infixly v = sep [pprInfixOcc v, pp_expr]
739

740
ppr_expr (ExplicitTuple exprs boxity)
741
  = tupleParens (boxityTupleSort boxity) (fcat (ppr_tup_args $ map unLoc exprs))
742
743
744
  where
    ppr_tup_args []               = []
    ppr_tup_args (Present e : es) = (ppr_lexpr e <> punc es) : ppr_tup_args es
745
    ppr_tup_args (Missing _ : es) = punc es : ppr_tup_args es
746
747
748
749
750

    punc (Present {} : _) = comma <> space
    punc (Missing {} : _) = comma
    punc []               = empty

751
752
ppr_expr (HsLam matches)
  = pprMatches (LambdaExpr :: HsMatchContext id) matches
753

754
ppr_expr (HsLamCase _ matches)
755
  = sep [ sep [text "\\case {"],
756
757
          nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]

758
ppr_expr (HsCase expr matches)
759
  = sep [ sep [text "case", nest 4 (ppr expr), ptext (sLit "of {")],
760
          nest 2 (pprMatches (CaseAlt :: HsMatchContext id) matches <+> char '}') ]
761

762
ppr_expr (HsIf _ e1 e2 e3)
763
  = sep [hsep [text "if", nest 2 (ppr e1), ptext (sLit "then")],
Ian Lynagh's avatar
Ian Lynagh committed
764
         nest 4 (ppr e2),
765
         text "else",
Ian Lynagh's avatar
Ian Lynagh committed
766
         nest 4 (ppr e3)]
767

768
ppr_expr (HsMultiIf _ alts)
769
  = sep $ text "if" : map ppr_alt alts
770
  where ppr_alt (L _ (GRHS guards expr)) =
771
          sep [ vbar <+> interpp'SP guards
772
              , text "->" <+> pprDeeper (ppr expr) ]
773

774
-- special case: let ... in let ...
775
ppr_expr (HsLet (L _ binds) expr@(L _ (HsLet _ _)))
776
  = sep [hang (text "let") 2 (hsep [pprBinds binds, ptext (sLit "in")]),
Ian Lynagh's avatar
Ian Lynagh committed
777
         ppr_lexpr expr]
778

779
ppr_expr (HsLet (L _ binds) expr)
780
781
  = sep [hang (text "let") 2 (pprBinds binds),
         hang (text "in")  2 (ppr expr)]
782

783
ppr_expr (HsDo do_or_list_comp (L _ stmts) _) = pprDo do_or_list_comp stmts
784

785
ppr_expr (ExplicitList _ _ exprs)
786
  = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
787

chak's avatar
chak committed
788
ppr_expr (ExplicitPArr _ exprs)
789
  = paBrackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
chak's avatar
chak committed
790

791
ppr_expr (RecordCon { rcon_con_name = con_id, rcon_flds = rbinds })
792
  = hang (ppr con_id) 2 (ppr rbinds)
793

794
795
ppr_expr (RecordUpd { rupd_expr = L _ aexp, rupd_flds = rbinds })
  = hang (pprParendExpr aexp) 2 (braces (fsep (punctuate comma (map ppr rbinds))))
796

797
ppr_expr (ExprWithTySig expr sig)
798
  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
Ian Lynagh's avatar
Ian Lynagh committed
799
         4 (ppr sig)
800
801
ppr_expr (ExprWithTySigOut expr sig)
  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
Ian Lynagh's avatar
Ian Lynagh committed
802
         4 (ppr sig)
803

804
ppr_expr (ArithSeq _ _ info) = brackets (ppr info)
805
ppr_expr (PArrSeq  _ info) = paBrackets (ppr info)
chak's avatar
chak committed
806

Ian Lynagh's avatar
Ian Lynagh committed
807
ppr_expr EWildPat       = char '_'
808
809
ppr_expr (ELazyPat e)   = char '~' <> pprParendLExpr e
ppr_expr (EAsPat v e)   = ppr v <> char '@' <> pprParendLExpr e
810
ppr_expr (EViewPat p e) = ppr p <+> text "->" <+> ppr e
811

812
ppr_expr (HsSCC _ (StringLiteral _ lbl) expr)
813
  = sep [ text "{-# SCC" <+> doubleQuotes (ftext lbl) <+> ptext (sLit "#-}"),
814
815
816
817
818
          pprParendLExpr expr ]

ppr_expr (HsWrap co_fn e)
  = pprHsWrapper co_fn (\parens -> if parens then pprParendExpr e
                                             else pprExpr       e)
819

820
ppr_expr (HsSpliceE s)         = pprSplice s
821
ppr_expr (HsBracket b)         = pprHsBracket b
822
ppr_expr (HsRnBracketOut e []) = ppr e
823
ppr_expr (HsRnBracketOut e ps) = ppr e $$ text "pending(rn)" <+> ppr ps
824
ppr_expr (HsTcBracketOut e []) = ppr e
825
ppr_expr (HsTcBracketOut e ps) = ppr e $$ text "pending(tc)" <+> ppr ps
826

827
ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
828
  = hsep [text "proc", ppr pat, ptext (sLit "->"), ppr cmd]
829

Facundo Domínguez's avatar
Facundo Domínguez committed
830
ppr_expr (HsStatic e)
831
  = hsep [text "static", pprParendLExpr e]
Facundo Domínguez's avatar
Facundo Domínguez committed
832

833
ppr_expr (HsTick tickish exp)
834
  = pprTicks (ppr exp) $
Peter Wortmann's avatar
Peter Wortmann committed
835
    ppr tickish <+> ppr_lexpr exp
andy@galois.com's avatar
andy@galois.com committed
836
ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
837
  = pprTicks (ppr exp) $
838
    hcat [text "bintick<",
Ian Lynagh's avatar
Ian Lynagh committed
839
          ppr tickIdTrue,
840
          text ",",
Ian Lynagh's avatar
Ian Lynagh committed
841
          ppr tickIdFalse,
842
843
          text ">(",
          ppr exp, text ")"]
844
ppr_expr (HsTickPragma _ externalSrcLoc _ exp)
845
  = pprTicks (ppr exp) $
846
    hcat [text "tickpragma<",
847
          pprExternalSrcLoc externalSrcLoc,
848
          text ">(",
Ian Lynagh's avatar
Ian Lynagh committed
849
          ppr exp,
850
          text ")"]
andy@galois.com's avatar
andy@galois.com committed
851

852
ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
853
  = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]
854
ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
855
  = hsep [ppr_lexpr arg, arrowt, ppr_lexpr arrow]
856
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
857
  = hsep [ppr_lexpr arrow, larrowtt, ppr_lexpr arg]
858
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
859
  = hsep [ppr_lexpr arg, arrowtt, ppr_lexpr arrow]
860

861
ppr_expr (HsArrForm (L _ (HsVar (L _ v))) (Just _) [arg1, arg2])
862
  = sep [pprCmdArg (unLoc arg1), hsep [pprInfixOcc v, pprCmdArg (unLoc arg2)]]
863
ppr_expr (HsArrForm op _ args)
864
865
  = hang (text "(|" <+> ppr_lexpr op)
         4 (sep (map (pprCmdArg.unLoc) args) <+> text "|)")
866
ppr_expr (HsRecFld f) = ppr f
867

868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
-- We must tiresomely make the "id" parameter to the LHsWcType existential
-- because it's different in the HsAppType case and the HsAppTypeOut case
data LHsWcTypeX = forall id. OutputableBndr id => LHsWcTypeX (LHsWcType id)

ppr_apps :: OutputableBndr id
         => HsExpr id
         -> [Either (LHsExpr id) LHsWcTypeX]
         -> SDoc
ppr_apps (HsApp (L _ fun) arg)        args
  = ppr_apps fun (Left arg : args)
ppr_apps (HsAppType (L _ fun) arg)    args
  = ppr_apps fun (Right (LHsWcTypeX arg) : args)
ppr_apps (HsAppTypeOut (L _ fun) arg) args
  = ppr_apps fun (Right (LHsWcTypeX arg) : args)
ppr_apps fun args = hang (ppr_expr fun) 2 (sep (map pp args))
  where
    pp (Left arg)                             = pprParendLExpr arg
    pp (Right (LHsWcTypeX (HsWC { hswc_body = L _ arg })))
      = char '@' <> pprParendHsType arg

888
889
890
891
pprExternalSrcLoc :: (StringLiteral,(Int,Int),(Int,Int)) -> SDoc
pprExternalSrcLoc (StringLiteral _ src,(n1,n2),(n3,n4))
  = ppr (src,(n1,n2),(n3,n4))

Austin Seipp's avatar
Austin Seipp committed
892
{-
893
894
895
896
HsSyn records exactly where the user put parens, with HsPar.
So generally speaking we print without adding any parens.
However, some code is internally generated, and in some places
parens are absolutely required; so for these places we use
897
pprParendLExpr (but don't print double parens of course).
898

thomie's avatar
thomie committed
899