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 import Ubiq{-uitous-}
  12 import HsLoop -- for paranoia checking
  13
  14 -- friends:
  15 import HsBinds          ( HsBinds )
  16 import HsLit            ( HsLit )
  17 import HsMatches        ( pprMatches, pprMatch, Match )
  18 import HsTypes          ( PolyType )
  19
  20 -- others:
  21 import Id               ( DictVar(..), GenId, Id(..) )
  22 import Outputable
  23 import PprType          ( pprType, pprParendType, GenType{-instance-}, GenTyVar{-instance-} )
  24 import Pretty
  25 import PprStyle         ( PprStyle(..) )
  26 import SrcLoc           ( SrcLoc )
  27 import TyVar            ( GenTyVar{-instances-} )
  28 import Usage            ( GenUsage{-instance-} )
  29 import Unique           ( Unique{-instances-} )
  30 import Util             ( panic{-ToDo:rm eventually-} )
  31 \end{code}
  32
  33 %************************************************************************
  34 %*                                                                      *
  35 \subsection{Expressions proper}
  36 %*                                                                      *
  37 %************************************************************************
  38
  39 \begin{code}
  40 data HsExpr tyvar uvar id pat
  41   = HsVar       id                              -- variable
  42   | HsLit       HsLit                           -- literal
  43   | HsLitOut    HsLit                           -- TRANSLATION
  44                 (GenType tyvar uvar)            -- (with its type)
  45
  46   | HsLam       (Match  tyvar uvar id pat)      -- lambda
  47   | HsApp       (HsExpr tyvar uvar id pat)      -- application
  48                 (HsExpr tyvar uvar id pat)
  49
  50   -- Operator applications and sections.
  51   -- NB Bracketed ops such as (+) come out as Vars.
  52
  53   | OpApp       (HsExpr tyvar uvar id pat)      -- left operand
  54                 (HsExpr tyvar uvar id pat)      -- operator
  55                 (HsExpr tyvar uvar id pat)      -- right operand
  56
  57   -- ADR Question? Why is the "op" in a section an expr when it will
  58   -- have to be of the form (HsVar op) anyway?
  59   -- WDP Answer: But when the typechecker gets ahold of it, it may
  60   -- apply the var to a few types; it will then be an expression.
  61
  62   | SectionL    (HsExpr tyvar uvar id pat)      -- operand
  63                 (HsExpr tyvar uvar id pat)      -- operator
  64   | SectionR    (HsExpr tyvar uvar id pat)      -- operator
  65                 (HsExpr tyvar uvar id pat)      -- operand
  66
  67
  68   | HsCase      (HsExpr tyvar uvar id pat)
  69                 [Match  tyvar uvar id pat]      -- must have at least one Match
  70                 SrcLoc
  71
  72   | HsIf        (HsExpr tyvar uvar id pat)      --  predicate
  73                 (HsExpr tyvar uvar id pat)      --  then part
  74                 (HsExpr tyvar uvar id pat)      --  else part
  75                 SrcLoc
  76
  77   | HsLet       (HsBinds tyvar uvar id pat)     -- let(rec)
  78                 (HsExpr  tyvar uvar id pat)
  79
  80   | HsDo        [Stmt tyvar uvar id pat]        -- "do":one or more stmts
  81                 SrcLoc
  82
  83   | HsDoOut     [Stmt tyvar uvar id pat]        -- "do":one or more stmts
  84                 id id                           -- Monad and MonadZero dicts
  85                 SrcLoc
  86
  87   | ListComp    (HsExpr tyvar uvar id pat)      -- list comprehension
  88                 [Qual   tyvar uvar id pat]      -- at least one Qual(ifier)
  89
  90   | ExplicitList                -- syntactic list
  91                 [HsExpr tyvar uvar id pat]
  92   | ExplicitListOut             -- TRANSLATION
  93                 (GenType tyvar uvar)    -- Gives type of components of list
  94                 [HsExpr tyvar uvar id pat]
  95
  96   | ExplicitTuple               -- tuple
  97                 [HsExpr tyvar uvar id pat]
  98                                 -- NB: Unit is ExplicitTuple []
  99                                 -- for tuples, we can get the types
 100                                 -- direct from the components
 101
 102   | RecordCon   id              -- record construction
 103                 [(id, Maybe (HsExpr tyvar uvar id pat))]
 104
 105   | RecordUpd   (HsExpr tyvar uvar id pat) -- record update
 106                 [(id, Maybe (HsExpr tyvar uvar id pat))]
 107
 108   | ExprWithTySig               -- signature binding
 109                 (HsExpr tyvar uvar id pat)
 110                 (PolyType id)
 111   | ArithSeqIn                  -- arithmetic sequence
 112                 (ArithSeqInfo tyvar uvar id pat)
 113   | ArithSeqOut
 114                 (HsExpr       tyvar uvar id pat) -- (typechecked, of course)
 115                 (ArithSeqInfo tyvar uvar id pat)
 116
 117   | CCall       FAST_STRING     -- call into the C world; string is
 118                 [HsExpr tyvar uvar id pat]      -- the C function; exprs are the
 119                                 -- arguments to pass.
 120                 Bool            -- True <=> might cause Haskell
 121                                 -- garbage-collection (must generate
 122                                 -- more paranoid code)
 123                 Bool            -- True <=> it's really a "casm"
 124                                 -- NOTE: this CCall is the *boxed*
 125                                 -- version; the desugarer will convert
 126                                 -- it into the unboxed "ccall#".
 127                 (GenType tyvar uvar)    -- The result type; will be *bottom*
 128                                 -- until the typechecker gets ahold of it
 129
 130   | HsSCC       FAST_STRING     -- "set cost centre" (_scc_) annotation
 131                 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
 132 \end{code}
 133
 134 Everything from here on appears only in typechecker output.
 135
 136 \begin{code}
 137   | TyLam                       -- TRANSLATION
 138                 [tyvar]
 139                 (HsExpr tyvar uvar id pat)
 140   | TyApp                       -- TRANSLATION
 141                 (HsExpr  tyvar uvar id pat) -- generated by Spec
 142                 [GenType tyvar uvar]
 143
 144   -- DictLam and DictApp are "inverses"
 145   |  DictLam
 146                 [id]
 147                 (HsExpr tyvar uvar id pat)
 148   |  DictApp
 149                 (HsExpr tyvar uvar id pat)
 150                 [id]
 151
 152   -- ClassDictLam and Dictionary are "inverses" (see note below)
 153   |  ClassDictLam
 154                 [id]            -- superclass dicts
 155                 [id]            -- methods
 156                 (HsExpr tyvar uvar id pat)
 157   |  Dictionary
 158                 [id]            -- superclass dicts
 159                 [id]            -- methods
 160
 161   |  SingleDict                 -- a simple special case of Dictionary
 162                 id              -- local dictionary name
 163 \end{code}
 164
 165 A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
 166 @ClassDictLam dictvars methods expr@ is, therefore:
 167 \begin{verbatim}
 168 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
 169 \end{verbatim}
 170
 171 \begin{code}
 172 instance (NamedThing id, Outputable id, Outputable pat,
 173           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 174                 Outputable (HsExpr tyvar uvar id pat) where
 175     ppr = pprExpr
 176 \end{code}
 177
 178 \begin{code}
 179 pprExpr sty (HsVar v)
 180   = (if (isOpLexeme v) then ppParens else id) (ppr sty v)
 181
 182 pprExpr sty (HsLit    lit)   = ppr sty lit
 183 pprExpr sty (HsLitOut lit _) = ppr sty lit
 184
 185 pprExpr sty (HsLam match)
 186   = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
 187
 188 pprExpr sty expr@(HsApp e1 e2)
 189   = let (fun, args) = collect_args expr [] in
 190     ppHang (pprParendExpr sty fun) 4 (ppSep (map (pprParendExpr sty) args))
 191   where
 192     collect_args (HsApp fun arg) args = collect_args fun (arg:args)
 193     collect_args fun             args = (fun, args)
 194
 195 pprExpr sty (OpApp e1 op e2)
 196   = case op of
 197       HsVar v -> pp_infixly v
 198       _       -> pp_prefixly
 199   where
 200     pp_e1 = pprParendExpr sty e1
 201     pp_e2 = pprParendExpr sty e2
 202
 203     pp_prefixly
 204       = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
 205
 206     pp_infixly v
 207       = ppSep [pp_e1, ppCat [pprOp sty v, pp_e2]]
 208
 209 pprExpr sty (SectionL expr op)
 210   = case op of
 211       HsVar v -> pp_infixly v
 212       _       -> pp_prefixly
 213   where
 214     pp_expr = pprParendExpr sty expr
 215
 216     pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
 217                        4 (ppCat [pp_expr, ppStr "_x )"])
 218     pp_infixly v
 219       = ppSep [ ppBeside ppLparen pp_expr,
 220                 ppBeside (pprOp sty v) ppRparen ]
 221
 222 pprExpr sty (SectionR op expr)
 223   = case op of
 224       HsVar v -> pp_infixly v
 225       _       -> pp_prefixly
 226   where
 227     pp_expr = pprParendExpr sty expr
 228
 229     pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppPStr SLIT("_x")])
 230                        4 (ppBeside pp_expr ppRparen)
 231     pp_infixly v
 232       = ppSep [ ppBeside ppLparen (pprOp sty v),
 233                 ppBeside pp_expr  ppRparen ]
 234
 235 pprExpr sty (CCall fun args _ is_asm result_ty)
 236   = ppHang (if is_asm
 237             then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
 238             else ppBeside  (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
 239          4 (ppSep (map (pprParendExpr sty) args))
 240
 241 pprExpr sty (HsSCC label expr)
 242   = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
 243             pprParendExpr sty expr ]
 244
 245 pprExpr sty (HsCase expr matches _)
 246   = ppSep [ ppSep [ppPStr SLIT("case"), ppNest 4 (pprExpr sty expr), ppPStr SLIT("of")],
 247             ppNest 2 (pprMatches sty (True, ppNil) matches) ]
 248
 249 pprExpr sty (ListComp expr quals)
 250   = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
 251          4 (ppSep [interpp'SP sty quals, ppRbrack])
 252
 253 -- special case: let ... in let ...
 254 pprExpr sty (HsLet binds expr@(HsLet _ _))
 255   = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
 256            ppr sty expr]
 257
 258 pprExpr sty (HsLet binds expr)
 259   = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
 260            ppHang (ppPStr SLIT("in"))  2 (ppr sty expr)]
 261
 262 pprExpr sty (HsDo stmts _)
 263   = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
 264
 265 pprExpr sty (HsIf e1 e2 e3 _)
 266   = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
 267            ppNest 4 (pprExpr sty e2),
 268            ppPStr SLIT("else"),
 269            ppNest 4 (pprExpr sty e3)]
 270
 271 pprExpr sty (ExplicitList exprs)
 272   = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
 273 pprExpr sty (ExplicitListOut ty exprs)
 274   = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
 275                 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprType sty ty))) ]
 276
 277 pprExpr sty (ExplicitTuple exprs)
 278   = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
 279 pprExpr sty (ExprWithTySig expr sig)
 280   = ppHang (ppBesides [ppLparen, ppNest 2 (pprExpr sty expr), ppPStr SLIT(" ::")])
 281          4 (ppBeside  (ppr sty sig) ppRparen)
 282
 283 pprExpr sty (RecordCon con  rbinds)
 284   = pp_rbinds sty (ppr sty con) rbinds
 285
 286 pprExpr sty (RecordUpd aexp rbinds)
 287   = pp_rbinds sty (pprParendExpr sty aexp) rbinds
 288
 289 pprExpr sty (ArithSeqIn info)
 290   = ppBracket (ppr sty info)
 291 pprExpr sty (ArithSeqOut expr info)
 292   = case sty of
 293         PprForUser ->
 294           ppBracket (ppr sty info)
 295         _          ->
 296           ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
 297
 298 pprExpr sty (TyLam tyvars expr)
 299   = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
 300          4 (pprExpr sty expr)
 301
 302 pprExpr sty (TyApp expr [ty])
 303   = ppHang (pprExpr sty expr) 4 (pprParendType sty ty)
 304
 305 pprExpr sty (TyApp expr tys)
 306   = ppHang (pprExpr sty expr)
 307          4 (ppBracket (interpp'SP sty tys))
 308
 309 pprExpr sty (DictLam dictvars expr)
 310   = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
 311          4 (pprExpr sty expr)
 312
 313 pprExpr sty (DictApp expr [dname])
 314   = ppHang (pprExpr sty expr) 4 (ppr sty dname)
 315
 316 pprExpr sty (DictApp expr dnames)
 317   = ppHang (pprExpr sty expr)
 318          4 (ppBracket (interpp'SP sty dnames))
 319
 320 pprExpr sty (ClassDictLam dicts methods expr)
 321   = ppHang (ppCat [ppStr "\\{-classdict-}",
 322                    ppBracket (interppSP sty dicts),
 323                    ppBracket (interppSP sty methods),
 324                    ppStr "->"])
 325          4 (pprExpr sty expr)
 326
 327 pprExpr sty (Dictionary dicts methods)
 328  = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
 329           ppBracket (interpp'SP sty dicts),
 330           ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
 331
 332 pprExpr sty (SingleDict dname)
 333  = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
 334 \end{code}
 335
 336 Parenthesize unless very simple:
 337 \begin{code}
 338 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
 339                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 340               => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
 341
 342 pprParendExpr sty expr
 343   = let
 344         pp_as_was = pprExpr sty expr
 345     in
 346     case expr of
 347       HsLit l               -> ppr sty l
 348       HsLitOut l _          -> ppr sty l
 349       HsVar _               -> pp_as_was
 350       ExplicitList _        -> pp_as_was
 351       ExplicitListOut _ _   -> pp_as_was
 352       ExplicitTuple _       -> pp_as_was
 353       _                     -> ppParens pp_as_was
 354 \end{code}
 355
 356 %************************************************************************
 357 %*                                                                      *
 358 \subsection{Record binds}
 359 %*                                                                      *
 360 %************************************************************************
 361
 362 \begin{code}
 363 pp_rbinds sty thing rbinds
 364   = ppHang thing 4
 365         (ppBesides [ppChar '{', ppInterleave ppComma (map (pp_rbind sty) rbinds), ppChar '}'])
 366
 367 pp_rbind :: (NamedThing id, Outputable id, Outputable pat,
 368                   Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 369               => PprStyle -> (id, Maybe (HsExpr tyvar uvar id pat)) -> Pretty
 370
 371 pp_rbind sty (v, Nothing) = ppr sty v
 372 pp_rbind sty (v, Just e)  = ppCat [ppr sty v, ppStr "<-", ppr sty e]
 373 \end{code}
 374
 375 %************************************************************************
 376 %*                                                                      *
 377 \subsection{Do stmts}
 378 %*                                                                      *
 379 %************************************************************************
 380
 381 \begin{code}
 382 data Stmt tyvar uvar id pat
 383   = BindStmt    pat
 384                 (HsExpr  tyvar uvar id pat)
 385                 SrcLoc
 386   | ExprStmt    (HsExpr  tyvar uvar id pat)
 387                 SrcLoc
 388   | LetStmt     (HsBinds tyvar uvar id pat)
 389 \end{code}
 390
 391 \begin{code}
 392 instance (NamedThing id, Outputable id, Outputable pat,
 393           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 394                 Outputable (Stmt tyvar uvar id pat) where
 395     ppr sty (BindStmt pat expr _)
 396      = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
 397     ppr sty (LetStmt binds)
 398      = ppCat [ppPStr SLIT("let"), ppr sty binds]
 399     ppr sty (ExprStmt expr _)
 400      = ppr sty expr
 401 \end{code}
 402
 403 %************************************************************************
 404 %*                                                                      *
 405 \subsection{Enumerations and list comprehensions}
 406 %*                                                                      *
 407 %************************************************************************
 408
 409 \begin{code}
 410 data ArithSeqInfo  tyvar uvar id pat
 411   = From            (HsExpr tyvar uvar id pat)
 412   | FromThen        (HsExpr tyvar uvar id pat)
 413                     (HsExpr tyvar uvar id pat)
 414   | FromTo          (HsExpr tyvar uvar id pat)
 415                     (HsExpr tyvar uvar id pat)
 416   | FromThenTo      (HsExpr tyvar uvar id pat)
 417                     (HsExpr tyvar uvar id pat)
 418                     (HsExpr tyvar uvar id pat)
 419 \end{code}
 420
 421 \begin{code}
 422 instance (NamedThing id, Outputable id, Outputable pat,
 423           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 424                 Outputable (ArithSeqInfo tyvar uvar id pat) where
 425     ppr sty (From e1)           = ppBesides [ppr sty e1, pp_dotdot]
 426     ppr sty (FromThen e1 e2)    = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
 427     ppr sty (FromTo e1 e3)      = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
 428     ppr sty (FromThenTo e1 e2 e3)
 429       = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
 430
 431 pp_dotdot = ppPStr SLIT(" .. ")
 432 \end{code}
 433
 434 ``Qualifiers'' in list comprehensions:
 435 \begin{code}
 436 data Qual tyvar uvar id pat
 437   = GeneratorQual   pat
 438                     (HsExpr  tyvar uvar id pat)
 439   | LetQual         (HsBinds tyvar uvar id pat)
 440   | FilterQual      (HsExpr  tyvar uvar id pat)
 441 \end{code}
 442
 443 \begin{code}
 444 instance (NamedThing id, Outputable id, Outputable pat,
 445           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
 446                 Outputable (Qual tyvar uvar id pat) where
 447     ppr sty (GeneratorQual pat expr)
 448      = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
 449     ppr sty (LetQual binds)
 450      = ppCat [ppPStr SLIT("let"), ppr sty binds]
 451     ppr sty (FilterQual expr)
 452      = ppr sty expr
 453 \end{code}