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