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        [Stmt tyvar uvar id pat]        -- "do":one or more stmts
  86                 SrcLoc
  87
  88   | HsDoOut     [Stmt   tyvar uvar id pat]      -- "do":one or more stmts
  89                 id                              -- id for >>=,  types applied
  90                 id                              -- id for zero, typed applied
  91                 SrcLoc
  92
  93   | ListComp    (HsExpr    tyvar uvar id pat)   -- list comprehension
  94                 [Qualifier tyvar uvar id pat]   -- at least one Qualifier
  95
  96   | ExplicitList                -- syntactic list
  97                 [HsExpr tyvar uvar id pat]
  98   | ExplicitListOut             -- TRANSLATION
  99                 (GenType tyvar uvar)    -- Gives type of components of list
 100                 [HsExpr tyvar uvar id pat]
 101
 102   | ExplicitTuple               -- tuple
 103                 [HsExpr tyvar uvar id pat]
 104                                 -- NB: Unit is ExplicitTuple []
 105                                 -- for tuples, we can get the types
 106                                 -- direct from the components
 107
 108         -- Record construction
 109   | RecordCon   (HsExpr tyvar uvar id pat)      -- Always (HsVar id) until type checker,
 110                                                 -- but the latter adds its type args too
 111                 (HsRecordBinds tyvar uvar id pat)
 112
 113         -- Record update
 114   | RecordUpd   (HsExpr tyvar uvar id pat)
 115                 (HsRecordBinds tyvar uvar id pat)
 116
 117   | RecordUpdOut (HsExpr tyvar uvar id pat)     -- TRANSLATION
 118                  [id]                           -- Dicts needed for construction
 119                  (HsRecordBinds tyvar uvar id pat)
 120
 121   | ExprWithTySig               -- signature binding
 122                 (HsExpr tyvar uvar id pat)
 123                 (HsType id)
 124   | ArithSeqIn                  -- arithmetic sequence
 125                 (ArithSeqInfo tyvar uvar id pat)
 126   | ArithSeqOut
 127                 (HsExpr       tyvar uvar id pat) -- (typechecked, of course)
 128                 (ArithSeqInfo tyvar uvar id pat)
 129
 130   | CCall       FAST_STRING     -- call into the C world; string is
 131                 [HsExpr tyvar uvar id pat]      -- the C function; exprs are the
 132                                 -- arguments to pass.
 133                 Bool            -- True <=> might cause Haskell
 134                                 -- garbage-collection (must generate
 135                                 -- more paranoid code)
 136                 Bool            -- True <=> it's really a "casm"
 137                                 -- NOTE: this CCall is the *boxed*
 138                                 -- version; the desugarer will convert
 139                                 -- it into the unboxed "ccall#".
 140                 (GenType tyvar uvar)    -- The result type; will be *bottom*
 141                                 -- until the typechecker gets ahold of it
 142
 143   | HsSCC       FAST_STRING     -- "set cost centre" (_scc_) annotation
 144                 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
 145 \end{code}
 146
 147 Everything from here on appears only in typechecker output.
 148
 149 \begin{code}
 150   | TyLam                       -- TRANSLATION
 151                 [tyvar]
 152                 (HsExpr tyvar uvar id pat)
 153   | TyApp                       -- TRANSLATION
 154                 (HsExpr  tyvar uvar id pat) -- generated by Spec
 155                 [GenType tyvar uvar]
 156
 157   -- DictLam and DictApp are "inverses"
 158   |  DictLam
 159                 [id]
 160                 (HsExpr tyvar uvar id pat)
 161   |  DictApp
 162                 (HsExpr tyvar uvar id pat)
 163                 [id]
 164
 165   -- ClassDictLam and Dictionary are "inverses" (see note below)
 166   |  ClassDictLam
 167                 [id]            -- superclass dicts
 168                 [id]            -- methods
 169                 (HsExpr tyvar uvar id pat)
 170   |  Dictionary
 171                 [id]            -- superclass dicts
 172                 [id]            -- methods
 173
 174   |  SingleDict                 -- a simple special case of Dictionary
 175                 id              -- local dictionary name
 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) = ppr sty v
 198
 199 pprExpr sty (HsLit    lit)   = ppr sty lit
 200 pprExpr sty (HsLitOut lit _) = ppr sty lit
 201
 202 pprExpr sty (HsLam match)
 203   = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
 204
 205 pprExpr sty expr@(HsApp e1 e2)
 206   = let (fun, args) = collect_args expr [] in
 207     ppHang (pprExpr sty fun) 4 (ppSep (map (pprExpr sty) args))
 208   where
 209     collect_args (HsApp fun arg) args = collect_args fun (arg:args)
 210     collect_args fun             args = (fun, args)
 211
 212 pprExpr sty (OpApp e1 op fixity e2)
 213   = case op of
 214       HsVar v -> pp_infixly v
 215       _       -> pp_prefixly
 216   where
 217     pp_e1 = pprParendExpr sty e1                -- Add parens to make precedence clear
 218     pp_e2 = pprParendExpr sty e2
 219
 220     pp_prefixly
 221       = ppHang (pprExpr sty op) 4 (ppSep [pp_e1, pp_e2])
 222
 223     pp_infixly v
 224       = ppSep [pp_e1, ppCat [ppr sty v, pp_e2]]
 225
 226 pprExpr sty (NegApp e _)
 227   = ppBeside (ppChar '-') (pprParendExpr sty e)
 228
 229 pprExpr sty (HsPar e)
 230   = ppParens (pprExpr sty e)
 231
 232 pprExpr sty (SectionL expr op)
 233   = case op of
 234       HsVar v -> pp_infixly v
 235       _       -> pp_prefixly
 236   where
 237     pp_expr = pprParendExpr sty expr
 238
 239     pp_prefixly = ppHang (ppCat [ppStr "( \\ x_ ->", ppr sty op])
 240                        4 (ppCat [pp_expr, ppStr "x_ )"])
 241     pp_infixly v
 242       = ppSep [ ppBeside ppLparen pp_expr,
 243                 ppBeside (ppr sty v) ppRparen ]
 244
 245 pprExpr sty (SectionR op expr)
 246   = case op of
 247       HsVar v -> pp_infixly v
 248       _       -> pp_prefixly
 249   where
 250     pp_expr = pprParendExpr sty expr
 251
 252     pp_prefixly = ppHang (ppCat [ppStr "( \\ x_ ->", ppr sty op, ppPStr SLIT("x_")])
 253                        4 (ppBeside pp_expr ppRparen)
 254     pp_infixly v
 255       = ppSep [ ppBeside ppLparen (ppr sty v),
 256                 ppBeside pp_expr  ppRparen ]
 257
 258 pprExpr sty (HsCase expr matches _)
 259   = ppSep [ ppSep [ppPStr SLIT("case"), ppNest 4 (pprExpr sty expr), ppPStr SLIT("of")],
 260             ppNest 2 (pprMatches sty (True, ppNil) matches) ]
 261
 262 pprExpr sty (HsIf e1 e2 e3 _)
 263   = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
 264            ppNest 4 (pprExpr sty e2),
 265            ppPStr SLIT("else"),
 266            ppNest 4 (pprExpr sty e3)]
 267
 268 -- special case: let ... in let ...
 269 pprExpr sty (HsLet binds expr@(HsLet _ _))
 270   = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
 271            ppr sty expr]
 272
 273 pprExpr sty (HsLet binds expr)
 274   = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
 275            ppHang (ppPStr SLIT("in"))  2 (ppr sty expr)]
 276
 277 pprExpr sty (HsDo stmts _)
 278   = ppHang (ppPStr SLIT("do")) 2 (ppAboves (map (ppr sty) stmts))
 279 pprExpr sty (HsDoOut stmts _ _ _)
 280   = ppHang (ppPStr SLIT("do")) 2 (ppAboves (map (ppr sty) stmts))
 281
 282 pprExpr sty (ListComp expr quals)
 283   = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
 284          4 (ppSep [interpp'SP sty quals, ppRbrack])
 285
 286 pprExpr sty (ExplicitList exprs)
 287   = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
 288 pprExpr sty (ExplicitListOut ty exprs)
 289   = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
 290                 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
 291
 292 pprExpr sty (ExplicitTuple exprs)
 293   = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
 294
 295 pprExpr sty (RecordCon con  rbinds)
 296   = pp_rbinds sty (ppr sty con) rbinds
 297
 298 pprExpr sty (RecordUpd aexp rbinds)
 299   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 300 pprExpr sty (RecordUpdOut aexp _ rbinds)
 301   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 302
 303 pprExpr sty (ExprWithTySig expr sig)
 304   = ppHang (ppBeside (ppNest 2 (pprExpr sty expr)) (ppPStr SLIT(" ::")))
 305          4 (ppr sty sig)
 306
 307 pprExpr sty (ArithSeqIn info)
 308   = ppBracket (ppr sty info)
 309 pprExpr sty (ArithSeqOut expr info)
 310   = case sty of
 311         PprForUser ->
 312           ppBracket (ppr sty info)
 313         _          ->
 314           ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
 315
 316 pprExpr sty (CCall fun args _ is_asm result_ty)
 317   = ppHang (if is_asm
 318             then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
 319             else ppBeside  (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
 320          4 (ppSep (map (pprParendExpr sty) args))
 321
 322 pprExpr sty (HsSCC label expr)
 323   = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
 324             pprParendExpr sty expr ]
 325
 326 pprExpr sty (TyLam tyvars expr)
 327   = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
 328          4 (pprExpr sty expr)
 329
 330 pprExpr sty (TyApp expr [ty])
 331   = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
 332
 333 pprExpr sty (TyApp expr tys)
 334   = ppHang (pprExpr sty expr)
 335          4 (ppBracket (interpp'SP sty tys))
 336
 337 pprExpr sty (DictLam dictvars expr)
 338   = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
 339          4 (pprExpr sty expr)
 340
 341 pprExpr sty (DictApp expr [dname])
 342   = ppHang (pprExpr sty expr) 4 (ppr sty dname)
 343
 344 pprExpr sty (DictApp expr dnames)
 345   = ppHang (pprExpr sty expr)
 346          4 (ppBracket (interpp'SP sty dnames))
 347
 348 pprExpr sty (ClassDictLam dicts methods expr)
 349   = ppHang (ppCat [ppStr "\\{-classdict-}",
 350                    ppBracket (interppSP sty dicts),
 351                    ppBracket (interppSP sty methods),
 352                    ppStr "->"])
 353          4 (pprExpr sty expr)
 354
 355 pprExpr sty (Dictionary dicts methods)
 356   = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
 357            ppBracket (interpp'SP sty dicts),
 358            ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
 359
 360 pprExpr sty (SingleDict dname)
 361   = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
 362
 363 \end{code}
 364
 365 Parenthesize unless very simple:
 366 \begin{code}
 367 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
 368                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 369               => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
 370
 371 pprParendExpr sty expr
 372   = let
 373         pp_as_was = pprExpr sty expr
 374     in
 375     case expr of
 376       HsLit l               -> ppr sty l
 377       HsLitOut l _          -> ppr sty l
 378
 379       HsVar _               -> pp_as_was
 380       ExplicitList _        -> pp_as_was
 381       ExplicitListOut _ _   -> pp_as_was
 382       ExplicitTuple _       -> pp_as_was
 383       HsPar _               -> pp_as_was
 384
 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
 402          4 (ppCurlies (ppIntersperse pp'SP (map (pp_rbind sty) rbinds)))
 403   where
 404     pp_rbind PprForUser (v, _, True) = ppr PprForUser 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
 423         -- Translations; the types are the "a" and "b" types of the monad.
 424   | BindStmtOut pat (HsExpr tyvar uvar id pat) SrcLoc (GenType tyvar uvar) (GenType tyvar uvar)
 425   | ExprStmtOut (HsExpr tyvar uvar id pat)     SrcLoc (GenType tyvar uvar) (GenType tyvar uvar)
 426 \end{code}
 427
 428 \begin{code}
 429 instance (NamedThing id, Outputable id, Outputable pat,
 430           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 431                 Outputable (Stmt tyvar uvar id pat) where
 432     ppr sty (BindStmt pat expr _)
 433      = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
 434     ppr sty (LetStmt binds)
 435      = ppCat [ppPStr SLIT("let"), ppr sty binds]
 436     ppr sty (ExprStmt expr _)
 437      = ppr sty expr
 438     ppr sty (BindStmtOut pat expr _ _ _)
 439      = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
 440     ppr sty (ExprStmtOut expr _ _ _)
 441      = ppr sty expr
 442 \end{code}
 443
 444 %************************************************************************
 445 %*                                                                      *
 446 \subsection{Enumerations and list comprehensions}
 447 %*                                                                      *
 448 %************************************************************************
 449
 450 \begin{code}
 451 data ArithSeqInfo  tyvar uvar id pat
 452   = From            (HsExpr tyvar uvar id pat)
 453   | FromThen        (HsExpr tyvar uvar id pat)
 454                     (HsExpr tyvar uvar id pat)
 455   | FromTo          (HsExpr tyvar uvar id pat)
 456                     (HsExpr tyvar uvar id pat)
 457   | FromThenTo      (HsExpr tyvar uvar id pat)
 458                     (HsExpr tyvar uvar id pat)
 459                     (HsExpr tyvar uvar id pat)
 460 \end{code}
 461
 462 \begin{code}
 463 instance (NamedThing id, Outputable id, Outputable pat,
 464           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 465                 Outputable (ArithSeqInfo tyvar uvar id pat) where
 466     ppr sty (From e1)           = ppBesides [ppr sty e1, pp_dotdot]
 467     ppr sty (FromThen e1 e2)    = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
 468     ppr sty (FromTo e1 e3)      = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
 469     ppr sty (FromThenTo e1 e2 e3)
 470       = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
 471
 472 pp_dotdot = ppPStr SLIT(" .. ")
 473 \end{code}
 474
 475 ``Qualifiers'' in list comprehensions:
 476 \begin{code}
 477 data Qualifier tyvar uvar id pat
 478   = GeneratorQual   pat
 479                     (HsExpr  tyvar uvar id pat)
 480   | LetQual         (HsBinds tyvar uvar id pat)
 481   | FilterQual      (HsExpr  tyvar uvar id pat)
 482 \end{code}
 483
 484 \begin{code}
 485 instance (NamedThing id, Outputable id, Outputable pat,
 486           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 487                 Outputable (Qualifier tyvar uvar id pat) where
 488     ppr sty (GeneratorQual pat expr)
 489      = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
 490     ppr sty (LetQual binds)
 491      = ppCat [ppPStr SLIT("let"), ppr sty binds]
 492     ppr sty (FilterQual expr)
 493      = ppr sty expr
 494 \end{code}