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 Outputable       --( interppSP, interpp'SP, ifnotPprForUser )
  23 import PprType          ( pprGenType, pprParendGenType, GenType{-instance-} )
  24 import Pretty
  25 import PprStyle         ( PprStyle(..), userStyle )
  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 sty (HsVar v) = ppr sty v
 203
 204 pprExpr sty (HsLit    lit)   = ppr sty lit
 205 pprExpr sty (HsLitOut lit _) = ppr sty lit
 206
 207 pprExpr sty (HsLam match)
 208   = hsep [char '\\', nest 2 (pprMatch sty True match)]
 209
 210 pprExpr sty expr@(HsApp e1 e2)
 211   = let (fun, args) = collect_args expr [] in
 212     hang (pprExpr sty fun) 4 (sep (map (pprExpr sty) args))
 213   where
 214     collect_args (HsApp fun arg) args = collect_args fun (arg:args)
 215     collect_args fun             args = (fun, args)
 216
 217 pprExpr sty (OpApp e1 op fixity e2)
 218   = case op of
 219       HsVar v -> pp_infixly v
 220       _       -> pp_prefixly
 221   where
 222     pp_e1 = pprParendExpr sty e1                -- Add parens to make precedence clear
 223     pp_e2 = pprParendExpr sty e2
 224
 225     pp_prefixly
 226       = hang (pprExpr sty op) 4 (sep [pp_e1, pp_e2])
 227
 228     pp_infixly v
 229       = sep [pp_e1, hsep [ppr sty v, pp_e2]]
 230
 231 pprExpr sty (NegApp e _)
 232   = (<>) (char '-') (pprParendExpr sty e)
 233
 234 pprExpr sty (HsPar e)
 235   = parens (pprExpr sty e)
 236
 237 pprExpr sty (SectionL expr op)
 238   = case op of
 239       HsVar v -> pp_infixly v
 240       _       -> pp_prefixly
 241   where
 242     pp_expr = pprParendExpr sty expr
 243
 244     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr sty op])
 245                        4 (hsep [pp_expr, ptext SLIT("x_ )")])
 246     pp_infixly v = parens (sep [pp_expr, ppr sty v])
 247
 248 pprExpr sty (SectionR op expr)
 249   = case op of
 250       HsVar v -> pp_infixly v
 251       _       -> pp_prefixly
 252   where
 253     pp_expr = pprParendExpr sty expr
 254
 255     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr sty op, ptext SLIT("x_")])
 256                        4 ((<>) pp_expr rparen)
 257     pp_infixly v
 258       = parens (sep [ppr sty v, pp_expr])
 259
 260 pprExpr sty (HsCase expr matches _)
 261   = sep [ sep [ptext SLIT("case"), nest 4 (pprExpr sty expr), ptext SLIT("of")],
 262             nest 2 (pprMatches sty (True, empty) matches) ]
 263
 264 pprExpr sty (HsIf e1 e2 e3 _)
 265   = sep [hsep [ptext SLIT("if"), nest 2 (pprExpr sty e1), ptext SLIT("then")],
 266            nest 4 (pprExpr sty e2),
 267            ptext SLIT("else"),
 268            nest 4 (pprExpr sty e3)]
 269
 270 -- special case: let ... in let ...
 271 pprExpr sty (HsLet binds expr@(HsLet _ _))
 272   = sep [hang (ptext SLIT("let")) 2 (hsep [ppr sty binds, ptext SLIT("in")]),
 273            ppr sty expr]
 274
 275 pprExpr sty (HsLet binds expr)
 276   = sep [hang (ptext SLIT("let")) 2 (ppr sty binds),
 277            hang (ptext SLIT("in"))  2 (ppr sty expr)]
 278
 279 pprExpr sty (HsDo do_or_list_comp stmts _)            = pprDo do_or_list_comp sty stmts
 280 pprExpr sty (HsDoOut do_or_list_comp stmts _ _ _ _ _) = pprDo do_or_list_comp sty stmts
 281
 282 pprExpr sty (ExplicitList exprs)
 283   = brackets (fsep (punctuate comma (map (pprExpr sty) exprs)))
 284 pprExpr sty (ExplicitListOut ty exprs)
 285   = hcat [ brackets (fsep (punctuate comma (map (pprExpr sty) exprs))),
 286            ifnotPprForUser sty ((<>) space (parens (pprGenType sty ty))) ]
 287
 288 pprExpr sty (ExplicitTuple exprs)
 289   = parens (sep (punctuate comma (map (pprExpr sty) exprs)))
 290
 291 pprExpr sty (RecordCon con  rbinds)
 292   = pp_rbinds sty (ppr sty con) rbinds
 293
 294 pprExpr sty (RecordUpd aexp rbinds)
 295   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 296 pprExpr sty (RecordUpdOut aexp _ _ rbinds)
 297   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 298
 299 pprExpr sty (ExprWithTySig expr sig)
 300   = hang ((<>) (nest 2 (pprExpr sty expr)) (ptext SLIT(" ::")))
 301          4 (ppr sty sig)
 302
 303 pprExpr sty (ArithSeqIn info)
 304   = brackets (ppr sty info)
 305 pprExpr sty (ArithSeqOut expr info)
 306   | userStyle sty = brackets (ppr sty info)
 307   | otherwise     = brackets (hcat [parens (ppr sty expr), space, ppr sty info])
 308
 309 pprExpr sty (CCall fun args _ is_asm result_ty)
 310   = hang (if is_asm
 311             then hcat [ptext SLIT("_casm_ ``"), ptext fun, ptext SLIT("''")]
 312             else (<>)  (ptext SLIT("_ccall_ ")) (ptext fun))
 313          4 (sep (map (pprParendExpr sty) args))
 314
 315 pprExpr sty (HsSCC label expr)
 316   = sep [ (<>) (ptext SLIT("_scc_ ")) (hcat [char '"', ptext label, char '"']),
 317             pprParendExpr sty expr ]
 318
 319 pprExpr sty (TyLam tyvars expr)
 320   = hang (hsep [ptext SLIT("/\\"), interppSP sty tyvars, ptext SLIT("->")])
 321          4 (pprExpr sty expr)
 322
 323 pprExpr sty (TyApp expr [ty])
 324   = hang (pprExpr sty expr) 4 (pprParendGenType sty ty)
 325
 326 pprExpr sty (TyApp expr tys)
 327   = hang (pprExpr sty expr)
 328          4 (brackets (interpp'SP sty tys))
 329
 330 pprExpr sty (DictLam dictvars expr)
 331   = hang (hsep [ptext SLIT("\\{-dict-}"), interppSP sty dictvars, ptext SLIT("->")])
 332          4 (pprExpr sty expr)
 333
 334 pprExpr sty (DictApp expr [dname])
 335   = hang (pprExpr sty expr) 4 (ppr sty dname)
 336
 337 pprExpr sty (DictApp expr dnames)
 338   = hang (pprExpr sty expr)
 339          4 (brackets (interpp'SP sty dnames))
 340
 341 pprExpr sty (ClassDictLam dicts methods expr)
 342   = hang (hsep [ptext SLIT("\\{-classdict-}"),
 343                    brackets (interppSP sty dicts),
 344                    brackets (interppSP sty methods),
 345                    ptext SLIT("->")])
 346          4 (pprExpr sty expr)
 347
 348 pprExpr sty (Dictionary dicts methods)
 349   = parens (sep [ptext SLIT("{-dict-}"),
 350                    brackets (interpp'SP sty dicts),
 351                    brackets (interpp'SP sty methods)])
 352
 353 pprExpr sty (SingleDict dname)
 354   = hsep [ptext SLIT("{-singleDict-}"), ppr sty dname]
 355
 356 \end{code}
 357
 358 Parenthesize unless very simple:
 359 \begin{code}
 360 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
 361                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 362               => PprStyle -> HsExpr tyvar uvar id pat -> Doc
 363
 364 pprParendExpr sty expr
 365   = let
 366         pp_as_was = pprExpr sty expr
 367     in
 368     case expr of
 369       HsLit l               -> ppr sty l
 370       HsLitOut l _          -> ppr sty l
 371
 372       HsVar _               -> pp_as_was
 373       ExplicitList _        -> pp_as_was
 374       ExplicitListOut _ _   -> pp_as_was
 375       ExplicitTuple _       -> pp_as_was
 376       HsPar _               -> pp_as_was
 377
 378       _                     -> parens pp_as_was
 379 \end{code}
 380
 381 %************************************************************************
 382 %*                                                                      *
 383 \subsection{Record binds}
 384 %*                                                                      *
 385 %************************************************************************
 386
 387 \begin{code}
 388 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
 389                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 390               => PprStyle -> Doc
 391               -> HsRecordBinds tyvar uvar id pat -> Doc
 392
 393 pp_rbinds sty thing rbinds
 394   = hang thing
 395          4 (braces (hsep (punctuate comma (map (pp_rbind sty) rbinds))))
 396   where
 397     pp_rbind sty (v, _, True) | userStyle sty = ppr sty v
 398     pp_rbind sty (v, e, _)                    = hsep [ppr sty v, char '=', ppr sty e]
 399 \end{code}
 400
 401 %************************************************************************
 402 %*                                                                      *
 403 \subsection{Do stmts and list comprehensions}
 404 %*                                                                      *
 405 %************************************************************************
 406
 407 \begin{code}
 408 data DoOrListComp = DoStmt | ListComp
 409
 410 pprDo DoStmt sty stmts
 411   = hang (ptext SLIT("do")) 2 (vcat (map (ppr sty) stmts))
 412 pprDo ListComp sty stmts
 413   = hang (hsep [lbrack, pprExpr sty expr, char '|'])
 414          4 (sep [interpp'SP sty quals, rbrack])
 415   where
 416     ReturnStmt expr = last stmts        -- Last stmt should be a ReturnStmt for list comps
 417     quals           = init stmts
 418 \end{code}
 419
 420 \begin{code}
 421 data Stmt tyvar uvar id pat
 422   = BindStmt    pat
 423                 (HsExpr  tyvar uvar id pat)
 424                 SrcLoc
 425
 426   | LetStmt     (HsBinds tyvar uvar id pat)
 427
 428   | GuardStmt   (HsExpr  tyvar uvar id pat)             -- List comps only
 429                 SrcLoc
 430
 431   | ExprStmt    (HsExpr  tyvar uvar id pat)             -- Do stmts only
 432                 SrcLoc
 433
 434   | ReturnStmt  (HsExpr  tyvar uvar id pat)             -- List comps only, at the end
 435 \end{code}
 436
 437 \begin{code}
 438 instance (NamedThing id, Outputable id, Outputable pat,
 439           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 440                 Outputable (Stmt tyvar uvar id pat) where
 441     ppr sty stmt = pprQuote sty $ \ sty -> pprStmt sty stmt
 442
 443 pprStmt sty (BindStmt pat expr _)
 444  = hsep [ppr sty pat, ptext SLIT("<-"), ppr sty expr]
 445 pprStmt sty (LetStmt binds)
 446  = hsep [ptext SLIT("let"), ppr sty binds]
 447 pprStmt sty (ExprStmt expr _)
 448  = ppr sty expr
 449 pprStmt sty (GuardStmt expr _)
 450  = ppr sty expr
 451 pprStmt sty (ReturnStmt expr)
 452  = hsep [ptext 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)           = hcat [ppr sty e1, pp_dotdot]
 478     ppr sty (FromThen e1 e2)    = hcat [ppr sty e1, comma, space, ppr sty e2, pp_dotdot]
 479     ppr sty (FromTo e1 e3)      = hcat [ppr sty e1, pp_dotdot, ppr sty e3]
 480     ppr sty (FromThenTo e1 e2 e3)
 481       = hcat [ppr sty e1, comma, space, ppr sty e2, pp_dotdot, ppr sty e3]
 482
 483 pp_dotdot = ptext SLIT(" .. ")
 484 \end{code}