2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
4 \section[HsExpr]{Abstract Haskell syntax: expressions}
7 #include "HsVersions.h"
12 import HsLoop -- for paranoia checking
15 import HsBinds ( HsBinds )
16 import HsLit ( HsLit )
17 import HsMatches ( pprMatches, pprMatch, Match )
18 import HsTypes ( PolyType )
21 import Id ( DictVar(..), GenId, Id(..) )
23 import PprType ( pprType, pprParendType, GenType{-instance-}, GenTyVar{-instance-} )
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-} )
33 %************************************************************************
35 \subsection{Expressions proper}
37 %************************************************************************
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)
46 | HsLam (Match tyvar uvar id pat) -- lambda
47 | HsApp (HsExpr tyvar uvar id pat) -- application
48 (HsExpr tyvar uvar id pat)
50 -- Operator applications and sections.
51 -- NB Bracketed ops such as (+) come out as Vars.
53 | OpApp (HsExpr tyvar uvar id pat) -- left operand
54 (HsExpr tyvar uvar id pat) -- operator
55 (HsExpr tyvar uvar id pat) -- right operand
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.
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
68 | HsCase (HsExpr tyvar uvar id pat)
69 [Match tyvar uvar id pat] -- must have at least one Match
72 | HsIf (HsExpr tyvar uvar id pat) -- predicate
73 (HsExpr tyvar uvar id pat) -- then part
74 (HsExpr tyvar uvar id pat) -- else part
77 | HsLet (HsBinds tyvar uvar id pat) -- let(rec)
78 (HsExpr tyvar uvar id pat)
80 | HsDo [Stmt tyvar uvar id pat] -- "do":one or more stmts
83 | HsDoOut [Stmt tyvar uvar id pat] -- "do":one or more stmts
84 id id -- Monad and MonadZero dicts
87 | ListComp (HsExpr tyvar uvar id pat) -- list comprehension
88 [Qual tyvar uvar id pat] -- at least one Qual(ifier)
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]
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
102 | RecordCon id -- record construction
103 [(id, Maybe (HsExpr tyvar uvar id pat))]
105 | RecordUpd (HsExpr tyvar uvar id pat) -- record update
106 [(id, Maybe (HsExpr tyvar uvar id pat))]
108 | ExprWithTySig -- signature binding
109 (HsExpr tyvar uvar id pat)
111 | ArithSeqIn -- arithmetic sequence
112 (ArithSeqInfo tyvar uvar id pat)
114 (HsExpr tyvar uvar id pat) -- (typechecked, of course)
115 (ArithSeqInfo tyvar uvar id pat)
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
130 | HsSCC FAST_STRING -- "set cost centre" (_scc_) annotation
131 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
134 Everything from here on appears only in typechecker output.
137 | TyLam -- TRANSLATION
139 (HsExpr tyvar uvar id pat)
140 | TyApp -- TRANSLATION
141 (HsExpr tyvar uvar id pat) -- generated by Spec
144 -- DictLam and DictApp are "inverses"
147 (HsExpr tyvar uvar id pat)
149 (HsExpr tyvar uvar id pat)
152 -- ClassDictLam and Dictionary are "inverses" (see note below)
154 [id] -- superclass dicts
156 (HsExpr tyvar uvar id pat)
158 [id] -- superclass dicts
161 | SingleDict -- a simple special case of Dictionary
162 id -- local dictionary name
165 A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
166 @ClassDictLam dictvars methods expr@ is, therefore:
168 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
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
179 pprExpr sty (HsVar v)
180 = (if (isOpLexeme v) then ppParens else id) (ppr sty v)
182 pprExpr sty (HsLit lit) = ppr sty lit
183 pprExpr sty (HsLitOut lit _) = ppr sty lit
185 pprExpr sty (HsLam match)
186 = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
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))
192 collect_args (HsApp fun arg) args = collect_args fun (arg:args)
193 collect_args fun args = (fun, args)
195 pprExpr sty (OpApp e1 op e2)
197 HsVar v -> pp_infixly v
200 pp_e1 = pprParendExpr sty e1
201 pp_e2 = pprParendExpr sty e2
204 = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
207 = ppSep [pp_e1, ppCat [pprOp sty v, pp_e2]]
209 pprExpr sty (SectionL expr op)
211 HsVar v -> pp_infixly v
214 pp_expr = pprParendExpr sty expr
216 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
217 4 (ppCat [pp_expr, ppStr "_x )"])
219 = ppSep [ ppBeside ppLparen pp_expr,
220 ppBeside (pprOp sty v) ppRparen ]
222 pprExpr sty (SectionR op expr)
224 HsVar v -> pp_infixly v
227 pp_expr = pprParendExpr sty expr
229 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppPStr SLIT("_x")])
230 4 (ppBeside pp_expr ppRparen)
232 = ppSep [ ppBeside ppLparen (pprOp sty v),
233 ppBeside pp_expr ppRparen ]
235 pprExpr sty (CCall fun args _ is_asm result_ty)
237 then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
238 else ppBeside (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
239 4 (ppSep (map (pprParendExpr sty) args))
241 pprExpr sty (HsSCC label expr)
242 = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
243 pprParendExpr sty expr ]
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) ]
249 pprExpr sty (ListComp expr quals)
250 = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
251 4 (ppSep [interpp'SP sty quals, ppRbrack])
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")]),
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)]
262 pprExpr sty (HsDo stmts _)
263 = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
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),
269 ppNest 4 (pprExpr sty e3)]
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))) ]
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)
283 pprExpr sty (RecordCon con rbinds)
284 = pp_rbinds sty (ppr sty con) rbinds
286 pprExpr sty (RecordUpd aexp rbinds)
287 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
289 pprExpr sty (ArithSeqIn info)
290 = ppBracket (ppr sty info)
291 pprExpr sty (ArithSeqOut expr info)
294 ppBracket (ppr sty info)
296 ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
298 pprExpr sty (TyLam tyvars expr)
299 = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
302 pprExpr sty (TyApp expr [ty])
303 = ppHang (pprExpr sty expr) 4 (pprParendType sty ty)
305 pprExpr sty (TyApp expr tys)
306 = ppHang (pprExpr sty expr)
307 4 (ppBracket (interpp'SP sty tys))
309 pprExpr sty (DictLam dictvars expr)
310 = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
313 pprExpr sty (DictApp expr [dname])
314 = ppHang (pprExpr sty expr) 4 (ppr sty dname)
316 pprExpr sty (DictApp expr dnames)
317 = ppHang (pprExpr sty expr)
318 4 (ppBracket (interpp'SP sty dnames))
320 pprExpr sty (ClassDictLam dicts methods expr)
321 = ppHang (ppCat [ppStr "\\{-classdict-}",
322 ppBracket (interppSP sty dicts),
323 ppBracket (interppSP sty methods),
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]]
332 pprExpr sty (SingleDict dname)
333 = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
336 Parenthesize unless very simple:
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
342 pprParendExpr sty expr
344 pp_as_was = pprExpr sty expr
348 HsLitOut l _ -> ppr sty l
350 ExplicitList _ -> pp_as_was
351 ExplicitListOut _ _ -> pp_as_was
352 ExplicitTuple _ -> pp_as_was
353 _ -> ppParens pp_as_was
356 %************************************************************************
358 \subsection{Record binds}
360 %************************************************************************
363 pp_rbinds sty thing rbinds
365 (ppBesides [ppChar '{', ppInterleave ppComma (map (pp_rbind sty) rbinds), ppChar '}'])
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
371 pp_rbind sty (v, Nothing) = ppr sty v
372 pp_rbind sty (v, Just e) = ppCat [ppr sty v, ppStr "<-", ppr sty e]
375 %************************************************************************
377 \subsection{Do stmts}
379 %************************************************************************
382 data Stmt tyvar uvar id pat
384 (HsExpr tyvar uvar id pat)
386 | ExprStmt (HsExpr tyvar uvar id pat)
388 | LetStmt (HsBinds tyvar uvar id pat)
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 _)
403 %************************************************************************
405 \subsection{Enumerations and list comprehensions}
407 %************************************************************************
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)
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]
431 pp_dotdot = ppPStr SLIT(" .. ")
434 ``Qualifiers'' in list comprehensions:
436 data Qual tyvar uvar id pat
438 (HsExpr tyvar uvar id pat)
439 | LetQual (HsBinds tyvar uvar id pat)
440 | FilterQual (HsExpr tyvar uvar id pat)
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)