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 IMP_Ubiq(){-uitous-}
  12 IMPORT_DELOOPER(HsLoop) -- for paranoia checking
  13
  14 -- friends:
  15 import HsBinds          ( HsBinds )
  16 import HsBasic          ( HsLit, Fixity(..), FixityDirection(..) )
  17 import HsMatches        ( pprMatches, pprMatch, Match )
  18 import HsTypes          ( HsType )
  19
  20 -- others:
  21 import Id               ( SYN_IE(DictVar), GenId, SYN_IE(Id) )
  22 import Name             ( pprNonSym, 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                 Fixity                          -- Renamer adds fixity; bottom until then
  58                 (HsExpr tyvar uvar id pat)      -- right operand
  59
  60   -- We preserve prefix negation and parenthesis for the precedence parser.
  61   -- They are eventually removed by the type checker.
  62
  63   | NegApp      (HsExpr tyvar uvar id pat)      -- negated expr
  64                 (HsExpr tyvar uvar id pat)      -- the negate id (in a HsVar)
  65
  66   | HsPar       (HsExpr tyvar uvar id pat)      -- parenthesised expr
  67
  68   | SectionL    (HsExpr tyvar uvar id pat)      -- operand
  69                 (HsExpr tyvar uvar id pat)      -- operator
  70   | SectionR    (HsExpr tyvar uvar id pat)      -- operator
  71                 (HsExpr tyvar uvar id pat)      -- operand
  72
  73   | HsCase      (HsExpr tyvar uvar id pat)
  74                 [Match  tyvar uvar id pat]      -- must have at least one Match
  75                 SrcLoc
  76
  77   | HsIf        (HsExpr tyvar uvar id pat)      --  predicate
  78                 (HsExpr tyvar uvar id pat)      --  then part
  79                 (HsExpr tyvar uvar id pat)      --  else part
  80                 SrcLoc
  81
  82   | HsLet       (HsBinds tyvar uvar id pat)     -- let(rec)
  83                 (HsExpr  tyvar uvar id pat)
  84
  85   | HsDo        DoOrListComp
  86                 [Stmt tyvar uvar id pat]        -- "do":one or more stmts
  87                 SrcLoc
  88
  89   | HsDoOut     DoOrListComp
  90                 [Stmt   tyvar uvar id pat]      -- "do":one or more stmts
  91                 id                              -- id for return
  92                 id                              -- id for >>=
  93                 id                              -- id for zero
  94                 (GenType tyvar uvar)            -- Type of the whole expression
  95                 SrcLoc
  96
  97   | ExplicitList                -- syntactic list
  98                 [HsExpr tyvar uvar id pat]
  99   | ExplicitListOut             -- TRANSLATION
 100                 (GenType tyvar uvar)    -- Gives type of components of list
 101                 [HsExpr tyvar uvar id pat]
 102
 103   | ExplicitTuple               -- tuple
 104                 [HsExpr tyvar uvar id pat]
 105                                 -- NB: Unit is ExplicitTuple []
 106                                 -- for tuples, we can get the types
 107                                 -- direct from the components
 108
 109         -- Record construction
 110   | RecordCon   (HsExpr tyvar uvar id pat)      -- Always (HsVar id) until type checker,
 111                                                 -- but the latter adds its type args too
 112                 (HsRecordBinds tyvar uvar id pat)
 113
 114         -- Record update
 115   | RecordUpd   (HsExpr tyvar uvar id pat)
 116                 (HsRecordBinds tyvar uvar id pat)
 117
 118   | RecordUpdOut (HsExpr tyvar uvar id pat)     -- TRANSLATION
 119                  [id]                           -- Dicts needed for construction
 120                  (HsRecordBinds tyvar uvar id pat)
 121
 122   | ExprWithTySig               -- signature binding
 123                 (HsExpr tyvar uvar id pat)
 124                 (HsType id)
 125   | ArithSeqIn                  -- arithmetic sequence
 126                 (ArithSeqInfo tyvar uvar id pat)
 127   | ArithSeqOut
 128                 (HsExpr       tyvar uvar id pat) -- (typechecked, of course)
 129                 (ArithSeqInfo tyvar uvar id pat)
 130
 131   | CCall       FAST_STRING     -- call into the C world; string is
 132                 [HsExpr tyvar uvar id pat]      -- the C function; exprs are the
 133                                 -- arguments to pass.
 134                 Bool            -- True <=> might cause Haskell
 135                                 -- garbage-collection (must generate
 136                                 -- more paranoid code)
 137                 Bool            -- True <=> it's really a "casm"
 138                                 -- NOTE: this CCall is the *boxed*
 139                                 -- version; the desugarer will convert
 140                                 -- it into the unboxed "ccall#".
 141                 (GenType tyvar uvar)    -- The result type; will be *bottom*
 142                                 -- until the typechecker gets ahold of it
 143
 144   | HsSCC       FAST_STRING     -- "set cost centre" (_scc_) annotation
 145                 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
 146 \end{code}
 147
 148 Everything from here on appears only in typechecker output.
 149
 150 \begin{code}
 151   | TyLam                       -- TRANSLATION
 152                 [tyvar]
 153                 (HsExpr tyvar uvar id pat)
 154   | TyApp                       -- TRANSLATION
 155                 (HsExpr  tyvar uvar id pat) -- generated by Spec
 156                 [GenType tyvar uvar]
 157
 158   -- DictLam and DictApp are "inverses"
 159   |  DictLam
 160                 [id]
 161                 (HsExpr tyvar uvar id pat)
 162   |  DictApp
 163                 (HsExpr tyvar uvar id pat)
 164                 [id]
 165
 166   -- ClassDictLam and Dictionary are "inverses" (see note below)
 167   |  ClassDictLam
 168                 [id]            -- superclass dicts
 169                 [id]            -- methods
 170                 (HsExpr tyvar uvar id pat)
 171   |  Dictionary
 172                 [id]            -- superclass dicts
 173                 [id]            -- methods
 174
 175   |  SingleDict                 -- a simple special case of Dictionary
 176                 id              -- local dictionary name
 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) = 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 [ppChar '\\', ppNest 2 (pprMatch sty True match)]
 205
 206 pprExpr sty expr@(HsApp e1 e2)
 207   = let (fun, args) = collect_args expr [] in
 208     ppHang (pprExpr sty fun) 4 (ppSep (map (pprExpr 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 fixity e2)
 214   = case op of
 215       HsVar v -> pp_infixly v
 216       _       -> pp_prefixly
 217   where
 218     pp_e1 = pprParendExpr sty e1                -- Add parens to make precedence clear
 219     pp_e2 = pprParendExpr sty e2
 220
 221     pp_prefixly
 222       = ppHang (pprExpr sty op) 4 (ppSep [pp_e1, pp_e2])
 223
 224     pp_infixly v
 225       = ppSep [pp_e1, ppCat [ppr 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, ppPStr SLIT("x_ )")])
 242     pp_infixly v
 243       = ppSep [ ppBeside ppLparen pp_expr,
 244                 ppBeside (ppr 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 (ppr 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 do_or_list_comp stmts _)            = pprDo do_or_list_comp sty stmts
 279 pprExpr sty (HsDoOut do_or_list_comp stmts _ _ _ _ _) = pprDo do_or_list_comp sty stmts
 280
 281 pprExpr sty (ExplicitList exprs)
 282   = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
 283 pprExpr sty (ExplicitListOut ty exprs)
 284   = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
 285                 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
 286
 287 pprExpr sty (ExplicitTuple exprs)
 288   = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
 289
 290 pprExpr sty (RecordCon con  rbinds)
 291   = pp_rbinds sty (ppr sty con) rbinds
 292
 293 pprExpr sty (RecordUpd aexp rbinds)
 294   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 295 pprExpr sty (RecordUpdOut aexp _ rbinds)
 296   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 297
 298 pprExpr sty (ExprWithTySig expr sig)
 299   = ppHang (ppBeside (ppNest 2 (pprExpr sty expr)) (ppPStr SLIT(" ::")))
 300          4 (ppr sty sig)
 301
 302 pprExpr sty (ArithSeqIn info)
 303   = ppBracket (ppr sty info)
 304 pprExpr sty (ArithSeqOut expr info)
 305   = case sty of
 306         PprForUser ->
 307           ppBracket (ppr sty info)
 308         _          ->
 309           ppBesides [ppLbrack, ppParens (ppr sty expr), ppSP, ppr sty info, ppRbrack]
 310
 311 pprExpr sty (CCall fun args _ is_asm result_ty)
 312   = ppHang (if is_asm
 313             then ppBesides [ppPStr SLIT("_casm_ ``"), ppPStr fun, ppPStr SLIT("''")]
 314             else ppBeside  (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
 315          4 (ppSep (map (pprParendExpr sty) args))
 316
 317 pprExpr sty (HsSCC label expr)
 318   = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
 319             pprParendExpr sty expr ]
 320
 321 pprExpr sty (TyLam tyvars expr)
 322   = ppHang (ppCat [ppPStr SLIT("/\\"), interppSP sty tyvars, ppPStr SLIT("->")])
 323          4 (pprExpr sty expr)
 324
 325 pprExpr sty (TyApp expr [ty])
 326   = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
 327
 328 pprExpr sty (TyApp expr tys)
 329   = ppHang (pprExpr sty expr)
 330          4 (ppBracket (interpp'SP sty tys))
 331
 332 pprExpr sty (DictLam dictvars expr)
 333   = ppHang (ppCat [ppPStr SLIT("\\{-dict-}"), interppSP sty dictvars, ppPStr SLIT("->")])
 334          4 (pprExpr sty expr)
 335
 336 pprExpr sty (DictApp expr [dname])
 337   = ppHang (pprExpr sty expr) 4 (ppr sty dname)
 338
 339 pprExpr sty (DictApp expr dnames)
 340   = ppHang (pprExpr sty expr)
 341          4 (ppBracket (interpp'SP sty dnames))
 342
 343 pprExpr sty (ClassDictLam dicts methods expr)
 344   = ppHang (ppCat [ppPStr SLIT("\\{-classdict-}"),
 345                    ppBracket (interppSP sty dicts),
 346                    ppBracket (interppSP sty methods),
 347                    ppPStr SLIT("->")])
 348          4 (pprExpr sty expr)
 349
 350 pprExpr sty (Dictionary dicts methods)
 351   = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
 352            ppBracket (interpp'SP sty dicts),
 353            ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
 354
 355 pprExpr sty (SingleDict dname)
 356   = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
 357
 358 \end{code}
 359
 360 Parenthesize unless very simple:
 361 \begin{code}
 362 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
 363                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 364               => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
 365
 366 pprParendExpr sty expr
 367   = let
 368         pp_as_was = pprExpr sty expr
 369     in
 370     case expr of
 371       HsLit l               -> ppr sty l
 372       HsLitOut l _          -> ppr sty l
 373
 374       HsVar _               -> pp_as_was
 375       ExplicitList _        -> pp_as_was
 376       ExplicitListOut _ _   -> pp_as_was
 377       ExplicitTuple _       -> pp_as_was
 378       HsPar _               -> pp_as_was
 379
 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
 397          4 (ppCurlies (ppIntersperse pp'SP (map (pp_rbind sty) rbinds)))
 398   where
 399     pp_rbind PprForUser (v, _, True) = ppr PprForUser v
 400     pp_rbind sty        (v, e, _)    = ppCat [ppr sty v, ppChar '=', ppr sty e]
 401 \end{code}
 402
 403 %************************************************************************
 404 %*                                                                      *
 405 \subsection{Do stmts and list comprehensions}
 406 %*                                                                      *
 407 %************************************************************************
 408
 409 \begin{code}
 410 data DoOrListComp = DoStmt | ListComp
 411
 412 pprDo DoStmt sty stmts
 413   = ppHang (ppPStr SLIT("do")) 2 (ppAboves (map (ppr sty) stmts))
 414 pprDo ListComp sty stmts
 415   = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
 416          4 (ppSep [interpp'SP sty quals, ppRbrack])
 417   where
 418     ReturnStmt expr = last stmts        -- Last stmt should be a ReturnStmt for list comps
 419     quals           = init stmts
 420 \end{code}
 421
 422 \begin{code}
 423 data Stmt tyvar uvar id pat
 424   = BindStmt    pat
 425                 (HsExpr  tyvar uvar id pat)
 426                 SrcLoc
 427
 428   | LetStmt     (HsBinds tyvar uvar id pat)
 429
 430   | GuardStmt   (HsExpr  tyvar uvar id pat)             -- List comps only
 431                 SrcLoc
 432
 433   | ExprStmt    (HsExpr  tyvar uvar id pat)             -- Do stmts only
 434                 SrcLoc
 435
 436   | ReturnStmt  (HsExpr  tyvar uvar id pat)             -- List comps only, at the end
 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 (Stmt tyvar uvar id pat) where
 443     ppr sty (BindStmt pat expr _)
 444      = ppCat [ppr sty pat, ppPStr SLIT("<-"), ppr sty expr]
 445     ppr sty (LetStmt binds)
 446      = ppCat [ppPStr SLIT("let"), ppr sty binds]
 447     ppr sty (ExprStmt expr _)
 448      = ppr sty expr
 449     ppr sty (GuardStmt expr _)
 450      = ppr sty expr
 451     ppr sty (ReturnStmt expr)
 452      = ppCat [ppPStr SLIT("return"), ppr sty expr]
 453 \end{code}
 454
 455 %************************************************************************
 456 %*                                                                      *
 457 \subsection{Enumerations and list comprehensions}
 458 %*                                                                      *
 459 %************************************************************************
 460
 461 \begin{code}
 462 data ArithSeqInfo  tyvar uvar id pat
 463   = From            (HsExpr tyvar uvar id pat)
 464   | FromThen        (HsExpr tyvar uvar id pat)
 465                     (HsExpr tyvar uvar id pat)
 466   | FromTo          (HsExpr tyvar uvar id pat)
 467                     (HsExpr tyvar uvar id pat)
 468   | FromThenTo      (HsExpr tyvar uvar id pat)
 469                     (HsExpr tyvar uvar id pat)
 470                     (HsExpr tyvar uvar id pat)
 471 \end{code}
 472
 473 \begin{code}
 474 instance (NamedThing id, Outputable id, Outputable pat,
 475           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 476                 Outputable (ArithSeqInfo tyvar uvar id pat) where
 477     ppr sty (From e1)           = ppBesides [ppr sty e1, pp_dotdot]
 478     ppr sty (FromThen e1 e2)    = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
 479     ppr sty (FromTo e1 e3)      = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
 480     ppr sty (FromThenTo e1 e2 e3)
 481       = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
 482
 483 pp_dotdot = ppPStr SLIT(" .. ")
 484 \end{code}