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(..) )
22 import Name ( isSymLexeme, pprSym )
23 import Outputable ( interppSP, interpp'SP, ifnotPprForUser )
24 import PprType ( pprGenType, pprParendGenType, GenType{-instance-} )
26 import PprStyle ( PprStyle(..) )
27 import SrcLoc ( SrcLoc )
28 import Usage ( GenUsage{-instance-} )
29 import Util ( panic{-ToDo:rm eventually-} )
32 %************************************************************************
34 \subsection{Expressions proper}
36 %************************************************************************
39 data HsExpr tyvar uvar id pat
40 = HsVar id -- variable
41 | HsLit HsLit -- literal
42 | HsLitOut HsLit -- TRANSLATION
43 (GenType tyvar uvar) -- (with its type)
45 | HsLam (Match tyvar uvar id pat) -- lambda
46 | HsApp (HsExpr tyvar uvar id pat) -- application
47 (HsExpr tyvar uvar id pat)
49 -- Operator applications:
50 -- NB Bracketed ops such as (+) come out as Vars.
52 -- NB We need an expr for the operator in an OpApp/Section since
53 -- the typechecker may need to apply the operator to a few types.
55 | OpApp (HsExpr tyvar uvar id pat) -- left operand
56 (HsExpr tyvar uvar id pat) -- operator
57 (HsExpr tyvar uvar id pat) -- right operand
59 -- We preserve prefix negation and parenthesis for the precedence parser.
61 | NegApp (HsExpr tyvar uvar id pat) -- negated expr
62 | HsPar (HsExpr tyvar uvar id pat) -- parenthesised expr
64 | SectionL (HsExpr tyvar uvar id pat) -- operand
65 (HsExpr tyvar uvar id pat) -- operator
66 | SectionR (HsExpr tyvar uvar id pat) -- operator
67 (HsExpr tyvar uvar id pat) -- operand
69 | HsCase (HsExpr tyvar uvar id pat)
70 [Match tyvar uvar id pat] -- must have at least one Match
73 | HsIf (HsExpr tyvar uvar id pat) -- predicate
74 (HsExpr tyvar uvar id pat) -- then part
75 (HsExpr tyvar uvar id pat) -- else part
78 | HsLet (HsBinds tyvar uvar id pat) -- let(rec)
79 (HsExpr tyvar uvar id pat)
81 | HsDo [Stmt tyvar uvar id pat] -- "do":one or more stmts
84 | HsDoOut [Stmt tyvar uvar id pat] -- "do":one or more stmts
85 id id -- Monad and MonadZero dicts
88 | ListComp (HsExpr tyvar uvar id pat) -- list comprehension
89 [Qual tyvar uvar id pat] -- at least one Qual(ifier)
91 | ExplicitList -- syntactic list
92 [HsExpr tyvar uvar id pat]
93 | ExplicitListOut -- TRANSLATION
94 (GenType tyvar uvar) -- Gives type of components of list
95 [HsExpr tyvar uvar id pat]
97 | ExplicitTuple -- tuple
98 [HsExpr tyvar uvar id pat]
99 -- NB: Unit is ExplicitTuple []
100 -- for tuples, we can get the types
101 -- direct from the components
103 -- Record construction
104 | RecordCon (HsExpr tyvar uvar id pat) -- Always (HsVar id) until type checker,
105 -- but the latter adds its type args too
106 (HsRecordBinds tyvar uvar id pat)
109 | RecordUpd (HsExpr tyvar uvar id pat)
110 (HsRecordBinds tyvar uvar id pat)
112 | RecordUpdOut (HsExpr tyvar uvar id pat) -- TRANSLATION
113 [id] -- Dicts needed for construction
114 (HsRecordBinds tyvar uvar id pat)
116 | ExprWithTySig -- signature binding
117 (HsExpr tyvar uvar id pat)
119 | ArithSeqIn -- arithmetic sequence
120 (ArithSeqInfo tyvar uvar id pat)
122 (HsExpr tyvar uvar id pat) -- (typechecked, of course)
123 (ArithSeqInfo tyvar uvar id pat)
125 | CCall FAST_STRING -- call into the C world; string is
126 [HsExpr tyvar uvar id pat] -- the C function; exprs are the
127 -- arguments to pass.
128 Bool -- True <=> might cause Haskell
129 -- garbage-collection (must generate
130 -- more paranoid code)
131 Bool -- True <=> it's really a "casm"
132 -- NOTE: this CCall is the *boxed*
133 -- version; the desugarer will convert
134 -- it into the unboxed "ccall#".
135 (GenType tyvar uvar) -- The result type; will be *bottom*
136 -- until the typechecker gets ahold of it
138 | HsSCC FAST_STRING -- "set cost centre" (_scc_) annotation
139 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
142 Everything from here on appears only in typechecker output.
145 | TyLam -- TRANSLATION
147 (HsExpr tyvar uvar id pat)
148 | TyApp -- TRANSLATION
149 (HsExpr tyvar uvar id pat) -- generated by Spec
152 -- DictLam and DictApp are "inverses"
155 (HsExpr tyvar uvar id pat)
157 (HsExpr tyvar uvar id pat)
160 -- ClassDictLam and Dictionary are "inverses" (see note below)
162 [id] -- superclass dicts
164 (HsExpr tyvar uvar id pat)
166 [id] -- superclass dicts
169 | SingleDict -- a simple special case of Dictionary
170 id -- local dictionary name
172 | HsCon -- TRANSLATION; a constructor application
173 Id -- used only in the RHS of constructor definitions
175 [HsExpr tyvar uvar id pat]
177 type HsRecordBinds tyvar uvar id pat
178 = [(id, HsExpr tyvar uvar id pat, Bool)]
179 -- True <=> source code used "punning",
180 -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
183 A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
184 @ClassDictLam dictvars methods expr@ is, therefore:
186 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
190 instance (NamedThing id, Outputable id, Outputable pat,
191 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
192 Outputable (HsExpr tyvar uvar id pat) where
197 pprExpr sty (HsVar v)
198 = (if (isSymLexeme v) then ppParens else id) (ppr sty v)
200 pprExpr sty (HsLit lit) = ppr sty lit
201 pprExpr sty (HsLitOut lit _) = ppr sty lit
203 pprExpr sty (HsLam match)
204 = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
206 pprExpr sty expr@(HsApp e1 e2)
207 = let (fun, args) = collect_args expr [] in
208 ppHang (pprParendExpr sty fun) 4 (ppSep (map (pprParendExpr sty) args))
210 collect_args (HsApp fun arg) args = collect_args fun (arg:args)
211 collect_args fun args = (fun, args)
213 pprExpr sty (OpApp e1 op e2)
215 HsVar v -> pp_infixly v
218 pp_e1 = pprParendExpr sty e1
219 pp_e2 = pprParendExpr sty e2
222 = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
225 = ppSep [pp_e1, ppCat [pprSym sty v, pp_e2]]
227 pprExpr sty (NegApp e)
228 = ppBeside (ppChar '-') (pprParendExpr sty e)
230 pprExpr sty (HsPar e)
231 = ppParens (pprExpr sty e)
233 pprExpr sty (SectionL expr op)
235 HsVar v -> pp_infixly v
238 pp_expr = pprParendExpr sty expr
240 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
241 4 (ppCat [pp_expr, ppStr "_x )"])
243 = ppSep [ ppBeside ppLparen pp_expr,
244 ppBeside (pprSym sty v) ppRparen ]
246 pprExpr sty (SectionR op expr)
248 HsVar v -> pp_infixly v
251 pp_expr = pprParendExpr sty expr
253 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppPStr SLIT("_x")])
254 4 (ppBeside pp_expr ppRparen)
256 = ppSep [ ppBeside ppLparen (pprSym sty v),
257 ppBeside pp_expr ppRparen ]
259 pprExpr sty (HsCase expr matches _)
260 = ppSep [ ppSep [ppPStr SLIT("case"), ppNest 4 (pprExpr sty expr), ppPStr SLIT("of")],
261 ppNest 2 (pprMatches sty (True, ppNil) matches) ]
263 pprExpr sty (HsIf e1 e2 e3 _)
264 = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
265 ppNest 4 (pprExpr sty e2),
267 ppNest 4 (pprExpr sty e3)]
269 -- special case: let ... in let ...
270 pprExpr sty (HsLet binds expr@(HsLet _ _))
271 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
274 pprExpr sty (HsLet binds expr)
275 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
276 ppHang (ppPStr SLIT("in")) 2 (ppr sty expr)]
278 pprExpr sty (HsDo stmts _)
279 = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
280 pprExpr sty (HsDoOut stmts _ _ _)
281 = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
283 pprExpr sty (ListComp expr quals)
284 = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
285 4 (ppSep [interpp'SP sty quals, ppRbrack])
287 pprExpr sty (ExplicitList exprs)
288 = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
289 pprExpr sty (ExplicitListOut ty exprs)
290 = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
291 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
293 pprExpr sty (ExplicitTuple exprs)
294 = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
296 pprExpr sty (RecordCon con rbinds)
297 = pp_rbinds sty (ppr sty con) rbinds
299 pprExpr sty (RecordUpd aexp rbinds)
300 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
301 pprExpr sty (RecordUpdOut aexp _ rbinds)
302 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
304 pprExpr sty (ExprWithTySig expr sig)
305 = ppHang (ppBesides [ppLparen, ppNest 2 (pprExpr sty expr), ppPStr SLIT(" ::")])
306 4 (ppBeside (ppr sty sig) ppRparen)
308 pprExpr sty (ArithSeqIn info)
309 = ppBracket (ppr sty info)
310 pprExpr sty (ArithSeqOut expr info)
313 ppBracket (ppr sty info)
315 ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
317 pprExpr sty (CCall fun args _ is_asm result_ty)
319 then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
320 else ppBeside (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
321 4 (ppSep (map (pprParendExpr sty) args))
323 pprExpr sty (HsSCC label expr)
324 = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
325 pprParendExpr sty expr ]
327 pprExpr sty (TyLam tyvars expr)
328 = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
331 pprExpr sty (TyApp expr [ty])
332 = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
334 pprExpr sty (TyApp expr tys)
335 = ppHang (pprExpr sty expr)
336 4 (ppBracket (interpp'SP sty tys))
338 pprExpr sty (DictLam dictvars expr)
339 = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
342 pprExpr sty (DictApp expr [dname])
343 = ppHang (pprExpr sty expr) 4 (ppr sty dname)
345 pprExpr sty (DictApp expr dnames)
346 = ppHang (pprExpr sty expr)
347 4 (ppBracket (interpp'SP sty dnames))
349 pprExpr sty (ClassDictLam dicts methods expr)
350 = ppHang (ppCat [ppStr "\\{-classdict-}",
351 ppBracket (interppSP sty dicts),
352 ppBracket (interppSP sty methods),
356 pprExpr sty (Dictionary dicts methods)
357 = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
358 ppBracket (interpp'SP sty dicts),
359 ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
361 pprExpr sty (SingleDict dname)
362 = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
364 pprExpr sty (HsCon con tys exprs)
365 = ppCat [ppPStr SLIT("{-HsCon-}"), ppr sty con, interppSP sty tys, interppSP sty exprs]
368 Parenthesize unless very simple:
370 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
371 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
372 => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
374 pprParendExpr sty expr
376 pp_as_was = pprExpr sty expr
380 HsLitOut l _ -> ppr sty l
382 ExplicitList _ -> pp_as_was
383 ExplicitListOut _ _ -> pp_as_was
384 ExplicitTuple _ -> pp_as_was
385 _ -> ppParens pp_as_was
388 %************************************************************************
390 \subsection{Record binds}
392 %************************************************************************
395 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
396 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
397 => PprStyle -> Pretty
398 -> HsRecordBinds tyvar uvar id pat -> Pretty
400 pp_rbinds sty thing rbinds
402 (ppBesides [ppChar '{', ppInterleave ppComma (map (pp_rbind sty) rbinds), ppChar '}'])
404 pp_rbind sty (v, _, True{-pun-}) = ppr sty v
405 pp_rbind sty (v, e, _) = ppCat [ppr sty v, ppStr "<-", ppr sty e]
408 %************************************************************************
410 \subsection{Do stmts}
412 %************************************************************************
415 data Stmt tyvar uvar id pat
417 (HsExpr tyvar uvar id pat)
419 | ExprStmt (HsExpr tyvar uvar id pat)
421 | LetStmt (HsBinds tyvar uvar id pat)
425 instance (NamedThing id, Outputable id, Outputable pat,
426 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
427 Outputable (Stmt tyvar uvar id pat) where
428 ppr sty (BindStmt pat expr _)
429 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
430 ppr sty (LetStmt binds)
431 = ppCat [ppPStr SLIT("let"), ppr sty binds]
432 ppr sty (ExprStmt expr _)
436 %************************************************************************
438 \subsection{Enumerations and list comprehensions}
440 %************************************************************************
443 data ArithSeqInfo tyvar uvar id pat
444 = From (HsExpr tyvar uvar id pat)
445 | FromThen (HsExpr tyvar uvar id pat)
446 (HsExpr tyvar uvar id pat)
447 | FromTo (HsExpr tyvar uvar id pat)
448 (HsExpr tyvar uvar id pat)
449 | FromThenTo (HsExpr tyvar uvar id pat)
450 (HsExpr tyvar uvar id pat)
451 (HsExpr tyvar uvar id pat)
455 instance (NamedThing id, Outputable id, Outputable pat,
456 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
457 Outputable (ArithSeqInfo tyvar uvar id pat) where
458 ppr sty (From e1) = ppBesides [ppr sty e1, pp_dotdot]
459 ppr sty (FromThen e1 e2) = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
460 ppr sty (FromTo e1 e3) = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
461 ppr sty (FromThenTo e1 e2 e3)
462 = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
464 pp_dotdot = ppPStr SLIT(" .. ")
467 ``Qualifiers'' in list comprehensions:
469 data Qual tyvar uvar id pat
471 (HsExpr tyvar uvar id pat)
472 | LetQual (HsBinds tyvar uvar id pat)
473 | FilterQual (HsExpr tyvar uvar id pat)
477 instance (NamedThing id, Outputable id, Outputable pat,
478 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
479 Outputable (Qual tyvar uvar id pat) where
480 ppr sty (GeneratorQual pat expr)
481 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
482 ppr sty (LetQual binds)
483 = ppCat [ppPStr SLIT("let"), ppr sty binds]
484 ppr sty (FilterQual expr)