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   id
 117                 (HsRecordBinds tyvar uvar id pat)
 118
 119   | RecordConOut id                             -- The constructor
 120                  (HsExpr tyvar uvar id pat)     -- The constructor applied to type/dict args
 121                  (HsRecordBinds tyvar uvar id pat)
 122
 123         -- Record update
 124   | RecordUpd   (HsExpr tyvar uvar id pat)
 125                 (HsRecordBinds tyvar uvar id pat)
 126
 127   | RecordUpdOut (HsExpr tyvar uvar id pat)     -- TRANSLATION
 128                  (GenType tyvar uvar)           -- Type of *result* record (may differ from
 129                                                 -- type of input record)
 130                  [id]                           -- Dicts needed for construction
 131                  (HsRecordBinds tyvar uvar id pat)
 132
 133   | ExprWithTySig               -- signature binding
 134                 (HsExpr tyvar uvar id pat)
 135                 (HsType id)
 136   | ArithSeqIn                  -- arithmetic sequence
 137                 (ArithSeqInfo tyvar uvar id pat)
 138   | ArithSeqOut
 139                 (HsExpr       tyvar uvar id pat) -- (typechecked, of course)
 140                 (ArithSeqInfo tyvar uvar id pat)
 141
 142   | CCall       FAST_STRING     -- call into the C world; string is
 143                 [HsExpr tyvar uvar id pat]      -- the C function; exprs are the
 144                                 -- arguments to pass.
 145                 Bool            -- True <=> might cause Haskell
 146                                 -- garbage-collection (must generate
 147                                 -- more paranoid code)
 148                 Bool            -- True <=> it's really a "casm"
 149                                 -- NOTE: this CCall is the *boxed*
 150                                 -- version; the desugarer will convert
 151                                 -- it into the unboxed "ccall#".
 152                 (GenType tyvar uvar)    -- The result type; will be *bottom*
 153                                 -- until the typechecker gets ahold of it
 154
 155   | HsSCC       FAST_STRING     -- "set cost centre" (_scc_) annotation
 156                 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
 157 \end{code}
 158
 159 Everything from here on appears only in typechecker output.
 160
 161 \begin{code}
 162   | TyLam                       -- TRANSLATION
 163                 [tyvar]
 164                 (HsExpr tyvar uvar id pat)
 165   | TyApp                       -- TRANSLATION
 166                 (HsExpr  tyvar uvar id pat) -- generated by Spec
 167                 [GenType tyvar uvar]
 168
 169   -- DictLam and DictApp are "inverses"
 170   |  DictLam
 171                 [id]
 172                 (HsExpr tyvar uvar id pat)
 173   |  DictApp
 174                 (HsExpr tyvar uvar id pat)
 175                 [id]
 176
 177   -- ClassDictLam and Dictionary are "inverses" (see note below)
 178   |  ClassDictLam
 179                 [id]            -- superclass dicts
 180                 [id]            -- methods
 181                 (HsExpr tyvar uvar id pat)
 182   |  Dictionary
 183                 [id]            -- superclass dicts
 184                 [id]            -- methods
 185
 186   |  SingleDict                 -- a simple special case of Dictionary
 187                 id              -- local dictionary name
 188
 189 type HsRecordBinds tyvar uvar id pat
 190   = [(id, HsExpr tyvar uvar id pat, Bool)]
 191         -- True <=> source code used "punning",
 192         -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
 193 \end{code}
 194
 195 A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
 196 @ClassDictLam dictvars methods expr@ is, therefore:
 197 \begin{verbatim}
 198 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
 199 \end{verbatim}
 200
 201 \begin{code}
 202 instance (NamedThing id, Outputable id, Outputable pat,
 203           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 204                 Outputable (HsExpr tyvar uvar id pat) where
 205     ppr sty expr = pprQuote sty $ \ sty -> pprExpr sty expr
 206 \end{code}
 207
 208 \begin{code}
 209 pprExpr :: (NamedThing id, Outputable id, Outputable pat,
 210             Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 211         => PprStyle -> HsExpr tyvar uvar id pat -> Doc
 212
 213 pprExpr sty (HsVar v) = ppr sty v
 214
 215 pprExpr sty (HsLit    lit)   = ppr sty lit
 216 pprExpr sty (HsLitOut lit _) = ppr sty lit
 217
 218 pprExpr sty (HsLam match)
 219   = hsep [char '\\', nest 2 (pprMatch sty True match)]
 220
 221 pprExpr sty expr@(HsApp e1 e2)
 222   = let (fun, args) = collect_args expr [] in
 223     (pprExpr sty fun) <+> (sep (map (pprExpr sty) args))
 224   where
 225     collect_args (HsApp fun arg) args = collect_args fun (arg:args)
 226     collect_args fun             args = (fun, args)
 227
 228 pprExpr sty (OpApp e1 op fixity e2)
 229   = case op of
 230       HsVar v -> pp_infixly v
 231       _       -> pp_prefixly
 232   where
 233     pp_e1 = pprParendExpr sty e1                -- Add parens to make precedence clear
 234     pp_e2 = pprParendExpr sty e2
 235
 236     pp_prefixly
 237       = hang (pprExpr sty op) 4 (sep [pp_e1, pp_e2])
 238
 239     pp_infixly v
 240       = sep [pp_e1, hsep [ppr sty v, pp_e2]]
 241
 242 pprExpr sty (NegApp e _)
 243   = (<>) (char '-') (pprParendExpr sty e)
 244
 245 pprExpr sty (HsPar e)
 246   = parens (pprExpr sty e)
 247
 248 pprExpr sty (SectionL expr op)
 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])
 256                        4 (hsep [pp_expr, ptext SLIT("x_ )")])
 257     pp_infixly v = parens (sep [pp_expr, ppr sty v])
 258
 259 pprExpr sty (SectionR op expr)
 260   = case op of
 261       HsVar v -> pp_infixly v
 262       _       -> pp_prefixly
 263   where
 264     pp_expr = pprParendExpr sty expr
 265
 266     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr sty op, ptext SLIT("x_")])
 267                        4 ((<>) pp_expr rparen)
 268     pp_infixly v
 269       = parens (sep [ppr sty v, pp_expr])
 270
 271 pprExpr sty (HsCase expr matches _)
 272   = sep [ sep [ptext SLIT("case"), nest 4 (pprExpr sty expr), ptext SLIT("of")],
 273             nest 2 (pprMatches sty (True, empty) matches) ]
 274
 275 pprExpr sty (HsIf e1 e2 e3 _)
 276   = sep [hsep [ptext SLIT("if"), nest 2 (pprExpr sty e1), ptext SLIT("then")],
 277            nest 4 (pprExpr sty e2),
 278            ptext SLIT("else"),
 279            nest 4 (pprExpr sty e3)]
 280
 281 -- special case: let ... in let ...
 282 pprExpr sty (HsLet binds expr@(HsLet _ _))
 283   = sep [hang (ptext SLIT("let")) 2 (hsep [ppr sty binds, ptext SLIT("in")]),
 284            ppr sty expr]
 285
 286 pprExpr sty (HsLet binds expr)
 287   = sep [hang (ptext SLIT("let")) 2 (ppr sty binds),
 288            hang (ptext SLIT("in"))  2 (ppr sty expr)]
 289
 290 pprExpr sty (HsDo do_or_list_comp stmts _)            = pprDo do_or_list_comp sty stmts
 291 pprExpr sty (HsDoOut do_or_list_comp stmts _ _ _ _ _) = pprDo do_or_list_comp sty stmts
 292
 293 pprExpr sty (ExplicitList exprs)
 294   = brackets (fsep (punctuate comma (map (pprExpr sty) exprs)))
 295 pprExpr sty (ExplicitListOut ty exprs)
 296   = hcat [ brackets (fsep (punctuate comma (map (pprExpr sty) exprs))),
 297            ifnotPprForUser sty ((<>) space (parens (pprGenType sty ty))) ]
 298
 299 pprExpr sty (ExplicitTuple exprs)
 300   = parens (sep (punctuate comma (map (pprExpr sty) exprs)))
 301
 302 pprExpr sty (RecordCon con rbinds)
 303   = pp_rbinds sty (ppr sty con) rbinds
 304 pprExpr sty (RecordConOut con_id con_expr rbinds)
 305   = pp_rbinds sty (ppr sty con_expr) rbinds
 306
 307 pprExpr sty (RecordUpd aexp rbinds)
 308   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 309 pprExpr sty (RecordUpdOut aexp _ _ rbinds)
 310   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 311
 312 pprExpr sty (ExprWithTySig expr sig)
 313   = hang ((<>) (nest 2 (pprExpr sty expr)) (ptext SLIT(" ::")))
 314          4 (ppr sty sig)
 315
 316 pprExpr sty (ArithSeqIn info)
 317   = brackets (ppr sty info)
 318 pprExpr sty (ArithSeqOut expr info)
 319   | userStyle sty = brackets (ppr sty info)
 320   | otherwise     = brackets (hcat [parens (ppr sty expr), space, ppr sty info])
 321
 322 pprExpr sty (CCall fun args _ is_asm result_ty)
 323   = hang (if is_asm
 324             then hcat [ptext SLIT("_casm_ ``"), ptext fun, ptext SLIT("''")]
 325             else (<>)  (ptext SLIT("_ccall_ ")) (ptext fun))
 326          4 (sep (map (pprParendExpr sty) args))
 327
 328 pprExpr sty (HsSCC label expr)
 329   = sep [ (<>) (ptext SLIT("_scc_ ")) (hcat [char '"', ptext label, char '"']),
 330             pprParendExpr sty expr ]
 331
 332 pprExpr sty (TyLam tyvars expr)
 333   = hang (hsep [ptext SLIT("/\\"), interppSP sty tyvars, ptext SLIT("->")])
 334          4 (pprExpr sty expr)
 335
 336 pprExpr sty (TyApp expr [ty])
 337   = hang (pprExpr sty expr) 4 (pprParendGenType sty ty)
 338
 339 pprExpr sty (TyApp expr tys)
 340   = hang (pprExpr sty expr)
 341          4 (brackets (interpp'SP sty tys))
 342
 343 pprExpr sty (DictLam dictvars expr)
 344   = hang (hsep [ptext SLIT("\\{-dict-}"), interppSP sty dictvars, ptext SLIT("->")])
 345          4 (pprExpr sty expr)
 346
 347 pprExpr sty (DictApp expr [dname])
 348   = hang (pprExpr sty expr) 4 (ppr sty dname)
 349
 350 pprExpr sty (DictApp expr dnames)
 351   = hang (pprExpr sty expr)
 352          4 (brackets (interpp'SP sty dnames))
 353
 354 pprExpr sty (ClassDictLam dicts methods expr)
 355   = hang (hsep [ptext SLIT("\\{-classdict-}"),
 356                    brackets (interppSP sty dicts),
 357                    brackets (interppSP sty methods),
 358                    ptext SLIT("->")])
 359          4 (pprExpr sty expr)
 360
 361 pprExpr sty (Dictionary dicts methods)
 362   = parens (sep [ptext SLIT("{-dict-}"),
 363                    brackets (interpp'SP sty dicts),
 364                    brackets (interpp'SP sty methods)])
 365
 366 pprExpr sty (SingleDict dname)
 367   = hsep [ptext SLIT("{-singleDict-}"), ppr sty dname]
 368
 369 \end{code}
 370
 371 Parenthesize unless very simple:
 372 \begin{code}
 373 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
 374                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 375               => PprStyle -> HsExpr tyvar uvar id pat -> Doc
 376
 377 pprParendExpr sty expr
 378   = let
 379         pp_as_was = pprExpr sty expr
 380     in
 381     case expr of
 382       HsLit l               -> ppr sty l
 383       HsLitOut l _          -> ppr sty l
 384
 385       HsVar _               -> pp_as_was
 386       ExplicitList _        -> pp_as_was
 387       ExplicitListOut _ _   -> pp_as_was
 388       ExplicitTuple _       -> pp_as_was
 389       HsPar _               -> pp_as_was
 390
 391       _                     -> parens pp_as_was
 392 \end{code}
 393
 394 %************************************************************************
 395 %*                                                                      *
 396 \subsection{Record binds}
 397 %*                                                                      *
 398 %************************************************************************
 399
 400 \begin{code}
 401 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
 402                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 403               => PprStyle -> Doc
 404               -> HsRecordBinds tyvar uvar id pat -> Doc
 405
 406 pp_rbinds sty thing rbinds
 407   = hang thing
 408          4 (braces (hsep (punctuate comma (map (pp_rbind sty) rbinds))))
 409   where
 410     pp_rbind sty (v, _, True) | userStyle sty = ppr sty v
 411     pp_rbind sty (v, e, _)                    = hsep [ppr sty v, char '=', ppr sty e]
 412 \end{code}
 413
 414 %************************************************************************
 415 %*                                                                      *
 416 \subsection{Do stmts and list comprehensions}
 417 %*                                                                      *
 418 %************************************************************************
 419
 420 \begin{code}
 421 data DoOrListComp = DoStmt | ListComp | Guard
 422
 423 pprDo DoStmt sty stmts
 424   = hang (ptext SLIT("do")) 2 (vcat (map (ppr sty) stmts))
 425 pprDo ListComp sty stmts
 426   = brackets $
 427     hang (pprExpr sty expr <+> char '|')
 428        4 (interpp'SP sty quals)
 429   where
 430     ReturnStmt expr = last stmts        -- Last stmt should be a ReturnStmt for list comps
 431     quals           = init stmts
 432 \end{code}
 433
 434 \begin{code}
 435 data Stmt tyvar uvar id pat
 436   = BindStmt    pat
 437                 (HsExpr  tyvar uvar id pat)
 438                 SrcLoc
 439
 440   | LetStmt     (HsBinds tyvar uvar id pat)
 441
 442   | GuardStmt   (HsExpr  tyvar uvar id pat)             -- List comps only
 443                 SrcLoc
 444
 445   | ExprStmt    (HsExpr  tyvar uvar id pat)             -- Do stmts only
 446                 SrcLoc
 447
 448   | ReturnStmt  (HsExpr  tyvar uvar id pat)             -- List comps only, at the end
 449 \end{code}
 450
 451 \begin{code}
 452 instance (NamedThing id, Outputable id, Outputable pat,
 453           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 454                 Outputable (Stmt tyvar uvar id pat) where
 455     ppr sty stmt = pprQuote sty $ \ sty -> pprStmt sty stmt
 456
 457 pprStmt sty (BindStmt pat expr _)
 458  = hsep [ppr sty pat, ptext SLIT("<-"), ppr sty expr]
 459 pprStmt sty (LetStmt binds)
 460  = hsep [ptext SLIT("let"), ppr sty binds]
 461 pprStmt sty (ExprStmt expr _)
 462  = ppr sty expr
 463 pprStmt sty (GuardStmt expr _)
 464  = ppr sty expr
 465 pprStmt sty (ReturnStmt expr)
 466  = hsep [ptext SLIT("return"), ppr sty expr]
 467 \end{code}
 468
 469 %************************************************************************
 470 %*                                                                      *
 471 \subsection{Enumerations and list comprehensions}
 472 %*                                                                      *
 473 %************************************************************************
 474
 475 \begin{code}
 476 data ArithSeqInfo  tyvar uvar id pat
 477   = From            (HsExpr tyvar uvar id pat)
 478   | FromThen        (HsExpr tyvar uvar id pat)
 479                     (HsExpr tyvar uvar id pat)
 480   | FromTo          (HsExpr tyvar uvar id pat)
 481                     (HsExpr tyvar uvar id pat)
 482   | FromThenTo      (HsExpr tyvar uvar id pat)
 483                     (HsExpr tyvar uvar id pat)
 484                     (HsExpr tyvar uvar id pat)
 485 \end{code}
 486
 487 \begin{code}
 488 instance (NamedThing id, Outputable id, Outputable pat,
 489           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 490                 Outputable (ArithSeqInfo tyvar uvar id pat) where
 491     ppr sty (From e1)           = hcat [ppr sty e1, pp_dotdot]
 492     ppr sty (FromThen e1 e2)    = hcat [ppr sty e1, comma, space, ppr sty e2, pp_dotdot]
 493     ppr sty (FromTo e1 e3)      = hcat [ppr sty e1, pp_dotdot, ppr sty e3]
 494     ppr sty (FromThenTo e1 e2 e3)
 495       = hcat [ppr sty e1, comma, space, ppr sty e2, pp_dotdot, ppr sty e3]
 496
 497 pp_dotdot = ptext SLIT(" .. ")
 498 \end{code}