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             ( isSymLexeme, pprSym )
  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   | 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   | RecordUpdOut (HsExpr tyvar uvar id pat)     -- TRANSLATION
 113                  [id]                           -- Dicts needed for construction
 114                  (HsRecordBinds tyvar uvar id pat)
 115
 116   | ExprWithTySig               -- signature binding
 117                 (HsExpr tyvar uvar id pat)
 118                 (PolyType id)
 119   | ArithSeqIn                  -- arithmetic sequence
 120                 (ArithSeqInfo tyvar uvar id pat)
 121   | ArithSeqOut
 122                 (HsExpr       tyvar uvar id pat) -- (typechecked, of course)
 123                 (ArithSeqInfo tyvar uvar id pat)
 124
 125   | CCall       FAST_STRING     -- call into the C world; string is
 126                 [HsExpr tyvar uvar id pat]      -- the C function; exprs are the
 127                                 -- arguments to pass.
 128                 Bool            -- True <=> might cause Haskell
 129                                 -- garbage-collection (must generate
 130                                 -- more paranoid code)
 131                 Bool            -- True <=> it's really a "casm"
 132                                 -- NOTE: this CCall is the *boxed*
 133                                 -- version; the desugarer will convert
 134                                 -- it into the unboxed "ccall#".
 135                 (GenType tyvar uvar)    -- The result type; will be *bottom*
 136                                 -- until the typechecker gets ahold of it
 137
 138   | HsSCC       FAST_STRING     -- "set cost centre" (_scc_) annotation
 139                 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
 140 \end{code}
 141
 142 Everything from here on appears only in typechecker output.
 143
 144 \begin{code}
 145   | TyLam                       -- TRANSLATION
 146                 [tyvar]
 147                 (HsExpr tyvar uvar id pat)
 148   | TyApp                       -- TRANSLATION
 149                 (HsExpr  tyvar uvar id pat) -- generated by Spec
 150                 [GenType tyvar uvar]
 151
 152   -- DictLam and DictApp are "inverses"
 153   |  DictLam
 154                 [id]
 155                 (HsExpr tyvar uvar id pat)
 156   |  DictApp
 157                 (HsExpr tyvar uvar id pat)
 158                 [id]
 159
 160   -- ClassDictLam and Dictionary are "inverses" (see note below)
 161   |  ClassDictLam
 162                 [id]            -- superclass dicts
 163                 [id]            -- methods
 164                 (HsExpr tyvar uvar id pat)
 165   |  Dictionary
 166                 [id]            -- superclass dicts
 167                 [id]            -- methods
 168
 169   |  SingleDict                 -- a simple special case of Dictionary
 170                 id              -- local dictionary name
 171
 172   |  HsCon                      -- TRANSLATION; a constructor application
 173         Id                      -- used only in the RHS of constructor definitions
 174         [GenType tyvar uvar]
 175         [HsExpr tyvar uvar id pat]
 176
 177 type HsRecordBinds tyvar uvar id pat
 178   = [(id, HsExpr tyvar uvar id pat, Bool)]
 179         -- True <=> source code used "punning",
 180         -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
 181 \end{code}
 182
 183 A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
 184 @ClassDictLam dictvars methods expr@ is, therefore:
 185 \begin{verbatim}
 186 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
 187 \end{verbatim}
 188
 189 \begin{code}
 190 instance (NamedThing id, Outputable id, Outputable pat,
 191           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 192                 Outputable (HsExpr tyvar uvar id pat) where
 193     ppr = pprExpr
 194 \end{code}
 195
 196 \begin{code}
 197 pprExpr sty (HsVar v)
 198   = (if (isSymLexeme v) then ppParens else id) (ppr sty v)
 199
 200 pprExpr sty (HsLit    lit)   = ppr sty lit
 201 pprExpr sty (HsLitOut lit _) = ppr sty lit
 202
 203 pprExpr sty (HsLam match)
 204   = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
 205
 206 pprExpr sty expr@(HsApp e1 e2)
 207   = let (fun, args) = collect_args expr [] in
 208     ppHang (pprParendExpr sty fun) 4 (ppSep (map (pprParendExpr sty) args))
 209   where
 210     collect_args (HsApp fun arg) args = collect_args fun (arg:args)
 211     collect_args fun             args = (fun, args)
 212
 213 pprExpr sty (OpApp e1 op e2)
 214   = case op of
 215       HsVar v -> pp_infixly v
 216       _       -> pp_prefixly
 217   where
 218     pp_e1 = pprParendExpr sty e1
 219     pp_e2 = pprParendExpr sty e2
 220
 221     pp_prefixly
 222       = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
 223
 224     pp_infixly v
 225       = ppSep [pp_e1, ppCat [pprSym sty v, pp_e2]]
 226
 227 pprExpr sty (NegApp e)
 228   = ppBeside (ppChar '-') (pprParendExpr sty e)
 229
 230 pprExpr sty (HsPar e)
 231   = ppParens (pprExpr sty e)
 232
 233 pprExpr sty (SectionL expr op)
 234   = case op of
 235       HsVar v -> pp_infixly v
 236       _       -> pp_prefixly
 237   where
 238     pp_expr = pprParendExpr sty expr
 239
 240     pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
 241                        4 (ppCat [pp_expr, ppStr "_x )"])
 242     pp_infixly v
 243       = ppSep [ ppBeside ppLparen pp_expr,
 244                 ppBeside (pprSym sty v) ppRparen ]
 245
 246 pprExpr sty (SectionR op expr)
 247   = case op of
 248       HsVar v -> pp_infixly v
 249       _       -> pp_prefixly
 250   where
 251     pp_expr = pprParendExpr sty expr
 252
 253     pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppPStr SLIT("_x")])
 254                        4 (ppBeside pp_expr ppRparen)
 255     pp_infixly v
 256       = ppSep [ ppBeside ppLparen (pprSym sty v),
 257                 ppBeside pp_expr  ppRparen ]
 258
 259 pprExpr sty (HsCase expr matches _)
 260   = ppSep [ ppSep [ppPStr SLIT("case"), ppNest 4 (pprExpr sty expr), ppPStr SLIT("of")],
 261             ppNest 2 (pprMatches sty (True, ppNil) matches) ]
 262
 263 pprExpr sty (HsIf e1 e2 e3 _)
 264   = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
 265            ppNest 4 (pprExpr sty e2),
 266            ppPStr SLIT("else"),
 267            ppNest 4 (pprExpr sty e3)]
 268
 269 -- special case: let ... in let ...
 270 pprExpr sty (HsLet binds expr@(HsLet _ _))
 271   = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
 272            ppr sty expr]
 273
 274 pprExpr sty (HsLet binds expr)
 275   = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
 276            ppHang (ppPStr SLIT("in"))  2 (ppr sty expr)]
 277
 278 pprExpr sty (HsDo stmts _)
 279   = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
 280 pprExpr sty (HsDoOut stmts _ _ _)
 281   = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
 282
 283 pprExpr sty (ListComp expr quals)
 284   = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
 285          4 (ppSep [interpp'SP sty quals, ppRbrack])
 286
 287 pprExpr sty (ExplicitList exprs)
 288   = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
 289 pprExpr sty (ExplicitListOut ty exprs)
 290   = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
 291                 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
 292
 293 pprExpr sty (ExplicitTuple exprs)
 294   = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
 295
 296 pprExpr sty (RecordCon con  rbinds)
 297   = pp_rbinds sty (ppr sty con) rbinds
 298
 299 pprExpr sty (RecordUpd aexp rbinds)
 300   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 301 pprExpr sty (RecordUpdOut aexp _ rbinds)
 302   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 303
 304 pprExpr sty (ExprWithTySig expr sig)
 305   = ppHang (ppBesides [ppLparen, ppNest 2 (pprExpr sty expr), ppPStr SLIT(" ::")])
 306          4 (ppBeside  (ppr sty sig) ppRparen)
 307
 308 pprExpr sty (ArithSeqIn info)
 309   = ppBracket (ppr sty info)
 310 pprExpr sty (ArithSeqOut expr info)
 311   = case sty of
 312         PprForUser ->
 313           ppBracket (ppr sty info)
 314         _          ->
 315           ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
 316
 317 pprExpr sty (CCall fun args _ is_asm result_ty)
 318   = ppHang (if is_asm
 319             then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
 320             else ppBeside  (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
 321          4 (ppSep (map (pprParendExpr sty) args))
 322
 323 pprExpr sty (HsSCC label expr)
 324   = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
 325             pprParendExpr sty expr ]
 326
 327 pprExpr sty (TyLam tyvars expr)
 328   = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
 329          4 (pprExpr sty expr)
 330
 331 pprExpr sty (TyApp expr [ty])
 332   = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
 333
 334 pprExpr sty (TyApp expr tys)
 335   = ppHang (pprExpr sty expr)
 336          4 (ppBracket (interpp'SP sty tys))
 337
 338 pprExpr sty (DictLam dictvars expr)
 339   = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
 340          4 (pprExpr sty expr)
 341
 342 pprExpr sty (DictApp expr [dname])
 343   = ppHang (pprExpr sty expr) 4 (ppr sty dname)
 344
 345 pprExpr sty (DictApp expr dnames)
 346   = ppHang (pprExpr sty expr)
 347          4 (ppBracket (interpp'SP sty dnames))
 348
 349 pprExpr sty (ClassDictLam dicts methods expr)
 350   = ppHang (ppCat [ppStr "\\{-classdict-}",
 351                    ppBracket (interppSP sty dicts),
 352                    ppBracket (interppSP sty methods),
 353                    ppStr "->"])
 354          4 (pprExpr sty expr)
 355
 356 pprExpr sty (Dictionary dicts methods)
 357   = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
 358            ppBracket (interpp'SP sty dicts),
 359            ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
 360
 361 pprExpr sty (SingleDict dname)
 362   = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
 363
 364 pprExpr sty (HsCon con tys exprs)
 365   = ppCat [ppPStr SLIT("{-HsCon-}"), ppr sty con, interppSP sty tys, interppSP sty exprs]
 366 \end{code}
 367
 368 Parenthesize unless very simple:
 369 \begin{code}
 370 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
 371                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 372               => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
 373
 374 pprParendExpr sty expr
 375   = let
 376         pp_as_was = pprExpr sty expr
 377     in
 378     case expr of
 379       HsLit l               -> ppr sty l
 380       HsLitOut l _          -> ppr sty l
 381       HsVar _               -> pp_as_was
 382       ExplicitList _        -> pp_as_was
 383       ExplicitListOut _ _   -> pp_as_was
 384       ExplicitTuple _       -> pp_as_was
 385       _                     -> ppParens pp_as_was
 386 \end{code}
 387
 388 %************************************************************************
 389 %*                                                                      *
 390 \subsection{Record binds}
 391 %*                                                                      *
 392 %************************************************************************
 393
 394 \begin{code}
 395 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
 396                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 397               => PprStyle -> Pretty
 398               -> HsRecordBinds tyvar uvar id pat -> Pretty
 399
 400 pp_rbinds sty thing rbinds
 401   = ppHang thing 4
 402         (ppBesides [ppChar '{', ppInterleave ppComma (map (pp_rbind sty) rbinds), ppChar '}'])
 403   where
 404     pp_rbind sty (v, _, True{-pun-}) = ppr sty v
 405     pp_rbind sty (v, e, _) = ppCat [ppr sty v, ppStr "<-", ppr sty e]
 406 \end{code}
 407
 408 %************************************************************************
 409 %*                                                                      *
 410 \subsection{Do stmts}
 411 %*                                                                      *
 412 %************************************************************************
 413
 414 \begin{code}
 415 data Stmt tyvar uvar id pat
 416   = BindStmt    pat
 417                 (HsExpr  tyvar uvar id pat)
 418                 SrcLoc
 419   | ExprStmt    (HsExpr  tyvar uvar id pat)
 420                 SrcLoc
 421   | LetStmt     (HsBinds tyvar uvar id pat)
 422 \end{code}
 423
 424 \begin{code}
 425 instance (NamedThing id, Outputable id, Outputable pat,
 426           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 427                 Outputable (Stmt tyvar uvar id pat) where
 428     ppr sty (BindStmt pat expr _)
 429      = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
 430     ppr sty (LetStmt binds)
 431      = ppCat [ppPStr SLIT("let"), ppr sty binds]
 432     ppr sty (ExprStmt expr _)
 433      = ppr sty expr
 434 \end{code}
 435
 436 %************************************************************************
 437 %*                                                                      *
 438 \subsection{Enumerations and list comprehensions}
 439 %*                                                                      *
 440 %************************************************************************
 441
 442 \begin{code}
 443 data ArithSeqInfo  tyvar uvar id pat
 444   = From            (HsExpr tyvar uvar id pat)
 445   | FromThen        (HsExpr tyvar uvar id pat)
 446                     (HsExpr tyvar uvar id pat)
 447   | FromTo          (HsExpr tyvar uvar id pat)
 448                     (HsExpr tyvar uvar id pat)
 449   | FromThenTo      (HsExpr tyvar uvar id pat)
 450                     (HsExpr tyvar uvar id pat)
 451                     (HsExpr tyvar uvar id pat)
 452 \end{code}
 453
 454 \begin{code}
 455 instance (NamedThing id, Outputable id, Outputable pat,
 456           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 457                 Outputable (ArithSeqInfo tyvar uvar id pat) where
 458     ppr sty (From e1)           = ppBesides [ppr sty e1, pp_dotdot]
 459     ppr sty (FromThen e1 e2)    = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
 460     ppr sty (FromTo e1 e3)      = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
 461     ppr sty (FromThenTo e1 e2 e3)
 462       = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
 463
 464 pp_dotdot = ppPStr SLIT(" .. ")
 465 \end{code}
 466
 467 ``Qualifiers'' in list comprehensions:
 468 \begin{code}
 469 data Qual tyvar uvar id pat
 470   = GeneratorQual   pat
 471                     (HsExpr  tyvar uvar id pat)
 472   | LetQual         (HsBinds tyvar uvar id pat)
 473   | FilterQual      (HsExpr  tyvar uvar id pat)
 474 \end{code}
 475
 476 \begin{code}
 477 instance (NamedThing id, Outputable id, Outputable pat,
 478           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 479                 Outputable (Qual tyvar uvar id pat) where
 480     ppr sty (GeneratorQual pat expr)
 481      = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
 482     ppr sty (LetQual binds)
 483      = ppCat [ppPStr SLIT("let"), ppr sty binds]
 484     ppr sty (FilterQual expr)
 485      = ppr sty expr
 486 \end{code}