ghc/compiler/hsSyn/HsExpr.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
   3 %
   4 \section[HsExpr]{Abstract Haskell syntax: expressions}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module HsExpr where
  10
  11 import Ubiq{-uitous-}
  12 import HsLoop -- for paranoia checking
  13
  14 -- friends:
  15 import HsBinds          ( HsBinds )
  16 import HsLit            ( HsLit )
  17 import HsMatches        ( pprMatches, pprMatch, Match )
  18 import HsTypes          ( PolyType )
  19
  20 -- others:
  21 import Id               ( DictVar(..), GenId, Id(..) )
  22 import Name             ( isOpLexeme, pprOp )
  23 import Outputable       ( interppSP, interpp'SP, ifnotPprForUser )
  24 import PprType          ( pprGenType, pprParendGenType, GenType{-instance-} )
  25 import Pretty
  26 import PprStyle         ( PprStyle(..) )
  27 import SrcLoc           ( SrcLoc )
  28 import Usage            ( GenUsage{-instance-} )
  29 import Util             ( panic{-ToDo:rm eventually-} )
  30 \end{code}
  31
  32 %************************************************************************
  33 %*                                                                      *
  34 \subsection{Expressions proper}
  35 %*                                                                      *
  36 %************************************************************************
  37
  38 \begin{code}
  39 data HsExpr tyvar uvar id pat
  40   = HsVar       id                              -- variable
  41   | HsLit       HsLit                           -- literal
  42   | HsLitOut    HsLit                           -- TRANSLATION
  43                 (GenType tyvar uvar)            -- (with its type)
  44
  45   | HsLam       (Match  tyvar uvar id pat)      -- lambda
  46   | HsApp       (HsExpr tyvar uvar id pat)      -- application
  47                 (HsExpr tyvar uvar id pat)
  48
  49   -- Operator applications:
  50   -- NB Bracketed ops such as (+) come out as Vars.
  51
  52   -- NB We need an expr for the operator in an OpApp/Section since
  53   -- the typechecker may need to apply the operator to a few types.
  54
  55   | OpApp       (HsExpr tyvar uvar id pat)      -- left operand
  56                 (HsExpr tyvar uvar id pat)      -- operator
  57                 (HsExpr tyvar uvar id pat)      -- right operand
  58
  59   -- We preserve prefix negation and parenthesis for the precedence parser.
  60
  61   | NegApp      (HsExpr tyvar uvar id pat)      -- negated expr
  62   | HsPar       (HsExpr tyvar uvar id pat)      -- parenthesised expr
  63
  64   | SectionL    (HsExpr tyvar uvar id pat)      -- operand
  65                 (HsExpr tyvar uvar id pat)      -- operator
  66   | SectionR    (HsExpr tyvar uvar id pat)      -- operator
  67                 (HsExpr tyvar uvar id pat)      -- operand
  68
  69
  70   | HsCase      (HsExpr tyvar uvar id pat)
  71                 [Match  tyvar uvar id pat]      -- must have at least one Match
  72                 SrcLoc
  73
  74   | HsIf        (HsExpr tyvar uvar id pat)      --  predicate
  75                 (HsExpr tyvar uvar id pat)      --  then part
  76                 (HsExpr tyvar uvar id pat)      --  else part
  77                 SrcLoc
  78
  79   | HsLet       (HsBinds tyvar uvar id pat)     -- let(rec)
  80                 (HsExpr  tyvar uvar id pat)
  81
  82   | HsDo        [Stmt tyvar uvar id pat]        -- "do":one or more stmts
  83                 SrcLoc
  84
  85   | HsDoOut     [Stmt tyvar uvar id pat]        -- "do":one or more stmts
  86                 id id                           -- Monad and MonadZero dicts
  87                 SrcLoc
  88
  89   | ListComp    (HsExpr tyvar uvar id pat)      -- list comprehension
  90                 [Qual   tyvar uvar id pat]      -- at least one Qual(ifier)
  91
  92   | ExplicitList                -- syntactic list
  93                 [HsExpr tyvar uvar id pat]
  94   | ExplicitListOut             -- TRANSLATION
  95                 (GenType tyvar uvar)    -- Gives type of components of list
  96                 [HsExpr tyvar uvar id pat]
  97
  98   | ExplicitTuple               -- tuple
  99                 [HsExpr tyvar uvar id pat]
 100                                 -- NB: Unit is ExplicitTuple []
 101                                 -- for tuples, we can get the types
 102                                 -- direct from the components
 103
 104         -- Record construction
 105   | RecordCon   (HsExpr tyvar uvar id pat)      -- Always (HsVar id) until type checker,
 106                                                 -- but the latter adds its type args too
 107                 (HsRecordBinds tyvar uvar id pat)
 108
 109         -- Record update
 110   | RecordUpd   (HsExpr tyvar uvar id pat)
 111                 (HsRecordBinds tyvar uvar id pat)
 112
 113   | RecordUpdOut        (HsExpr tyvar uvar id pat)      -- TRANSLATION
 114                         [id]                            -- Dicts needed for construction
 115                         (HsRecordBinds tyvar uvar id pat)
 116
 117   | ExprWithTySig               -- signature binding
 118                 (HsExpr tyvar uvar id pat)
 119                 (PolyType id)
 120   | ArithSeqIn                  -- arithmetic sequence
 121                 (ArithSeqInfo tyvar uvar id pat)
 122   | ArithSeqOut
 123                 (HsExpr       tyvar uvar id pat) -- (typechecked, of course)
 124                 (ArithSeqInfo tyvar uvar id pat)
 125
 126   | CCall       FAST_STRING     -- call into the C world; string is
 127                 [HsExpr tyvar uvar id pat]      -- the C function; exprs are the
 128                                 -- arguments to pass.
 129                 Bool            -- True <=> might cause Haskell
 130                                 -- garbage-collection (must generate
 131                                 -- more paranoid code)
 132                 Bool            -- True <=> it's really a "casm"
 133                                 -- NOTE: this CCall is the *boxed*
 134                                 -- version; the desugarer will convert
 135                                 -- it into the unboxed "ccall#".
 136                 (GenType tyvar uvar)    -- The result type; will be *bottom*
 137                                 -- until the typechecker gets ahold of it
 138
 139   | HsSCC       FAST_STRING     -- "set cost centre" (_scc_) annotation
 140                 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
 141 \end{code}
 142
 143 Everything from here on appears only in typechecker output.
 144
 145 \begin{code}
 146   | TyLam                       -- TRANSLATION
 147                 [tyvar]
 148                 (HsExpr tyvar uvar id pat)
 149   | TyApp                       -- TRANSLATION
 150                 (HsExpr  tyvar uvar id pat) -- generated by Spec
 151                 [GenType tyvar uvar]
 152
 153   -- DictLam and DictApp are "inverses"
 154   |  DictLam
 155                 [id]
 156                 (HsExpr tyvar uvar id pat)
 157   |  DictApp
 158                 (HsExpr tyvar uvar id pat)
 159                 [id]
 160
 161   -- ClassDictLam and Dictionary are "inverses" (see note below)
 162   |  ClassDictLam
 163                 [id]            -- superclass dicts
 164                 [id]            -- methods
 165                 (HsExpr tyvar uvar id pat)
 166   |  Dictionary
 167                 [id]            -- superclass dicts
 168                 [id]            -- methods
 169
 170   |  SingleDict                 -- a simple special case of Dictionary
 171                 id              -- local dictionary name
 172
 173   |  HsCon                      -- TRANSLATION; a constructor application
 174         Id                      -- used only in the RHS of constructor definitions
 175         [GenType tyvar uvar]
 176         [HsExpr tyvar uvar id pat]
 177
 178 type HsRecordBinds tyvar uvar id pat
 179   = [(id, HsExpr tyvar uvar id pat, Bool)]
 180         -- True <=> source code used "punning",
 181         -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
 182 \end{code}
 183
 184 A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
 185 @ClassDictLam dictvars methods expr@ is, therefore:
 186 \begin{verbatim}
 187 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
 188 \end{verbatim}
 189
 190 \begin{code}
 191 instance (NamedThing id, Outputable id, Outputable pat,
 192           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 193                 Outputable (HsExpr tyvar uvar id pat) where
 194     ppr = pprExpr
 195 \end{code}
 196
 197 \begin{code}
 198 pprExpr sty (HsVar v)
 199   = (if (isOpLexeme v) then ppParens else id) (ppr sty v)
 200
 201 pprExpr sty (HsLit    lit)   = ppr sty lit
 202 pprExpr sty (HsLitOut lit _) = ppr sty lit
 203
 204 pprExpr sty (HsLam match)
 205   = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
 206
 207 pprExpr sty expr@(HsApp e1 e2)
 208   = let (fun, args) = collect_args expr [] in
 209     ppHang (pprParendExpr sty fun) 4 (ppSep (map (pprParendExpr sty) args))
 210   where
 211     collect_args (HsApp fun arg) args = collect_args fun (arg:args)
 212     collect_args fun             args = (fun, args)
 213
 214
 215 pprExpr sty (OpApp e1 op e2)
 216   = case op of
 217       HsVar v -> pp_infixly v
 218       _       -> pp_prefixly
 219   where
 220     pp_e1 = pprParendExpr sty e1
 221     pp_e2 = pprParendExpr sty e2
 222
 223     pp_prefixly
 224       = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
 225
 226     pp_infixly v
 227       = ppSep [pp_e1, ppCat [pprOp sty v, pp_e2]]
 228
 229 pprExpr sty (NegApp e)
 230   = ppBeside (ppChar '-') (ppParens (pprExpr sty e))
 231
 232 pprExpr sty (HsPar e)
 233   = ppParens (pprExpr sty e)
 234
 235
 236 pprExpr sty (SectionL expr op)
 237   = case op of
 238       HsVar v -> pp_infixly v
 239       _       -> pp_prefixly
 240   where
 241     pp_expr = pprParendExpr sty expr
 242
 243     pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
 244                        4 (ppCat [pp_expr, ppStr "_x )"])
 245     pp_infixly v
 246       = ppSep [ ppBeside ppLparen pp_expr,
 247                 ppBeside (pprOp sty v) ppRparen ]
 248
 249 pprExpr sty (SectionR op expr)
 250   = case op of
 251       HsVar v -> pp_infixly v
 252       _       -> pp_prefixly
 253   where
 254     pp_expr = pprParendExpr sty expr
 255
 256     pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppPStr SLIT("_x")])
 257                        4 (ppBeside pp_expr ppRparen)
 258     pp_infixly v
 259       = ppSep [ ppBeside ppLparen (pprOp sty v),
 260                 ppBeside pp_expr  ppRparen ]
 261
 262 pprExpr sty (CCall fun args _ is_asm result_ty)
 263   = ppHang (if is_asm
 264             then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
 265             else ppBeside  (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
 266          4 (ppSep (map (pprParendExpr sty) args))
 267
 268 pprExpr sty (HsSCC label expr)
 269   = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
 270             pprParendExpr sty expr ]
 271
 272 pprExpr sty (HsCase expr matches _)
 273   = ppSep [ ppSep [ppPStr SLIT("case"), ppNest 4 (pprExpr sty expr), ppPStr SLIT("of")],
 274             ppNest 2 (pprMatches sty (True, ppNil) matches) ]
 275
 276 pprExpr sty (ListComp expr quals)
 277   = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
 278          4 (ppSep [interpp'SP sty quals, ppRbrack])
 279
 280 -- special case: let ... in let ...
 281 pprExpr sty (HsLet binds expr@(HsLet _ _))
 282   = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
 283            ppr sty expr]
 284
 285 pprExpr sty (HsLet binds expr)
 286   = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
 287            ppHang (ppPStr SLIT("in"))  2 (ppr sty expr)]
 288
 289 pprExpr sty (HsDo stmts _)
 290   = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
 291
 292 pprExpr sty (HsIf e1 e2 e3 _)
 293   = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
 294            ppNest 4 (pprExpr sty e2),
 295            ppPStr SLIT("else"),
 296            ppNest 4 (pprExpr sty e3)]
 297
 298 pprExpr sty (ExplicitList exprs)
 299   = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
 300 pprExpr sty (ExplicitListOut ty exprs)
 301   = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
 302                 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
 303
 304 pprExpr sty (ExplicitTuple exprs)
 305   = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
 306 pprExpr sty (ExprWithTySig expr sig)
 307   = ppHang (ppBesides [ppLparen, ppNest 2 (pprExpr sty expr), ppPStr SLIT(" ::")])
 308          4 (ppBeside  (ppr sty sig) ppRparen)
 309
 310 pprExpr sty (RecordCon con  rbinds)
 311   = pp_rbinds sty (ppr sty con) rbinds
 312
 313 pprExpr sty (RecordUpd aexp rbinds)
 314   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 315
 316 pprExpr sty (ArithSeqIn info)
 317   = ppBracket (ppr sty info)
 318 pprExpr sty (ArithSeqOut expr info)
 319   = case sty of
 320         PprForUser ->
 321           ppBracket (ppr sty info)
 322         _          ->
 323           ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
 324
 325 pprExpr sty (TyLam tyvars expr)
 326   = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
 327          4 (pprExpr sty expr)
 328
 329 pprExpr sty (TyApp expr [ty])
 330   = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
 331
 332 pprExpr sty (TyApp expr tys)
 333   = ppHang (pprExpr sty expr)
 334          4 (ppBracket (interpp'SP sty tys))
 335
 336 pprExpr sty (DictLam dictvars expr)
 337   = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
 338          4 (pprExpr sty expr)
 339
 340 pprExpr sty (DictApp expr [dname])
 341   = ppHang (pprExpr sty expr) 4 (ppr sty dname)
 342
 343 pprExpr sty (DictApp expr dnames)
 344   = ppHang (pprExpr sty expr)
 345          4 (ppBracket (interpp'SP sty dnames))
 346
 347 pprExpr sty (ClassDictLam dicts methods expr)
 348   = ppHang (ppCat [ppStr "\\{-classdict-}",
 349                    ppBracket (interppSP sty dicts),
 350                    ppBracket (interppSP sty methods),
 351                    ppStr "->"])
 352          4 (pprExpr sty expr)
 353
 354 pprExpr sty (Dictionary dicts methods)
 355  = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
 356           ppBracket (interpp'SP sty dicts),
 357           ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
 358
 359 pprExpr sty (SingleDict dname)
 360  = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
 361 \end{code}
 362
 363 Parenthesize unless very simple:
 364 \begin{code}
 365 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
 366                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 367               => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
 368
 369 pprParendExpr sty expr
 370   = let
 371         pp_as_was = pprExpr sty expr
 372     in
 373     case expr of
 374       HsLit l               -> ppr sty l
 375       HsLitOut l _          -> ppr sty l
 376       HsVar _               -> pp_as_was
 377       ExplicitList _        -> pp_as_was
 378       ExplicitListOut _ _   -> pp_as_was
 379       ExplicitTuple _       -> pp_as_was
 380       _                     -> ppParens pp_as_was
 381 \end{code}
 382
 383 %************************************************************************
 384 %*                                                                      *
 385 \subsection{Record binds}
 386 %*                                                                      *
 387 %************************************************************************
 388
 389 \begin{code}
 390 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
 391                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 392               => PprStyle -> Pretty
 393               -> HsRecordBinds tyvar uvar id pat -> Pretty
 394
 395 pp_rbinds sty thing rbinds
 396   = ppHang thing 4
 397         (ppBesides [ppChar '{', ppInterleave ppComma (map (pp_rbind sty) rbinds), ppChar '}'])
 398   where
 399     pp_rbind sty (v, _, True{-pun-}) = ppr sty v
 400     pp_rbind sty (v, e, _) = ppCat [ppr sty v, ppStr "<-", ppr sty e]
 401 \end{code}
 402
 403 %************************************************************************
 404 %*                                                                      *
 405 \subsection{Do stmts}
 406 %*                                                                      *
 407 %************************************************************************
 408
 409 \begin{code}
 410 data Stmt tyvar uvar id pat
 411   = BindStmt    pat
 412                 (HsExpr  tyvar uvar id pat)
 413                 SrcLoc
 414   | ExprStmt    (HsExpr  tyvar uvar id pat)
 415                 SrcLoc
 416   | LetStmt     (HsBinds tyvar uvar id pat)
 417 \end{code}
 418
 419 \begin{code}
 420 instance (NamedThing id, Outputable id, Outputable pat,
 421           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 422                 Outputable (Stmt tyvar uvar id pat) where
 423     ppr sty (BindStmt pat expr _)
 424      = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
 425     ppr sty (LetStmt binds)
 426      = ppCat [ppPStr SLIT("let"), ppr sty binds]
 427     ppr sty (ExprStmt expr _)
 428      = ppr sty expr
 429 \end{code}
 430
 431 %************************************************************************
 432 %*                                                                      *
 433 \subsection{Enumerations and list comprehensions}
 434 %*                                                                      *
 435 %************************************************************************
 436
 437 \begin{code}
 438 data ArithSeqInfo  tyvar uvar id pat
 439   = From            (HsExpr tyvar uvar id pat)
 440   | FromThen        (HsExpr tyvar uvar id pat)
 441                     (HsExpr tyvar uvar id pat)
 442   | FromTo          (HsExpr tyvar uvar id pat)
 443                     (HsExpr tyvar uvar id pat)
 444   | FromThenTo      (HsExpr tyvar uvar id pat)
 445                     (HsExpr tyvar uvar id pat)
 446                     (HsExpr tyvar uvar id pat)
 447 \end{code}
 448
 449 \begin{code}
 450 instance (NamedThing id, Outputable id, Outputable pat,
 451           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 452                 Outputable (ArithSeqInfo tyvar uvar id pat) where
 453     ppr sty (From e1)           = ppBesides [ppr sty e1, pp_dotdot]
 454     ppr sty (FromThen e1 e2)    = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
 455     ppr sty (FromTo e1 e3)      = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
 456     ppr sty (FromThenTo e1 e2 e3)
 457       = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
 458
 459 pp_dotdot = ppPStr SLIT(" .. ")
 460 \end{code}
 461
 462 ``Qualifiers'' in list comprehensions:
 463 \begin{code}
 464 data Qual tyvar uvar id pat
 465   = GeneratorQual   pat
 466                     (HsExpr  tyvar uvar id pat)
 467   | LetQual         (HsBinds tyvar uvar id pat)
 468   | FilterQual      (HsExpr  tyvar uvar id pat)
 469 \end{code}
 470
 471 \begin{code}
 472 instance (NamedThing id, Outputable id, Outputable pat,
 473           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 474                 Outputable (Qual tyvar uvar id pat) where
 475     ppr sty (GeneratorQual pat expr)
 476      = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
 477     ppr sty (LetQual binds)
 478      = ppCat [ppPStr SLIT("let"), ppr sty binds]
 479     ppr sty (FilterQual expr)
 480      = ppr sty expr
 481 \end{code}