ghc/compiler/abstractSyn/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 AbsUniType       ( pprUniType, pprParendUniType, TyVar, UniType
  12                           IF_ATTACK_PRAGMAS(COMMA cmpTyVar)
  13                           IF_ATTACK_PRAGMAS(COMMA cmpUniType)
  14                         )
  15 import Name             ( Name )
  16 import Unique           ( Unique )
  17 import HsBinds          ( Binds )
  18 import HsLit            ( Literal )
  19 import HsMatches        ( pprMatches, pprMatch, Match )
  20 import HsPat            ( ProtoNamePat(..), RenamedPat(..),
  21                           TypecheckedPat, InPat
  22                           IF_ATTACK_PRAGMAS(COMMA typeOfPat)
  23                         )
  24 import HsTypes          ( PolyType )
  25 import Id               ( Id, DictVar(..), DictFun(..) )
  26 import Outputable
  27 import ProtoName        ( ProtoName(..) ) -- .. for pragmas only
  28 import Pretty
  29 import Util
  30 \end{code}
  31
  32 %************************************************************************
  33 %*                                                                      *
  34 \subsection[AbsSyn-Expr]{Expressions proper}
  35 %*                                                                      *
  36 %************************************************************************
  37
  38 \begin{code}
  39 data Expr bdee pat
  40   = Var         bdee                    -- variable
  41   | Lit         Literal                 -- literal
  42
  43   | Lam         (Match bdee pat)        -- lambda
  44   | App         (Expr bdee pat)         -- application
  45                 (Expr bdee pat)
  46
  47   -- Operator applications and sections.
  48   -- NB Bracketed ops such as (+) come out as Vars.
  49
  50   | OpApp       (Expr bdee pat) (Expr bdee pat) (Expr bdee pat)
  51                                         -- middle expr is the "op"
  52
  53   -- ADR Question? Why is the "op" in a section an expr when it will
  54   -- have to be of the form (Var op) anyway?
  55   -- WDP Answer: But when the typechecker gets ahold of it, it may
  56   -- apply the var to a few types; it will then be an expression.
  57
  58   | SectionL    (Expr bdee pat) (Expr bdee pat)
  59                                         -- right expr is the "op"
  60   | SectionR    (Expr bdee pat) (Expr bdee pat)
  61                                         -- left expr is the "op"
  62
  63   | CCall       FAST_STRING     -- call into the C world; string is
  64                 [Expr bdee pat] -- the C function; exprs are the
  65                                 -- arguments to pass.
  66                 Bool            -- True <=> might cause Haskell
  67                                 -- garbage-collection (must generate
  68                                 -- more paranoid code)
  69                 Bool            -- True <=> it's really a "casm"
  70                                 -- NOTE: this CCall is the *boxed*
  71                                 -- version; the desugarer will convert
  72                                 -- it into the unboxed "ccall#".
  73                 UniType         -- The result type; will be *bottom*
  74                                 -- until the typechecker gets ahold of it
  75
  76   | SCC         FAST_STRING     -- set cost centre annotation
  77                 (Expr bdee pat) -- expr whose cost is to be measured
  78
  79   | Case        (Expr bdee pat)
  80                 [Match bdee pat] -- must have at least one Match
  81
  82   | If                          -- conditional
  83                 (Expr bdee pat) --  predicate
  84                 (Expr bdee pat) --  then part
  85                 (Expr bdee pat) --  else part
  86
  87   | Let         (Binds bdee pat) -- let(rec)
  88                 (Expr bdee pat)
  89
  90   | ListComp    (Expr bdee pat) -- list comprehension
  91                 [Qual bdee pat] -- at least one Qual(ifier)
  92
  93   | ExplicitList                -- syntactic list
  94                 [Expr bdee pat]
  95   | ExplicitListOut             -- TRANSLATION
  96                 UniType         -- Unitype gives type of components of list
  97                 [Expr bdee pat]
  98
  99   | ExplicitTuple               -- tuple
 100                 [Expr bdee pat]
 101                                 -- NB: Unit is ExplicitTuple []
 102                                 -- for tuples, we can get the types
 103                                 -- direct from the components
 104
 105   | ExprWithTySig               -- signature binding
 106                 (Expr bdee pat)
 107                 (PolyType bdee)
 108   | ArithSeqIn                  -- arithmetic sequence
 109                 (ArithSeqInfo bdee pat)
 110   | ArithSeqOut
 111                 (Expr bdee pat) -- (typechecked, of course)
 112                 (ArithSeqInfo bdee pat)
 113 #ifdef DPH
 114   | ParallelZF
 115                 (Expr bdee pat)
 116                 (ParQuals bdee pat)
 117   | ExplicitPodIn
 118                 [Expr bdee pat]
 119   | ExplicitPodOut
 120                 UniType         -- Unitype gives type of components of list
 121                 [Expr bdee pat]
 122   | ExplicitProcessor
 123                 [Expr bdee pat]
 124                 (Expr bdee pat)
 125 #endif {- Data Parallel Haskell -}
 126 \end{code}
 127
 128 Everything from here on appears only in typechecker output; hence, the
 129 explicit @Id@s.
 130 \begin{code}
 131   | TyLam                       -- TRANSLATION
 132                 [TyVar]         -- Not TyVarTemplate, which only occur in a
 133                                 -- binding position in a forall type.
 134                 (Expr bdee pat)
 135   | TyApp                       -- TRANSLATION
 136                 (Expr bdee pat) -- generated by Spec
 137                 [UniType]
 138
 139   -- DictLam and DictApp are "inverses"
 140   |  DictLam
 141                 [DictVar]
 142                 (Expr bdee pat)
 143   |  DictApp
 144                 (Expr bdee pat)
 145                 [DictVar]               -- dictionary names
 146
 147   -- ClassDictLam and Dictionary are "inverses" (see note below)
 148   |  ClassDictLam
 149                 [DictVar]
 150                 [Id]
 151                 -- The ordering here allows us to do away with dicts and methods
 152
 153                 -- [I don't understand this comment. WDP.  Perhaps a ptr to
 154                 --  a complete description of what's going on ? ]
 155                 (Expr bdee pat)
 156   |  Dictionary
 157                 [DictVar]       -- superclass dictionary names
 158                 [Id]            -- method names
 159   |  SingleDict                 -- a simple special case of Dictionary
 160                 DictVar         -- local dictionary name
 161 \end{code}
 162
 163 \begin{code}
 164 type ProtoNameExpr              = Expr ProtoName ProtoNamePat
 165
 166 type RenamedExpr        = Expr Name RenamedPat
 167
 168 type TypecheckedExpr    = Expr Id TypecheckedPat
 169 \end{code}
 170
 171 A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
 172 @ClassDictLam dictvars methods expr@ is, therefore:
 173 \begin{verbatim}
 174 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
 175 \end{verbatim}
 176
 177 \begin{code}
 178 instance (NamedThing bdee, Outputable bdee,
 179                                     NamedThing pat, Outputable pat) =>
 180                 Outputable (Expr bdee pat) where
 181     ppr = pprExpr
 182 \end{code}
 183
 184 \begin{code}
 185 pprExpr :: (NamedThing bdee, Outputable bdee,
 186                       NamedThing pat, Outputable pat) =>
 187                 PprStyle -> Expr bdee pat -> Pretty
 188
 189 pprExpr sty (Var v)
 190   = if (isOpLexeme v) then
 191         ppBesides [ppLparen, ppr sty v, ppRparen]
 192     else
 193         ppr sty v
 194
 195 pprExpr sty (Lit lit)  = ppr sty lit
 196 pprExpr sty (Lam match)
 197   = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
 198
 199 pprExpr sty expr@(App e1 e2)
 200   = let (fun, args) = collect_args expr [] in
 201     ppHang (pprParendExpr sty fun) 4 (ppSep (map (pprParendExpr sty) args))
 202   where
 203     collect_args (App fun arg) args = collect_args fun (arg:args)
 204     collect_args fun           args = (fun, args)
 205
 206 pprExpr sty (OpApp e1 op e2)
 207   = case op of
 208       Var v -> pp_infixly v
 209       _     -> pp_prefixly
 210   where
 211     pp_e1 = pprParendExpr sty e1
 212     pp_e2 = pprParendExpr sty e2
 213
 214     pp_prefixly
 215       = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
 216
 217     pp_infixly v
 218       = ppSep [pp_e1, ppCat [pprOp sty v, pp_e2]]
 219
 220 pprExpr sty (SectionL expr op)
 221   = case op of
 222       Var v -> pp_infixly v
 223       _     -> pp_prefixly
 224   where
 225     pp_expr = pprParendExpr sty expr
 226
 227     pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
 228                        4 (ppCat [pp_expr, ppStr "_x )"])
 229     pp_infixly v
 230       = ppSep [ ppBesides [ppLparen, pp_expr],
 231                 ppBesides [pprOp sty v, ppRparen] ]
 232
 233 pprExpr sty (SectionR op expr)
 234   = case op of
 235       Var v -> pp_infixly v
 236       _     -> pp_prefixly
 237   where
 238     pp_expr = pprParendExpr sty expr
 239
 240     pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppStr "_x"])
 241                        4 (ppBesides [pp_expr, ppRparen])
 242     pp_infixly v
 243       = ppSep [ ppBesides [ppLparen, pprOp sty v],
 244                 ppBesides [pp_expr, ppRparen] ]
 245
 246 pprExpr sty (CCall fun args _ is_asm result_ty)
 247   = ppHang (if is_asm
 248             then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
 249             else ppCat     [ppStr "_ccall_", ppPStr fun])
 250          4 (ppSep (map (pprParendExpr sty) args
 251                 {-++ [ppCat [ppStr "{-", ppr sty result_ty, ppStr "-}"]]-}))
 252         -- printing the result type can give reader panics (ToDo: fix)
 253
 254 pprExpr sty (SCC label expr)
 255   = ppSep [ ppBesides [ppStr "scc", ppBesides [ppChar '"', ppPStr label, ppChar '"'] ],
 256             pprParendExpr sty expr ]
 257
 258 pprExpr sty (Case expr matches)
 259   = ppSep [ ppSep [ppStr "case", ppNest 4 (pprExpr sty expr), ppStr "of"],
 260             ppNest 2 (pprMatches sty (True, ppNil) matches) ]
 261
 262 pprExpr sty (ListComp expr quals)
 263   = ppHang (ppCat [ppStr "[", pprExpr sty expr, ppStr "|"])
 264          4 (ppSep [interpp'SP sty quals, ppRbrack])
 265
 266 -- special case: let ... in let ...
 267 pprExpr sty (Let binds expr@(Let _ _))
 268   = ppSep [ppHang (ppStr "let") 2 (ppCat [ppr sty binds, ppStr "in"]),
 269            ppr sty expr]
 270
 271 pprExpr sty (Let binds expr)
 272   = ppSep [ppHang (ppStr "let") 2 (ppr sty binds),
 273            ppHang (ppStr "in")  2 (ppr sty expr)]
 274
 275 pprExpr sty (ExplicitList exprs)
 276   = ppBesides [ppLbrack, ppInterleave ppComma (map (pprExpr sty) exprs), ppRbrack]
 277 pprExpr sty (ExplicitListOut ty exprs)
 278   = ppBesides [ ppLbrack, ppInterleave ppComma (map (pprExpr sty) exprs), ppRbrack,
 279                 case sty of
 280                   PprForUser -> ppNil
 281                   _ -> ppBesides [ppStr " (", pprUniType sty ty, ppStr ")"] ]
 282
 283 pprExpr sty (ExplicitTuple exprs)
 284   = ppBesides [ppLparen, ppInterleave ppComma (map (pprExpr sty) exprs), ppRparen]
 285 pprExpr sty (ExprWithTySig expr sig)
 286   = ppHang (ppBesides [ppLparen, ppNest 2 (pprExpr sty expr), ppStr " ::"])
 287          4 (ppBesides [ppr sty sig, ppRparen])
 288
 289 pprExpr sty (If e1 e2 e3)
 290   = ppSep [ppCat [ppStr "if", ppNest 2 (pprExpr sty e1), ppStr "then"],
 291            ppNest 4 (pprExpr sty e2),
 292            ppStr "else",
 293            ppNest 4 (pprExpr sty e3)]
 294 pprExpr sty (ArithSeqIn info)
 295     = ppCat [ppLbrack, ppr sty info, ppRbrack]
 296 pprExpr sty (ArithSeqOut expr info)
 297     = case sty of
 298         PprForUser ->
 299           ppBesides [ppLbrack, ppr sty info, ppRbrack]
 300         _          ->
 301           ppBesides [ppLbrack, ppLparen, ppr sty expr, ppRparen, ppr sty info, ppRbrack]
 302 #ifdef DPH
 303 pprExpr sty (ParallelZF expr pquals)
 304   = ppHang (ppCat [ppStr "<<" , pprExpr sty expr , ppStr "|"])
 305          4 (ppSep [ppr sty pquals, ppStr ">>"])
 306
 307 pprExpr sty (ExplicitPodIn exprs)
 308   = ppBesides [ppStr "<<", ppInterleave ppComma (map (pprExpr sty) exprs) ,
 309                ppStr ">>"]
 310
 311 pprExpr sty (ExplicitPodOut ty exprs)
 312   = ppBesides [ppStr "(",ppStr "<<",
 313                ppInterleave ppComma (map (pprExpr sty) exprs),
 314                ppStr ">>", ppStr " ::" , ppStr "<<" , pprUniType sty ty ,
 315                ppStr ">>" , ppStr ")"]
 316
 317 pprExpr sty (ExplicitProcessor exprs expr)
 318   = ppBesides [ppStr "(|", ppInterleave ppComma (map (pprExpr sty) exprs) ,
 319                ppSemi , pprExpr sty expr, ppStr "|)"]
 320
 321 #endif {- Data Parallel Haskell -}
 322
 323 -- for these translation-introduced things, we don't show them
 324 -- if style is PprForUser
 325
 326 pprExpr sty (TyLam tyvars expr)
 327   = case sty of
 328       PprForUser -> pprExpr sty expr
 329       _ -> ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
 330                 4 (pprExpr sty expr)
 331
 332 pprExpr sty (TyApp expr [ty])
 333   = case sty of
 334       PprForUser -> pprExpr sty expr
 335       _ -> ppHang (ppBeside pp_note (pprExpr sty expr)) 4 (pprParendUniType sty ty)
 336   where
 337     pp_note = ifPprShowAll sty (ppStr "{-TyApp-} ")
 338
 339 pprExpr sty (TyApp expr tys)
 340   = case sty of
 341       PprForUser -> pprExpr sty expr
 342       _ -> ppHang (ppBeside pp_note (pprExpr sty expr))
 343                 4 (ppBesides [ppLbrack, interpp'SP sty tys, ppRbrack])
 344   where
 345     pp_note = ifPprShowAll sty (ppStr "{-TyApp-} ")
 346
 347 pprExpr sty (DictLam dictvars expr)
 348   = case sty of
 349       PprForUser -> pprExpr sty expr
 350       _ -> ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
 351                 4 (pprExpr sty expr)
 352
 353 pprExpr sty (DictApp expr [dname])
 354   = case sty of
 355       PprForUser -> pprExpr sty expr
 356       _ -> ppHang (ppBeside pp_note (pprExpr sty expr)) 4 (ppr sty dname)
 357   where
 358     pp_note = ifPprShowAll sty (ppStr "{-DictApp-} ")
 359
 360 pprExpr sty (DictApp expr dnames)
 361   = case sty of
 362       PprForUser -> pprExpr sty expr
 363       _ -> ppHang (ppBeside pp_note (pprExpr sty expr))
 364                 4 (ppBesides [ppLbrack, interpp'SP sty dnames, ppRbrack])
 365   where
 366     pp_note = ifPprShowAll sty (ppStr "{-DictApp-} ")
 367
 368 pprExpr sty (ClassDictLam dicts methods expr)
 369   = case sty of
 370       PprForUser -> pprExpr sty expr
 371       _ -> ppHang (ppCat [ppStr "\\{-classdict-}",
 372                    ppBesides [ppLbrack, interppSP sty dicts,   ppRbrack],
 373                    ppBesides [ppLbrack, interppSP sty methods, ppRbrack],
 374                    ppStr "->"])
 375                 4 (pprExpr sty expr)
 376
 377 pprExpr sty (Dictionary dictNames methods)
 378  = ppSep [ppBesides [ppLparen, ppStr "{-dict-}"],
 379           ppBesides [ppLbrack, interpp'SP sty dictNames, ppRbrack],
 380           ppBesides [ppLbrack, interpp'SP sty methods,   ppRbrack, ppRparen]]
 381
 382 pprExpr sty (SingleDict dname)
 383  = ppCat [ppStr "{-singleDict-}", ppr sty dname]
 384 \end{code}
 385
 386 Parenthesize unless very simple:
 387 \begin{code}
 388 pprParendExpr :: (NamedThing bdee, Outputable bdee,
 389                      NamedThing pat, Outputable pat) =>
 390                     PprStyle -> Expr bdee pat -> Pretty
 391 pprParendExpr sty e@(Var _)             = pprExpr sty e
 392 pprParendExpr sty e@(Lit _)             = pprExpr sty e
 393 pprParendExpr sty other_e       = ppBesides [ppLparen, pprExpr sty other_e, ppRparen]
 394 \end{code}
 395
 396 %************************************************************************
 397 %*                                                                      *
 398 \subsection[AbsSyntax-enums-list-comps]{Enumerations and list comprehensions}
 399 %*                                                                      *
 400 %************************************************************************
 401
 402 \begin{code}
 403 data ArithSeqInfo  bdee pat
 404   = From            (Expr bdee pat)
 405   | FromThen        (Expr bdee pat) (Expr bdee pat)
 406   | FromTo          (Expr bdee pat) (Expr bdee pat)
 407   | FromThenTo      (Expr bdee pat) (Expr bdee pat) (Expr bdee pat)
 408
 409 type ProtoNameArithSeqInfo           = ArithSeqInfo ProtoName ProtoNamePat
 410 type RenamedArithSeqInfo = ArithSeqInfo Name RenamedPat
 411 type TypecheckedArithSeqInfo = ArithSeqInfo Id          TypecheckedPat
 412 \end{code}
 413
 414 \begin{code}
 415 instance (NamedThing bdee, Outputable bdee,
 416                   NamedThing pat, Outputable pat) =>
 417                 Outputable (ArithSeqInfo bdee pat) where
 418     ppr sty (From e1)           = ppBesides [ppr sty e1, ppStr " .. "]
 419     ppr sty (FromThen e1 e2)    = ppBesides [ppr sty e1, pp'SP, ppr sty e2, ppStr " .. "]
 420     ppr sty (FromTo e1 e3)      = ppBesides [ppr sty e1, ppStr " .. ", ppr sty e3]
 421     ppr sty (FromThenTo e1 e2 e3)
 422       = ppBesides [ppr sty e1, pp'SP, ppr sty e2, ppStr " .. ", ppr sty e3]
 423 \end{code}
 424
 425 ``Qualifiers'' in list comprehensions:
 426 \begin{code}
 427 data Qual bdee pat
 428   = GeneratorQual  pat (Expr bdee pat)
 429   | FilterQual     (Expr bdee pat)
 430
 431 type ProtoNameQual      = Qual ProtoName ProtoNamePat
 432 type RenamedQual        = Qual Name      RenamedPat
 433 type TypecheckedQual    = Qual Id        TypecheckedPat
 434 \end{code}
 435
 436 \begin{code}
 437 instance (NamedThing bdee, Outputable bdee,
 438             NamedThing pat, Outputable pat) =>
 439                 Outputable (Qual bdee pat) where
 440     ppr sty (GeneratorQual pat expr)
 441      = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
 442     ppr sty (FilterQual expr) = ppr sty expr
 443 \end{code}
 444
 445 %************************************************************************
 446 %*                                                                      *
 447 \subsection[AbsSyntax-parallel-quals]{Parallel Qualifiers for ZF expressions}
 448 %*                                                                      *
 449 %************************************************************************
 450
 451 \begin{code}
 452 #ifdef DPH
 453 data ParQuals var pat
 454   = AndParQuals     (ParQuals var pat)
 455                     (ParQuals var pat)
 456   | DrawnGenIn      [pat]
 457                     pat
 458                     (Expr var pat)      -- (|pat1,...,patN;pat|)<<-exp
 459
 460   | DrawnGenOut     [pat]               -- Same information as processor
 461                     [(Expr var pat)]    -- Conversion fn of type t -> Integer
 462                     pat                 -- to keep things together :-)
 463                     (Expr var pat)
 464   | IndexGen        [(Expr var pat)]
 465                     pat
 466                     (Expr var pat)      -- (|exp1,...,expN;pat|)<<-exp
 467   | ParFilter       (Expr var pat)
 468
 469 type ProtoNameParQuals          = ParQuals ProtoName ProtoNamePat
 470 type RenamedParQuals            = ParQuals Name RenamedPat
 471 type TypecheckedParQuals        = ParQuals Id        TypecheckedPat
 472
 473 instance (NamedThing bdee, Outputable bdee,
 474             NamedThing pat, Outputable pat) =>
 475                 Outputable (ParQuals bdee pat) where
 476     ppr sty (AndParQuals quals1 quals2)
 477      = ppBesides [ppr sty quals1, pp'SP, ppr sty quals2]
 478     ppr sty (DrawnGenIn pats pat expr)
 479      = ppCat [ppStr "(|",
 480               ppInterleave ppComma (map (ppr sty) pats),
 481               ppSemi, ppr sty pat,ppStr "|)",
 482               ppStr "<<-", ppr sty expr]
 483
 484     ppr sty (DrawnGenOut pats convs pat expr)
 485      = case sty of
 486           PprForUser -> basic_ppr
 487           _          -> ppHang basic_ppr 4 exprs_ppr
 488      where
 489         basic_ppr = ppCat [ppStr "(|",
 490                            ppInterleave ppComma (map (ppr sty) pats),
 491                            ppSemi, ppr sty pat,ppStr "|)",
 492                            ppStr "<<-", ppr sty expr]
 493
 494         exprs_ppr = ppBesides [ppStr "{- " ,
 495                                ppr sty convs,
 496                                ppStr " -}"]
 497
 498     ppr sty (IndexGen exprs pat expr)
 499      = ppCat [ppStr "(|",
 500               ppInterleave ppComma (map (pprExpr sty) exprs),
 501               ppSemi, ppr sty pat, ppStr "|)",
 502               ppStr "<<=", ppr sty expr]
 503
 504     ppr sty (ParFilter expr) = ppr sty expr
 505 #endif {-Data Parallel Haskell -}
 506 \end{code}