2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
4 \section[HsExpr]{Abstract Haskell syntax: expressions}
7 #include "HsVersions.h"
11 import AbsUniType ( pprUniType, pprParendUniType, TyVar, UniType
12 IF_ATTACK_PRAGMAS(COMMA cmpTyVar)
13 IF_ATTACK_PRAGMAS(COMMA cmpUniType)
16 import Unique ( Unique )
17 import HsBinds ( Binds )
18 import HsLit ( Literal )
19 import HsMatches ( pprMatches, pprMatch, Match )
20 import HsPat ( ProtoNamePat(..), RenamedPat(..),
22 IF_ATTACK_PRAGMAS(COMMA typeOfPat)
24 import HsTypes ( PolyType )
25 import Id ( Id, DictVar(..), DictFun(..) )
27 import ProtoName ( ProtoName(..) ) -- .. for pragmas only
32 %************************************************************************
34 \subsection[AbsSyn-Expr]{Expressions proper}
36 %************************************************************************
40 = Var bdee -- variable
41 | Lit Literal -- literal
43 | Lam (Match bdee pat) -- lambda
44 | App (Expr bdee pat) -- application
47 -- Operator applications and sections.
48 -- NB Bracketed ops such as (+) come out as Vars.
50 | OpApp (Expr bdee pat) (Expr bdee pat) (Expr bdee pat)
51 -- middle expr is the "op"
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.
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"
63 | CCall FAST_STRING -- call into the C world; string is
64 [Expr bdee pat] -- the C function; exprs are the
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
76 | SCC FAST_STRING -- set cost centre annotation
77 (Expr bdee pat) -- expr whose cost is to be measured
79 | Case (Expr bdee pat)
80 [Match bdee pat] -- must have at least one Match
83 (Expr bdee pat) -- predicate
84 (Expr bdee pat) -- then part
85 (Expr bdee pat) -- else part
87 | Let (Binds bdee pat) -- let(rec)
90 | ListComp (Expr bdee pat) -- list comprehension
91 [Qual bdee pat] -- at least one Qual(ifier)
93 | ExplicitList -- syntactic list
95 | ExplicitListOut -- TRANSLATION
96 UniType -- Unitype gives type of components of list
99 | ExplicitTuple -- tuple
101 -- NB: Unit is ExplicitTuple []
102 -- for tuples, we can get the types
103 -- direct from the components
105 | ExprWithTySig -- signature binding
108 | ArithSeqIn -- arithmetic sequence
109 (ArithSeqInfo bdee pat)
111 (Expr bdee pat) -- (typechecked, of course)
112 (ArithSeqInfo bdee pat)
120 UniType -- Unitype gives type of components of list
125 #endif {- Data Parallel Haskell -}
128 Everything from here on appears only in typechecker output; hence, the
131 | TyLam -- TRANSLATION
132 [TyVar] -- Not TyVarTemplate, which only occur in a
133 -- binding position in a forall type.
135 | TyApp -- TRANSLATION
136 (Expr bdee pat) -- generated by Spec
139 -- DictLam and DictApp are "inverses"
145 [DictVar] -- dictionary names
147 -- ClassDictLam and Dictionary are "inverses" (see note below)
151 -- The ordering here allows us to do away with dicts and methods
153 -- [I don't understand this comment. WDP. Perhaps a ptr to
154 -- a complete description of what's going on ? ]
157 [DictVar] -- superclass dictionary names
159 | SingleDict -- a simple special case of Dictionary
160 DictVar -- local dictionary name
164 type ProtoNameExpr = Expr ProtoName ProtoNamePat
166 type RenamedExpr = Expr Name RenamedPat
168 type TypecheckedExpr = Expr Id TypecheckedPat
171 A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
172 @ClassDictLam dictvars methods expr@ is, therefore:
174 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
178 instance (NamedThing bdee, Outputable bdee,
179 NamedThing pat, Outputable pat) =>
180 Outputable (Expr bdee pat) where
185 pprExpr :: (NamedThing bdee, Outputable bdee,
186 NamedThing pat, Outputable pat) =>
187 PprStyle -> Expr bdee pat -> Pretty
190 = if (isOpLexeme v) then
191 ppBesides [ppLparen, ppr sty v, ppRparen]
195 pprExpr sty (Lit lit) = ppr sty lit
196 pprExpr sty (Lam match)
197 = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
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))
203 collect_args (App fun arg) args = collect_args fun (arg:args)
204 collect_args fun args = (fun, args)
206 pprExpr sty (OpApp e1 op e2)
208 Var v -> pp_infixly v
211 pp_e1 = pprParendExpr sty e1
212 pp_e2 = pprParendExpr sty e2
215 = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
218 = ppSep [pp_e1, ppCat [pprOp sty v, pp_e2]]
220 pprExpr sty (SectionL expr op)
222 Var v -> pp_infixly v
225 pp_expr = pprParendExpr sty expr
227 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
228 4 (ppCat [pp_expr, ppStr "_x )"])
230 = ppSep [ ppBesides [ppLparen, pp_expr],
231 ppBesides [pprOp sty v, ppRparen] ]
233 pprExpr sty (SectionR op expr)
235 Var v -> pp_infixly v
238 pp_expr = pprParendExpr sty expr
240 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppStr "_x"])
241 4 (ppBesides [pp_expr, ppRparen])
243 = ppSep [ ppBesides [ppLparen, pprOp sty v],
244 ppBesides [pp_expr, ppRparen] ]
246 pprExpr sty (CCall fun args _ is_asm result_ty)
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)
254 pprExpr sty (SCC label expr)
255 = ppSep [ ppBesides [ppStr "scc", ppBesides [ppChar '"', ppPStr label, ppChar '"'] ],
256 pprParendExpr sty expr ]
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) ]
262 pprExpr sty (ListComp expr quals)
263 = ppHang (ppCat [ppStr "[", pprExpr sty expr, ppStr "|"])
264 4 (ppSep [interpp'SP sty quals, ppRbrack])
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"]),
271 pprExpr sty (Let binds expr)
272 = ppSep [ppHang (ppStr "let") 2 (ppr sty binds),
273 ppHang (ppStr "in") 2 (ppr sty expr)]
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,
281 _ -> ppBesides [ppStr " (", pprUniType sty ty, ppStr ")"] ]
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])
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),
293 ppNest 4 (pprExpr sty e3)]
294 pprExpr sty (ArithSeqIn info)
295 = ppCat [ppLbrack, ppr sty info, ppRbrack]
296 pprExpr sty (ArithSeqOut expr info)
299 ppBesides [ppLbrack, ppr sty info, ppRbrack]
301 ppBesides [ppLbrack, ppLparen, ppr sty expr, ppRparen, ppr sty info, ppRbrack]
303 pprExpr sty (ParallelZF expr pquals)
304 = ppHang (ppCat [ppStr "<<" , pprExpr sty expr , ppStr "|"])
305 4 (ppSep [ppr sty pquals, ppStr ">>"])
307 pprExpr sty (ExplicitPodIn exprs)
308 = ppBesides [ppStr "<<", ppInterleave ppComma (map (pprExpr sty) exprs) ,
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 ")"]
317 pprExpr sty (ExplicitProcessor exprs expr)
318 = ppBesides [ppStr "(|", ppInterleave ppComma (map (pprExpr sty) exprs) ,
319 ppSemi , pprExpr sty expr, ppStr "|)"]
321 #endif {- Data Parallel Haskell -}
323 -- for these translation-introduced things, we don't show them
324 -- if style is PprForUser
326 pprExpr sty (TyLam tyvars expr)
328 PprForUser -> pprExpr sty expr
329 _ -> ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
332 pprExpr sty (TyApp expr [ty])
334 PprForUser -> pprExpr sty expr
335 _ -> ppHang (ppBeside pp_note (pprExpr sty expr)) 4 (pprParendUniType sty ty)
337 pp_note = ifPprShowAll sty (ppStr "{-TyApp-} ")
339 pprExpr sty (TyApp expr tys)
341 PprForUser -> pprExpr sty expr
342 _ -> ppHang (ppBeside pp_note (pprExpr sty expr))
343 4 (ppBesides [ppLbrack, interpp'SP sty tys, ppRbrack])
345 pp_note = ifPprShowAll sty (ppStr "{-TyApp-} ")
347 pprExpr sty (DictLam dictvars expr)
349 PprForUser -> pprExpr sty expr
350 _ -> ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
353 pprExpr sty (DictApp expr [dname])
355 PprForUser -> pprExpr sty expr
356 _ -> ppHang (ppBeside pp_note (pprExpr sty expr)) 4 (ppr sty dname)
358 pp_note = ifPprShowAll sty (ppStr "{-DictApp-} ")
360 pprExpr sty (DictApp expr dnames)
362 PprForUser -> pprExpr sty expr
363 _ -> ppHang (ppBeside pp_note (pprExpr sty expr))
364 4 (ppBesides [ppLbrack, interpp'SP sty dnames, ppRbrack])
366 pp_note = ifPprShowAll sty (ppStr "{-DictApp-} ")
368 pprExpr sty (ClassDictLam dicts methods expr)
370 PprForUser -> pprExpr sty expr
371 _ -> ppHang (ppCat [ppStr "\\{-classdict-}",
372 ppBesides [ppLbrack, interppSP sty dicts, ppRbrack],
373 ppBesides [ppLbrack, interppSP sty methods, ppRbrack],
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]]
382 pprExpr sty (SingleDict dname)
383 = ppCat [ppStr "{-singleDict-}", ppr sty dname]
386 Parenthesize unless very simple:
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]
396 %************************************************************************
398 \subsection[AbsSyntax-enums-list-comps]{Enumerations and list comprehensions}
400 %************************************************************************
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)
409 type ProtoNameArithSeqInfo = ArithSeqInfo ProtoName ProtoNamePat
410 type RenamedArithSeqInfo = ArithSeqInfo Name RenamedPat
411 type TypecheckedArithSeqInfo = ArithSeqInfo Id TypecheckedPat
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]
425 ``Qualifiers'' in list comprehensions:
428 = GeneratorQual pat (Expr bdee pat)
429 | FilterQual (Expr bdee pat)
431 type ProtoNameQual = Qual ProtoName ProtoNamePat
432 type RenamedQual = Qual Name RenamedPat
433 type TypecheckedQual = Qual Id TypecheckedPat
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
445 %************************************************************************
447 \subsection[AbsSyntax-parallel-quals]{Parallel Qualifiers for ZF expressions}
449 %************************************************************************
453 data ParQuals var pat
454 = AndParQuals (ParQuals var pat)
458 (Expr var pat) -- (|pat1,...,patN;pat|)<<-exp
460 | DrawnGenOut [pat] -- Same information as processor
461 [(Expr var pat)] -- Conversion fn of type t -> Integer
462 pat -- to keep things together :-)
464 | IndexGen [(Expr var pat)]
466 (Expr var pat) -- (|exp1,...,expN;pat|)<<-exp
467 | ParFilter (Expr var pat)
469 type ProtoNameParQuals = ParQuals ProtoName ProtoNamePat
470 type RenamedParQuals = ParQuals Name RenamedPat
471 type TypecheckedParQuals = ParQuals Id TypecheckedPat
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)
480 ppInterleave ppComma (map (ppr sty) pats),
481 ppSemi, ppr sty pat,ppStr "|)",
482 ppStr "<<-", ppr sty expr]
484 ppr sty (DrawnGenOut pats convs pat expr)
486 PprForUser -> basic_ppr
487 _ -> ppHang basic_ppr 4 exprs_ppr
489 basic_ppr = ppCat [ppStr "(|",
490 ppInterleave ppComma (map (ppr sty) pats),
491 ppSemi, ppr sty pat,ppStr "|)",
492 ppStr "<<-", ppr sty expr]
494 exprs_ppr = ppBesides [ppStr "{- " ,
498 ppr sty (IndexGen exprs pat expr)
500 ppInterleave ppComma (map (pprExpr sty) exprs),
501 ppSemi, ppr sty pat, ppStr "|)",
502 ppStr "<<=", ppr sty expr]
504 ppr sty (ParFilter expr) = ppr sty expr
505 #endif {-Data Parallel Haskell -}