HsExpr.lhs 42.6 KB
Newer Older
1
%
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
%
5 6

HsExpr: Abstract Haskell syntax: expressions
7 8 9 10

\begin{code}
module HsExpr where

11
#include "HsVersions.h"
12 13

-- friends:
14 15 16 17 18 19
import HsDecls
import HsPat
import HsLit
import HsTypes
import HsImpExp
import HsBinds
20 21

-- others:
22 23 24
import Var
import Name
import BasicTypes
25
import DataCon
26
import SrcLoc
Ian Lynagh's avatar
Ian Lynagh committed
27
import Outputable
28
import FastString
29 30
\end{code}

31

32
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
33
%*                                                                      *
34
\subsection{Expressions proper}
Ian Lynagh's avatar
Ian Lynagh committed
35
%*                                                                      *
36 37 38
%************************************************************************

\begin{code}
39 40
type LHsExpr id = Located (HsExpr id)

41 42 43
-------------------------
-- PostTcExpr is an evidence expression attached to the
-- syntax tree by the type checker (c.f. postTcType)
Ian Lynagh's avatar
Ian Lynagh committed
44
-- We use a PostTcTable where there are a bunch of pieces of
45 46 47 48 49
-- evidence, more than is convenient to keep individually
type PostTcExpr  = HsExpr Id
type PostTcTable = [(Name, Id)]

noPostTcExpr :: PostTcExpr
Ian Lynagh's avatar
Ian Lynagh committed
50
noPostTcExpr = HsLit (HsString (fsLit "noPostTcExpr"))
51 52 53 54 55 56

noPostTcTable :: PostTcTable
noPostTcTable = []

-------------------------
-- SyntaxExpr is like PostTcExpr, but it's filled in a little earlier,
Ian Lynagh's avatar
Ian Lynagh committed
57
-- by the renamer.  It's used for rebindable syntax.
58 59
-- E.g. (>>=) is filled in before the renamer by the appropriate Name
--      for (>>=), and then instantiated by the type checker with its
Ian Lynagh's avatar
Ian Lynagh committed
60
--      type args tec
61 62 63

type SyntaxExpr id = HsExpr id

Ian Lynagh's avatar
Ian Lynagh committed
64 65
noSyntaxExpr :: SyntaxExpr id -- Before renaming, and sometimes after,
                              -- (if the syntax slot makes no sense)
Ian Lynagh's avatar
Ian Lynagh committed
66
noSyntaxExpr = HsLit (HsString (fsLit "noSyntaxExpr"))
67 68 69


type SyntaxTable id = [(Name, SyntaxExpr id)]
Ian Lynagh's avatar
Ian Lynagh committed
70
-- *** Currently used only for CmdTop (sigh) ***
71 72 73 74
-- * Before the renamer, this list is noSyntaxTable
--
-- * After the renamer, it takes the form [(std_name, HsVar actual_name)]
--   For example, for the 'return' op of a monad
Ian Lynagh's avatar
Ian Lynagh committed
75 76 77
--      normal case:            (GHC.Base.return, HsVar GHC.Base.return)
--      with rebindable syntax: (GHC.Base.return, return_22)
--              where return_22 is whatever "return" is in scope
78 79
--
-- * After the type checker, it takes the form [(std_name, <expression>)]
Ian Lynagh's avatar
Ian Lynagh committed
80
--      where <expression> is the evidence for the method
81 82 83 84 85 86

noSyntaxTable :: SyntaxTable id
noSyntaxTable = []


-------------------------
87
data HsExpr id
Ian Lynagh's avatar
Ian Lynagh committed
88 89 90
  = HsVar     id                        -- variable
  | HsIPVar   (IPName id)               -- implicit parameter
  | HsOverLit (HsOverLit id)            -- Overloaded literals
91

Ian Lynagh's avatar
Ian Lynagh committed
92
  | HsLit     HsLit                     -- Simple (non-overloaded) literals
93

Ian Lynagh's avatar
Ian Lynagh committed
94
  | HsLam     (MatchGroup id)           -- Currently always a single match
95

Ian Lynagh's avatar
Ian Lynagh committed
96
  | HsApp     (LHsExpr id) (LHsExpr id) -- Application
97

98
  -- Operator applications:
99 100
  -- NB Bracketed ops such as (+) come out as Vars.

101 102 103
  -- 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
104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 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 167 168 169 170
  | OpApp       (LHsExpr id)    -- left operand
                (LHsExpr id)    -- operator
                Fixity          -- Renamer adds fixity; bottom until then
                (LHsExpr id)    -- right operand

  | NegApp      (LHsExpr id)    -- negated expr
                (SyntaxExpr id) -- Name of 'negate'

  | HsPar       (LHsExpr id)    -- parenthesised expr

  | SectionL    (LHsExpr id)    -- operand
                (LHsExpr id)    -- operator
  | SectionR    (LHsExpr id)    -- operator
                (LHsExpr id)    -- operand

  | HsCase      (LHsExpr id)
                (MatchGroup id)

  | HsIf        (LHsExpr id)    --  predicate
                (LHsExpr id)    --  then part
                (LHsExpr id)    --  else part

  | HsLet       (HsLocalBinds id) -- let(rec)
                (LHsExpr  id)

  | HsDo        (HsStmtContext Name) -- The parameterisation is unimportant
                                     -- because in this context we never use
                                     -- the PatGuard or ParStmt variant
                [LStmt id]           -- "do":one or more stmts
                (LHsExpr id)         -- The body; the last expression in the
                                     -- 'do' of [ body | ... ] in a list comp
                PostTcType           -- Type of the whole expression

  | ExplicitList                -- syntactic list
                PostTcType      -- Gives type of components of list
                [LHsExpr id]

  | ExplicitPArr                -- syntactic parallel array: [:e1, ..., en:]
                PostTcType      -- type of elements of the parallel array
                [LHsExpr id]

  | ExplicitTuple               -- tuple
                [LHsExpr id]
                                -- NB: Unit is ExplicitTuple []
                                -- for tuples, we can get the types
                                -- direct from the components
                Boxity


  -- Record construction
  | RecordCon   (Located id)       -- The constructor.  After type checking
                                   -- it's the dataConWrapId of the constructor
                PostTcExpr         -- Data con Id applied to type args
                (HsRecordBinds id)

  -- Record update
  | RecordUpd   (LHsExpr id)
                (HsRecordBinds id)
                [DataCon]          -- Filled in by the type checker to the
                                   -- *non-empty* list of DataCons that have
                                   -- all the upd'd fields
                [PostTcType]       -- Argument types of *input* record type
                [PostTcType]       --              and  *output* record type
  -- For a type family, the arg types are of the *instance* tycon,
  -- not the family tycon

  | ExprWithTySig                       -- e :: type
171
                (LHsExpr id)
Ian Lynagh's avatar
Ian Lynagh committed
172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
                (LHsType id)

  | ExprWithTySigOut                    -- TRANSLATION
                (LHsExpr id)
                (LHsType Name)          -- Retain the signature for
                                        -- round-tripping purposes

  | ArithSeq                            -- arithmetic sequence
                PostTcExpr
                (ArithSeqInfo id)

  | PArrSeq                             -- arith. sequence for parallel array
                PostTcExpr              -- [:e1..e2:] or [:e1, e2..e3:]
                (ArithSeqInfo id)

  | HsSCC       FastString              -- "set cost centre" SCC pragma
                (LHsExpr id)            -- expr whose cost is to be measured

  | HsCoreAnn   FastString              -- hdaume: core annotation
                (LHsExpr id)

193
  -----------------------------------------------------------
194
  -- MetaHaskell Extensions
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
195

196
  | HsBracket    (HsBracket id)
197

Ian Lynagh's avatar
Ian Lynagh committed
198 199 200 201 202
  | HsBracketOut (HsBracket Name)       -- Output of the type checker is
                                        -- the *original*
                 [PendingSplice]        -- renamed expression, plus
                                        -- *typechecked* splices to be
                                        -- pasted back in by the desugarer
203

Ian Lynagh's avatar
Ian Lynagh committed
204
  | HsSpliceE (HsSplice id)
205

206 207 208
  | HsQuasiQuoteE (HsQuasiQuote id)
	-- See Note [Quasi-quote overview] in TcSplice

209 210 211
  -----------------------------------------------------------
  -- Arrow notation extension

Ian Lynagh's avatar
Ian Lynagh committed
212 213 214
  | HsProc      (LPat id)               -- arrow abstraction, proc
                (LHsCmdTop id)          -- body of the abstraction
                                        -- always has an empty stack
215 216 217 218

  ---------------------------------------
  -- The following are commands, not expressions proper

Ian Lynagh's avatar
Ian Lynagh committed
219 220 221 222 223 224 225 226
  | HsArrApp            -- Arrow tail, or arrow application (f -< arg)
        (LHsExpr id)    -- arrow expression, f
        (LHsExpr id)    -- input expression, arg
        PostTcType      -- 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)
227

Ian Lynagh's avatar
Ian Lynagh committed
228 229 230 231 232 233 234
  | 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
235

236

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
237 238 239
  ---------------------------------------
  -- Haskell program coverage (Hpc) Support

Ian Lynagh's avatar
Ian Lynagh committed
240 241
  | HsTick
     Int                                -- module-local tick number
242
     [id]                               -- variables in scope
Ian Lynagh's avatar
Ian Lynagh committed
243
     (LHsExpr id)                       -- sub-expression
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
244 245

  | HsBinTick
Ian Lynagh's avatar
Ian Lynagh committed
246 247 248
     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
249

Ian Lynagh's avatar
Ian Lynagh committed
250 251 252
  | HsTickPragma                        -- A pragma introduced tick
     (FastString,(Int,Int),(Int,Int))   -- external span for this tick
     (LHsExpr id)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
253 254 255 256

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

Ian Lynagh's avatar
Ian Lynagh committed
258
  | EWildPat                 -- wildcard
259

Ian Lynagh's avatar
Ian Lynagh committed
260 261
  | EAsPat      (Located id) -- as pattern
                (LHsExpr id)
262

Ian Lynagh's avatar
Ian Lynagh committed
263 264
  | EViewPat    (LHsExpr id) -- view pattern
                (LHsExpr id)
265

Ian Lynagh's avatar
Ian Lynagh committed
266
  | ELazyPat    (LHsExpr id) -- ~ pattern
267

Ian Lynagh's avatar
Ian Lynagh committed
268
  | HsType      (LHsType id) -- Explicit type argument; e.g  f {| Int |} x y
269

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
270 271
  ---------------------------------------
  -- Finally, HsWrap appears only in typechecker output
272

Ian Lynagh's avatar
Ian Lynagh committed
273 274
  |  HsWrap     HsWrapper    -- TRANSLATION
                (HsExpr id)
275

Ian Lynagh's avatar
Ian Lynagh committed
276 277
type PendingSplice = (Name, LHsExpr Id) -- Typechecked splices, waiting to be
                                        -- pasted back in by the desugarer
278 279 280 281 282 283 284 285 286
\end{code}

A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
@ClassDictLam dictvars methods expr@ is, therefore:
\begin{verbatim}
\ x -> case x of ( dictvars-and-methods-tuple ) -> expr
\end{verbatim}

\begin{code}
287
instance OutputableBndr id => Outputable (HsExpr id) where
288
    ppr expr = pprExpr expr
289 290 291
\end{code}

\begin{code}
292
-----------------------
Ian Lynagh's avatar
Ian Lynagh committed
293
-- pprExpr, pprLExpr, pprBinds call pprDeeper;
294 295
-- the underscore versions do not
pprLExpr :: OutputableBndr id => LHsExpr id -> SDoc
296 297 298
pprLExpr (L _ e) = pprExpr e

pprExpr :: OutputableBndr id => HsExpr id -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
299 300 301 302 303 304 305 306 307 308 309 310
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 (...)
isQuietHsExpr (HsPar _) = True
-- applications don't display anything themselves
isQuietHsExpr (HsApp _ _) = True
isQuietHsExpr (OpApp _ _ _ _) = True
isQuietHsExpr _ = False
311

Ian Lynagh's avatar
Ian Lynagh committed
312 313
pprBinds :: (OutputableBndr idL, OutputableBndr idR)
         => HsLocalBindsLR idL idR -> SDoc
314
pprBinds b = pprDeeper (ppr b)
315

316
-----------------------
317 318
ppr_lexpr :: OutputableBndr id => LHsExpr id -> SDoc
ppr_lexpr e = ppr_expr (unLoc e)
319

320
ppr_expr :: OutputableBndr id => HsExpr id -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
321
ppr_expr (HsVar v)       = pprHsVar v
322
ppr_expr (HsIPVar v)     = ppr v
323 324
ppr_expr (HsLit lit)     = ppr lit
ppr_expr (HsOverLit lit) = ppr lit
Ian Lynagh's avatar
Ian Lynagh committed
325
ppr_expr (HsPar e)       = parens (ppr_lexpr e)
326 327

ppr_expr (HsCoreAnn s e)
Ian Lynagh's avatar
Ian Lynagh committed
328
  = vcat [ptext (sLit "HsCoreAnn") <+> ftext s, ppr_lexpr e]
329

330 331
ppr_expr (HsApp e1 e2)
  = let (fun, args) = collect_args e1 [e2] in
332
    hang (ppr_lexpr fun) 2 (sep (map pprParendExpr args))
333
  where
334 335
    collect_args (L _ (HsApp fun arg)) args = collect_args fun (arg:args)
    collect_args fun args = (fun, args)
336

Ian Lynagh's avatar
Ian Lynagh committed
337
ppr_expr (OpApp e1 op _ e2)
338
  = case unLoc op of
339
      HsVar v -> pp_infixly v
Ian Lynagh's avatar
Ian Lynagh committed
340
      _       -> pp_prefixly
341
  where
Ian Lynagh's avatar
Ian Lynagh committed
342
    pp_e1 = pprDebugParendExpr e1   -- In debug mode, add parens
343
    pp_e2 = pprDebugParendExpr e2   -- to make precedence clear
344 345

    pp_prefixly
346
      = hang (ppr op) 2 (sep [pp_e1, pp_e2])
347 348

    pp_infixly v
349
      = sep [nest 2 pp_e1, pprInfix v, nest 2 pp_e2]
350

351
ppr_expr (NegApp e _) = char '-' <+> pprDebugParendExpr e
352

353
ppr_expr (SectionL expr op)
354
  = case unLoc op of
355
      HsVar v -> pp_infixly v
Ian Lynagh's avatar
Ian Lynagh committed
356
      _       -> pp_prefixly
357
  where
358
    pp_expr = pprDebugParendExpr expr
359

360
    pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
Ian Lynagh's avatar
Ian Lynagh committed
361
                       4 (hsep [pp_expr, ptext (sLit "x_ )")])
362
    pp_infixly v = (sep [pp_expr, pprInfix v])
363

364
ppr_expr (SectionR op expr)
365
  = case unLoc op of
366
      HsVar v -> pp_infixly v
Ian Lynagh's avatar
Ian Lynagh committed
367
      _       -> pp_prefixly
368
  where
369
    pp_expr = pprDebugParendExpr expr
370

Ian Lynagh's avatar
Ian Lynagh committed
371
    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext (sLit "x_")])
Ian Lynagh's avatar
Ian Lynagh committed
372
                       4 ((<>) pp_expr rparen)
373
    pp_infixly v
374
      = (sep [pprInfix v, pp_expr])
375

376 377 378 379
--avoid using PatternSignatures for stage1 code portability
ppr_expr exprType@(HsLam matches)
  = pprMatches (LambdaExpr `asTypeOf` idType exprType) matches
 where idType :: HsExpr id -> HsMatchContext id; idType = undefined
380

381
ppr_expr exprType@(HsCase expr matches)
Ian Lynagh's avatar
Ian Lynagh committed
382
  = sep [ sep [ptext (sLit "case"), nest 4 (ppr expr), ptext (sLit "of")],
383 384
          nest 2 (pprMatches (CaseAlt `asTypeOf` idType exprType) matches) ]
 where idType :: HsExpr id -> HsMatchContext id; idType = undefined
385

386
ppr_expr (HsIf e1 e2 e3)
Ian Lynagh's avatar
Ian Lynagh committed
387
  = sep [hsep [ptext (sLit "if"), nest 2 (ppr e1), ptext (sLit "then")],
Ian Lynagh's avatar
Ian Lynagh committed
388
         nest 4 (ppr e2),
Ian Lynagh's avatar
Ian Lynagh committed
389
         ptext (sLit "else"),
Ian Lynagh's avatar
Ian Lynagh committed
390
         nest 4 (ppr e3)]
391 392

-- special case: let ... in let ...
393
ppr_expr (HsLet binds expr@(L _ (HsLet _ _)))
Ian Lynagh's avatar
Ian Lynagh committed
394
  = sep [hang (ptext (sLit "let")) 2 (hsep [pprBinds binds, ptext (sLit "in")]),
Ian Lynagh's avatar
Ian Lynagh committed
395
         ppr_lexpr expr]
396

397
ppr_expr (HsLet binds expr)
Ian Lynagh's avatar
Ian Lynagh committed
398 399
  = sep [hang (ptext (sLit "let")) 2 (pprBinds binds),
         hang (ptext (sLit "in"))  2 (ppr expr)]
400

401
ppr_expr (HsDo do_or_list_comp stmts body _) = pprDo do_or_list_comp stmts body
402

403
ppr_expr (ExplicitList _ exprs)
404
  = brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
405

chak's avatar
chak committed
406
ppr_expr (ExplicitPArr _ exprs)
407
  = pa_brackets (pprDeeperList fsep (punctuate comma (map ppr_lexpr exprs)))
chak's avatar
chak committed
408

409
ppr_expr (ExplicitTuple exprs boxity)
410
  = tupleParens boxity (sep (punctuate comma (map ppr_lexpr exprs)))
411

Ian Lynagh's avatar
Ian Lynagh committed
412
ppr_expr (RecordCon con_id _ rbinds)
413
  = hang (ppr con_id) 2 (ppr rbinds)
414

415
ppr_expr (RecordUpd aexp rbinds _ _ _)
416
  = hang (pprParendExpr aexp) 2 (ppr rbinds)
417 418

ppr_expr (ExprWithTySig expr sig)
419
  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
Ian Lynagh's avatar
Ian Lynagh committed
420
         4 (ppr sig)
421 422
ppr_expr (ExprWithTySigOut expr sig)
  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
Ian Lynagh's avatar
Ian Lynagh committed
423
         4 (ppr sig)
424

Ian Lynagh's avatar
Ian Lynagh committed
425 426
ppr_expr (ArithSeq _ info) = brackets (ppr info)
ppr_expr (PArrSeq  _ info) = pa_brackets (ppr info)
chak's avatar
chak committed
427

Ian Lynagh's avatar
Ian Lynagh committed
428 429 430
ppr_expr EWildPat       = char '_'
ppr_expr (ELazyPat e)   = char '~' <> pprParendExpr e
ppr_expr (EAsPat v e)   = ppr v <> char '@' <> pprParendExpr e
Ian Lynagh's avatar
Ian Lynagh committed
431
ppr_expr (EViewPat p e) = ppr p <+> ptext (sLit "->") <+> ppr e
432 433

ppr_expr (HsSCC lbl expr)
Ian Lynagh's avatar
Ian Lynagh committed
434
  = sep [ ptext (sLit "_scc_") <+> doubleQuotes (ftext lbl),
Ian Lynagh's avatar
Ian Lynagh committed
435
          pprParendExpr expr ]
436

437
ppr_expr (HsWrap co_fn e) = pprHsWrapper (pprExpr e) co_fn
Ian Lynagh's avatar
Ian Lynagh committed
438
ppr_expr (HsType id)      = ppr id
chak's avatar
chak committed
439

440 441
ppr_expr (HsSpliceE s)       = pprSplice s
ppr_expr (HsBracket b)       = pprHsBracket b
Ian Lynagh's avatar
Ian Lynagh committed
442
ppr_expr (HsBracketOut e []) = ppr e
Ian Lynagh's avatar
Ian Lynagh committed
443
ppr_expr (HsBracketOut e ps) = ppr e $$ ptext (sLit "pending") <+> ppr ps
444 445
ppr_expr (HsQuasiQuoteE (HsQuasiQuote name quoter _ quote)) 
    = char '$' <> brackets (ppr name) <>
Ian Lynagh's avatar
Ian Lynagh committed
446 447
      ptext (sLit "[:") <> ppr quoter <> ptext (sLit "|") <>
      ppr quote <> ptext (sLit "|]")
448

449
ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
Ian Lynagh's avatar
Ian Lynagh committed
450
  = hsep [ptext (sLit "proc"), ppr pat, ptext (sLit "->"), ppr cmd]
451

452
ppr_expr (HsTick tickId vars exp)
Ian Lynagh's avatar
Ian Lynagh committed
453
  = hcat [ptext (sLit "tick<"),
Ian Lynagh's avatar
Ian Lynagh committed
454
          ppr tickId,
Ian Lynagh's avatar
Ian Lynagh committed
455
          ptext (sLit ">("),
Ian Lynagh's avatar
Ian Lynagh committed
456 457
          hsep (map pprHsVar vars),
          ppr exp,
Ian Lynagh's avatar
Ian Lynagh committed
458
          ptext (sLit ")")]
andy@galois.com's avatar
andy@galois.com committed
459
ppr_expr (HsBinTick tickIdTrue tickIdFalse exp)
Ian Lynagh's avatar
Ian Lynagh committed
460
  = hcat [ptext (sLit "bintick<"),
Ian Lynagh's avatar
Ian Lynagh committed
461
          ppr tickIdTrue,
Ian Lynagh's avatar
Ian Lynagh committed
462
          ptext (sLit ","),
Ian Lynagh's avatar
Ian Lynagh committed
463
          ppr tickIdFalse,
Ian Lynagh's avatar
Ian Lynagh committed
464 465
          ptext (sLit ">("),
          ppr exp,ptext (sLit ")")]
andy@galois.com's avatar
andy@galois.com committed
466
ppr_expr (HsTickPragma externalSrcLoc exp)
Ian Lynagh's avatar
Ian Lynagh committed
467
  = hcat [ptext (sLit "tickpragma<"),
Ian Lynagh's avatar
Ian Lynagh committed
468
          ppr externalSrcLoc,
Ian Lynagh's avatar
Ian Lynagh committed
469
          ptext (sLit ">("),
Ian Lynagh's avatar
Ian Lynagh committed
470
          ppr exp,
Ian Lynagh's avatar
Ian Lynagh committed
471
          ptext (sLit ")")]
andy@galois.com's avatar
andy@galois.com committed
472

473
ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
Ian Lynagh's avatar
Ian Lynagh committed
474
  = hsep [ppr_lexpr arrow, ptext (sLit "-<"), ppr_lexpr arg]
475
ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
Ian Lynagh's avatar
Ian Lynagh committed
476
  = hsep [ppr_lexpr arg, ptext (sLit ">-"), ppr_lexpr arrow]
477
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
Ian Lynagh's avatar
Ian Lynagh committed
478
  = hsep [ppr_lexpr arrow, ptext (sLit "-<<"), ppr_lexpr arg]
479
ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
Ian Lynagh's avatar
Ian Lynagh committed
480
  = hsep [ppr_lexpr arg, ptext (sLit ">>-"), ppr_lexpr arrow]
481

482 483 484
ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
  = sep [pprCmdArg (unLoc arg1), hsep [pprInfix v, pprCmdArg (unLoc arg2)]]
ppr_expr (HsArrForm op _ args)
Ian Lynagh's avatar
Ian Lynagh committed
485 486
  = hang (ptext (sLit "(|") <> ppr_lexpr op)
         4 (sep (map (pprCmdArg.unLoc) args) <> ptext (sLit "|)"))
487 488

pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
489 490 491 492
pprCmdArg (HsCmdTop cmd@(L _ (HsArrForm _ Nothing [])) _ _ _)
  = ppr_lexpr cmd
pprCmdArg (HsCmdTop cmd _ _ _)
  = parens (ppr_lexpr cmd)
493

Ian Lynagh's avatar
Ian Lynagh committed
494 495 496
instance OutputableBndr id => Outputable (HsCmdTop id) where
    ppr = pprCmdArg

497 498 499
-- Put a var in backquotes if it's not an operator already
pprInfix :: Outputable name => name -> SDoc
pprInfix v | isOperator ppr_v = ppr_v
Ian Lynagh's avatar
Ian Lynagh committed
500 501
           | otherwise        = char '`' <> ppr_v <> char '`'
    where ppr_v = ppr v
502

chak's avatar
chak committed
503 504
-- add parallel array brackets around a document
--
505
pa_brackets :: SDoc -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
506
pa_brackets p = ptext (sLit "[:") <> p <> ptext (sLit ":]")
507 508
\end{code}

509 510 511 512 513 514 515 516 517 518
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
pprParendExpr (but don't print double parens of course).

For operator applications we don't add parens, because the oprerator
fixities should do the job, except in debug mode (-dppr-debug) so we
can see the structure of the parse tree.

519
\begin{code}
520 521 522 523
pprDebugParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
pprDebugParendExpr expr
  = getPprStyle (\sty ->
    if debugStyle sty then pprParendExpr expr
Ian Lynagh's avatar
Ian Lynagh committed
524 525
                      else pprLExpr      expr)

526
pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
527
pprParendExpr expr
528
  = let
Ian Lynagh's avatar
Ian Lynagh committed
529 530 531
        pp_as_was = pprLExpr expr
        -- Using pprLExpr makes sure that we go 'deeper'
        -- I think that is usually (always?) right
532
    in
533
    case unLoc expr of
Ian Lynagh's avatar
Ian Lynagh committed
534 535 536 537
      HsLit _              -> pp_as_was
      HsOverLit _          -> pp_as_was
      HsVar _              -> pp_as_was
      HsIPVar _            -> pp_as_was
538 539
      ExplicitList _ _     -> pp_as_was
      ExplicitPArr _ _     -> pp_as_was
Ian Lynagh's avatar
Ian Lynagh committed
540 541 542 543
      ExplicitTuple _ _    -> pp_as_was
      HsPar _              -> pp_as_was
      HsBracket _          -> pp_as_was
      HsBracketOut _ []    -> pp_as_was
544 545
      HsDo sc _ _ _
       | isListCompExpr sc -> pp_as_was
Ian Lynagh's avatar
Ian Lynagh committed
546
      _                    -> parens pp_as_was
547

Ian Lynagh's avatar
Ian Lynagh committed
548
isAtomicHsExpr :: HsExpr id -> Bool -- A single token
549 550 551 552 553 554
isAtomicHsExpr (HsVar {})     = True
isAtomicHsExpr (HsLit {})     = True
isAtomicHsExpr (HsOverLit {}) = True
isAtomicHsExpr (HsIPVar {})   = True
isAtomicHsExpr (HsWrap _ e)   = isAtomicHsExpr e
isAtomicHsExpr (HsPar e)      = isAtomicHsExpr (unLoc e)
Ian Lynagh's avatar
Ian Lynagh committed
555
isAtomicHsExpr _              = False
556 557
\end{code}

558
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
559
%*                                                                      *
560
\subsection{Commands (in arrow abstractions)}
Ian Lynagh's avatar
Ian Lynagh committed
561
%*                                                                      *
562 563 564 565 566 567 568
%************************************************************************

We re-use HsExpr to represent these.

\begin{code}
type HsCmd id = HsExpr id

569 570
type LHsCmd id = LHsExpr id

571 572 573 574 575
data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
\end{code}

The legal constructors for commands are:

Ian Lynagh's avatar
Ian Lynagh committed
576
  = HsArrApp ...                -- as above
577

Ian Lynagh's avatar
Ian Lynagh committed
578
  | HsArrForm ...               -- as above
579

Ian Lynagh's avatar
Ian Lynagh committed
580 581
  | HsApp       (HsCmd id)
                (HsExpr id)
ross's avatar
ross committed
582

Ian Lynagh's avatar
Ian Lynagh committed
583
  | HsLam       (Match  id)     -- kappa
584 585

  -- the renamer turns this one into HsArrForm
Ian Lynagh's avatar
Ian Lynagh committed
586 587 588 589
  | OpApp       (HsExpr id)     -- left operand
                (HsCmd id)      -- operator
                Fixity          -- Renamer adds fixity; bottom until then
                (HsCmd id)      -- right operand
590

Ian Lynagh's avatar
Ian Lynagh committed
591
  | HsPar       (HsCmd id)      -- parenthesised command
592

Ian Lynagh's avatar
Ian Lynagh committed
593 594 595
  | HsCase      (HsExpr id)
                [Match id]      -- bodies are HsCmd's
                SrcLoc
596

Ian Lynagh's avatar
Ian Lynagh committed
597 598 599 600
  | HsIf        (HsExpr id)     --  predicate
                (HsCmd id)      --  then part
                (HsCmd id)      --  else part
                SrcLoc
601

Ian Lynagh's avatar
Ian Lynagh committed
602 603
  | HsLet       (HsLocalBinds id)       -- let(rec)
                (HsCmd  id)
604

Ian Lynagh's avatar
Ian Lynagh committed
605 606 607 608 609 610
  | HsDo        (HsStmtContext Name)    -- The parameterisation is unimportant
                                        -- because in this context we never use
                                        -- the PatGuard or ParStmt variant
                [Stmt id]       -- HsExpr's are really HsCmd's
                PostTcType      -- Type of the whole expression
                SrcLoc
611 612 613 614 615 616

Top-level command, introducing a new arrow.
This may occur inside a proc (where the stack is empty) or as an
argument of a command-forming operator.

\begin{code}
617 618
type LHsCmdTop id = Located (HsCmdTop id)

619
data HsCmdTop id
Ian Lynagh's avatar
Ian Lynagh committed
620 621 622 623 624
  = HsCmdTop (LHsCmd id)
             [PostTcType]     -- types of inputs on the command's stack
             PostTcType       -- return type of the command
             (SyntaxTable id) -- after type checking:
                              -- names used in the command's desugaring
625 626
\end{code}

627
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
628
%*                                                                      *
629
\subsection{Record binds}
Ian Lynagh's avatar
Ian Lynagh committed
630
%*                                                                      *
631 632 633
%************************************************************************

\begin{code}
634
type HsRecordBinds id = HsRecFields id (LHsExpr id)
635 636
\end{code}

637 638


639
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
640
%*                                                                      *
641
\subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
Ian Lynagh's avatar
Ian Lynagh committed
642
%*                                                                      *
643 644
%************************************************************************

645 646 647 648 649 650 651 652 653 654 655 656 657 658
@Match@es are sets of pattern bindings and right hand sides for
functions, patterns or case branches. For example, if a function @g@
is defined as:
\begin{verbatim}
g (x,y) = y
g ((x:ys),y) = y+1,
\end{verbatim}
then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.

It is always the case that each element of an @[Match]@ list has the
same number of @pats@s inside it.  This corresponds to saying that
a function defined by pattern matching must have the same number of
patterns in each equation.

659
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
660 661 662 663 664 665
data MatchGroup id
  = MatchGroup
        [LMatch id]     -- The alternatives
        PostTcType      -- The type is the type of the entire group
                        --      t1 -> ... -> tn -> tr
                        -- where there are n patterns
666

667 668
type LMatch id = Located (Match id)

669
data Match id
670
  = Match
Ian Lynagh's avatar
Ian Lynagh committed
671 672 673 674
        [LPat id]               -- The patterns
        (Maybe (LHsType id))    -- A type signature for the result of the match
                                -- Nothing after typechecking
        (GRHSs id)
675

676
matchGroupArity :: MatchGroup id -> Arity
Ian Lynagh's avatar
Ian Lynagh committed
677 678
matchGroupArity (MatchGroup [] _)
  = panic "matchGroupArity"     -- MatchGroup is never empty
679 680
matchGroupArity (MatchGroup (match:matches) _)
  = ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
Ian Lynagh's avatar
Ian Lynagh committed
681
    -- Assertion just checks that all the matches have the same number of pats
682 683 684 685
    n_pats
  where
    n_pats = length (hsLMatchPats match)

686 687 688
hsLMatchPats :: LMatch id -> [LPat id]
hsLMatchPats (L _ (Match pats _ _)) = pats

689
-- GRHSs are used both for pattern bindings and for Matches
Ian Lynagh's avatar
Ian Lynagh committed
690 691 692
data GRHSs id
  = GRHSs [LGRHS id]             -- Guarded RHSs
          (HsLocalBinds id)      -- The where clause
693

694
type LGRHS id = Located (GRHS id)
695

Ian Lynagh's avatar
Ian Lynagh committed
696 697
data GRHS id = GRHS [LStmt id]   -- Guards
                    (LHsExpr id) -- Right hand side
698
\end{code}
699

700
We know the list must have at least one @Match@ in it.
701

702
\begin{code}
703
pprMatches :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> MatchGroup idR -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
704 705
pprMatches ctxt (MatchGroup matches _)
    = vcat (map (pprMatch ctxt) (map unLoc matches))
Ian Lynagh's avatar
Ian Lynagh committed
706
      -- Don't print the type; it's only a place-holder before typechecking
707 708

-- Exported to HsBinds, which can't see the defn of HsMatchContext
709
pprFunBind :: (OutputableBndr idL, OutputableBndr idR) => idL -> Bool -> MatchGroup idR -> SDoc
710
pprFunBind fun inf matches = pprMatches (FunRhs fun inf) matches
711 712

-- Exported to HsBinds, which can't see the defn of HsMatchContext
713
pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
Ian Lynagh's avatar
Ian Lynagh committed
714
           => LPat bndr -> GRHSs id -> SDoc
715 716 717 718
pprPatBind pat ty@(grhss)
 = sep [ppr pat, nest 4 (pprGRHSs (PatBindRhs `asTypeOf` idType ty) grhss)]
--avoid using PatternSignatures for stage1 code portability
 where idType :: GRHSs id -> HsMatchContext id; idType = undefined
719 720


721
pprMatch :: (OutputableBndr idL, OutputableBndr idR) => HsMatchContext idL -> Match idR -> SDoc
722
pprMatch ctxt (Match pats maybe_ty grhss)
Ian Lynagh's avatar
Ian Lynagh committed
723 724 725
  = herald <+> sep [sep (map ppr other_pats),
                    ppr_maybe_ty,
                    nest 2 (pprGRHSs ctxt grhss)]
726
  where
Ian Lynagh's avatar
Ian Lynagh committed
727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745
    (herald, other_pats)
        = case ctxt of
            FunRhs fun is_infix
                | not is_infix -> (ppr fun, pats)
                        -- f x y z = e
                        -- Not pprBndr; the AbsBinds will
                        -- have printed the signature

                | null pats3 -> (pp_infix, [])
                        -- x &&& y = e

                | otherwise -> (parens pp_infix, pats3)
                        -- (x &&& y) z = e
                where
                  (pat1:pat2:pats3) = pats
                  pp_infix = ppr pat1 <+> ppr fun <+> ppr pat2

            LambdaExpr -> (char '\\', pats)
            _          -> (empty,     pats)
746

747
    ppr_maybe_ty = case maybe_ty of
Ian Lynagh's avatar
Ian Lynagh committed
748 749
                        Just ty -> dcolon <+> ppr ty
                        Nothing -> empty
750 751


Ian Lynagh's avatar
Ian Lynagh committed
752 753
pprGRHSs :: (OutputableBndr idL, OutputableBndr idR)
         => HsMatchContext idL -> GRHSs idR -> SDoc
754
pprGRHSs ctxt (GRHSs grhss binds)
Ian Lynagh's avatar
Ian Lynagh committed
755 756 757
  = vcat (map (pprGRHS ctxt . unLoc) grhss)
 $$ if isEmptyLocalBinds binds then empty
                               else text "where" $$ nest 4 (pprBinds binds)
758

Ian Lynagh's avatar
Ian Lynagh committed
759 760
pprGRHS :: (OutputableBndr idL, OutputableBndr idR)
        => HsMatchContext idL -> GRHS idR -> SDoc
761

762
pprGRHS ctxt (GRHS [] expr)
763
 =  pp_rhs ctxt expr
764

765
pprGRHS ctxt (GRHS guards expr)
766
 = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
767

Ian Lynagh's avatar
Ian Lynagh committed
768
pp_rhs :: OutputableBndr idR => HsMatchContext idL -> LHsExpr idR -> SDoc
769
pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
770
\end{code}
771

772
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
773
%*                                                                      *
774
\subsection{Do stmts and list comprehensions}
Ian Lynagh's avatar
Ian Lynagh committed
775
%*                                                                      *
776 777 778
%************************************************************************

\begin{code}
779 780 781 782
type LStmt id = Located (StmtLR id id)
type LStmtLR idL idR = Located (StmtLR idL idR)

type Stmt id = StmtLR id id
783

Ian Lynagh's avatar
Ian Lynagh committed
784 785 786 787 788 789 790 791
data GroupByClause id
    = GroupByNothing (LHsExpr id) -- Using expression, i.e.
                                  -- "then group using f" ==> GroupByNothing f
    | GroupBySomething (Either (LHsExpr id) (SyntaxExpr id)) (LHsExpr id)
      -- "then group using f by e" ==> GroupBySomething (Left f) e
      -- "then group by e"         ==> GroupBySomething (Right _) e: in
      --                               this case the expression is filled
      --                               in by the renamer
792

793 794
-- The SyntaxExprs in here are used *only* for do-notation, which
-- has rebindable syntax.  Otherwise they are unused.
795
data StmtLR idL idR
Ian Lynagh's avatar
Ian Lynagh committed
796 797 798 799 800 801
  = BindStmt (LPat idL)
             (LHsExpr idR)
             (SyntaxExpr idR) -- The (>>=) operator
             (SyntaxExpr idR) -- The fail operator
             -- The fail operator is noSyntaxExpr
             -- if the pattern match can't fail
802

Ian Lynagh's avatar
Ian Lynagh committed
803 804 805
  | ExprStmt (LHsExpr idR)
             (SyntaxExpr idR) -- The (>>) operator
             PostTcType       -- Element type of the RHS (used for arrows)
806

Ian Lynagh's avatar
Ian Lynagh committed
807
  | LetStmt  (HsLocalBindsLR idL idR)
808

Ian Lynagh's avatar
Ian Lynagh committed
809 810 811 812
  -- ParStmts only occur in a list comprehension
  | ParStmt  [([LStmt idL], [idR])]
  -- After renaming, the ids are the binders bound by the stmts and used
  -- after them
813 814

  | TransformStmt ([LStmt idL], [idR]) (LHsExpr idR) (Maybe (LHsExpr idR))
Ian Lynagh's avatar
Ian Lynagh committed
815 816 817 818
  -- After renaming, the IDs are the binders occurring within this
  -- transform statement that are used after it
  -- "qs, then f by e" ==> TransformStmt (qs, binders) f (Just e)
  -- "qs, then f"      ==> TransformStmt (qs, binders) f Nothing
819 820

  | GroupStmt ([LStmt idL], [(idR, idR)]) (GroupByClause idR)
Ian Lynagh's avatar
Ian Lynagh committed
821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845
  -- After renaming, the IDs are the binders occurring within this
  -- transform statement that are used after it which are paired with
  -- the names which they group over in statements

  -- Recursive statement (see Note [RecStmt] below)
  | RecStmt  [LStmtLR idL idR]
             --- The next two fields are only valid after renaming
             [idR] -- The ids are a subset of the variables bound by the
                   -- stmts that are used in stmts that follow the RecStmt

             [idR] -- Ditto, but these variables are the "recursive" ones,
                   -- that are used before they are bound in the stmts of
                   -- the RecStmt. From a type-checking point of view,
                   -- these ones have to be monomorphic

             --- These fields are only valid after typechecking
             [PostTcExpr]       -- These expressions correspond 1-to-1 with
                                -- the "recursive" [id], and are the
                                -- expressions that should be returned by
                                -- the recursion.
                                -- They may not quite be the Ids themselves,
                                -- because the Id may be *polymorphic*, but
                                -- the returned thing has to be *monomorphic*.
             (DictBinds idR)    -- Method bindings of Ids bound by the
                                -- RecStmt, and used afterwards
846 847
\end{code}

848
ExprStmts are a bit tricky, because what they mean
849
depends on the context.  Consider the following contexts:
850

Ian Lynagh's avatar
Ian Lynagh committed
851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870
        A do expression of type (m res_ty)
        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        * ExprStmt E any_ty:   do { ....; E; ... }
                E :: m any_ty
          Translation: E >> ...

        A list comprehensions of type [elt_ty]
        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        * ExprStmt E Bool:   [ .. | .... E ]
                        [ .. | ..., E, ... ]
                        [ .. | .... | ..., E | ... ]
                E :: Bool
          Translation: if E then fail else ...

        A guard list, guarding a RHS of type rhs_ty
        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        * ExprStmt E Bool:   f x | ..., E, ... = ...rhs...
                E :: Bool
          Translation: if E then fail else ...

chak's avatar
chak committed
871
Array comprehensions are handled like list comprehensions -=chak
872

873 874 875
Note [RecStmt]
~~~~~~~~~~~~~~
Example:
Ian Lynagh's avatar
Ian Lynagh committed
876
        HsDo [ BindStmt x ex
877

Ian Lynagh's avatar
Ian Lynagh committed
878 879 880 881 882
             , RecStmt [a::forall a. a -> a, b]
                       [a::Int -> Int,       c]
                       [ BindStmt b (return x)
                       , LetStmt a = ea
                       , BindStmt c ec ]
883

Ian Lynagh's avatar
Ian Lynagh committed
884
             , return (a b) ]
885

Ian Lynagh's avatar
Ian Lynagh committed
886 887 888
Here, the RecStmt binds a,b,c; but
  - Only a,b are used in the stmts *following* the RecStmt,
        This 'a' is *polymorphic'
889
  - Only a,c are used in the stmts *inside* the RecStmt
Ian Lynagh's avatar
Ian Lynagh committed
890 891
        *before* their bindings
        This 'a' is monomorphic
892 893 894 895 896

Nota Bene: the two a's have different types, even though they
have the same Name.


897
\begin{code}
898
instance (OutputableBndr idL, OutputableBndr idR) => Outputable (StmtLR idL idR) where