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