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