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 ( pprGenType, pprParendGenType, GenType{-instance-} )
25 import PprStyle ( PprStyle(..) )
26 import SrcLoc ( SrcLoc )
27 import Usage ( GenUsage{-instance-} )
28 import Util ( panic{-ToDo:rm eventually-} )
31 %************************************************************************
33 \subsection{Expressions proper}
35 %************************************************************************
38 data HsExpr tyvar uvar id pat
39 = HsVar id -- variable
40 | HsLit HsLit -- literal
41 | HsLitOut HsLit -- TRANSLATION
42 (GenType tyvar uvar) -- (with its type)
44 | HsLam (Match tyvar uvar id pat) -- lambda
45 | HsApp (HsExpr tyvar uvar id pat) -- application
46 (HsExpr tyvar uvar id pat)
48 -- Operator applications and sections.
49 -- NB Bracketed ops such as (+) come out as Vars.
51 | OpApp (HsExpr tyvar uvar id pat) -- left operand
52 (HsExpr tyvar uvar id pat) -- operator
53 (HsExpr tyvar uvar id pat) -- right operand
55 -- ADR Question? Why is the "op" in a section an expr when it will
56 -- have to be of the form (HsVar op) anyway?
57 -- WDP Answer: But when the typechecker gets ahold of it, it may
58 -- apply the var to a few types; it will then be an expression.
60 | SectionL (HsExpr tyvar uvar id pat) -- operand
61 (HsExpr tyvar uvar id pat) -- operator
62 | SectionR (HsExpr tyvar uvar id pat) -- operator
63 (HsExpr tyvar uvar id pat) -- operand
66 | HsCase (HsExpr tyvar uvar id pat)
67 [Match tyvar uvar id pat] -- must have at least one Match
70 | HsIf (HsExpr tyvar uvar id pat) -- predicate
71 (HsExpr tyvar uvar id pat) -- then part
72 (HsExpr tyvar uvar id pat) -- else part
75 | HsLet (HsBinds tyvar uvar id pat) -- let(rec)
76 (HsExpr tyvar uvar id pat)
78 | HsDo [Stmt tyvar uvar id pat] -- "do":one or more stmts
81 | HsDoOut [Stmt tyvar uvar id pat] -- "do":one or more stmts
82 id id -- Monad and MonadZero dicts
85 | ListComp (HsExpr tyvar uvar id pat) -- list comprehension
86 [Qual tyvar uvar id pat] -- at least one Qual(ifier)
88 | ExplicitList -- syntactic list
89 [HsExpr tyvar uvar id pat]
90 | ExplicitListOut -- TRANSLATION
91 (GenType tyvar uvar) -- Gives type of components of list
92 [HsExpr tyvar uvar id pat]
94 | ExplicitTuple -- tuple
95 [HsExpr tyvar uvar id pat]
96 -- NB: Unit is ExplicitTuple []
97 -- for tuples, we can get the types
98 -- direct from the components
100 -- Record construction
101 | RecordCon (HsExpr tyvar uvar id pat) -- Always (HsVar id) until type checker,
102 -- but the latter adds its type args too
103 (HsRecordBinds tyvar uvar id pat)
106 | RecordUpd (HsExpr tyvar uvar id pat)
107 (HsRecordBinds tyvar uvar id pat)
109 | ExprWithTySig -- signature binding
110 (HsExpr tyvar uvar id pat)
112 | ArithSeqIn -- arithmetic sequence
113 (ArithSeqInfo tyvar uvar id pat)
115 (HsExpr tyvar uvar id pat) -- (typechecked, of course)
116 (ArithSeqInfo tyvar uvar id pat)
118 | CCall FAST_STRING -- call into the C world; string is
119 [HsExpr tyvar uvar id pat] -- the C function; exprs are the
120 -- arguments to pass.
121 Bool -- True <=> might cause Haskell
122 -- garbage-collection (must generate
123 -- more paranoid code)
124 Bool -- True <=> it's really a "casm"
125 -- NOTE: this CCall is the *boxed*
126 -- version; the desugarer will convert
127 -- it into the unboxed "ccall#".
128 (GenType tyvar uvar) -- The result type; will be *bottom*
129 -- until the typechecker gets ahold of it
131 | HsSCC FAST_STRING -- "set cost centre" (_scc_) annotation
132 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
135 Everything from here on appears only in typechecker output.
138 | TyLam -- TRANSLATION
140 (HsExpr tyvar uvar id pat)
141 | TyApp -- TRANSLATION
142 (HsExpr tyvar uvar id pat) -- generated by Spec
145 -- DictLam and DictApp are "inverses"
148 (HsExpr tyvar uvar id pat)
150 (HsExpr tyvar uvar id pat)
153 -- ClassDictLam and Dictionary are "inverses" (see note below)
155 [id] -- superclass dicts
157 (HsExpr tyvar uvar id pat)
159 [id] -- superclass dicts
162 | SingleDict -- a simple special case of Dictionary
163 id -- local dictionary name
165 type HsRecordBinds tyvar uvar id pat
166 = [(id, HsExpr tyvar uvar id pat, Bool)]
167 -- True <=> source code used "punning",
168 -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
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 id, Outputable id, Outputable pat,
179 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
180 Outputable (HsExpr tyvar uvar id pat) where
185 pprExpr sty (HsVar v)
186 = (if (isOpLexeme v) then ppParens else id) (ppr sty v)
188 pprExpr sty (HsLit lit) = ppr sty lit
189 pprExpr sty (HsLitOut lit _) = ppr sty lit
191 pprExpr sty (HsLam match)
192 = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
194 pprExpr sty expr@(HsApp e1 e2)
195 = let (fun, args) = collect_args expr [] in
196 ppHang (pprParendExpr sty fun) 4 (ppSep (map (pprParendExpr sty) args))
198 collect_args (HsApp fun arg) args = collect_args fun (arg:args)
199 collect_args fun args = (fun, args)
201 pprExpr sty (OpApp e1 op e2)
203 HsVar v -> pp_infixly v
206 pp_e1 = pprParendExpr sty e1
207 pp_e2 = pprParendExpr sty e2
210 = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
213 = ppSep [pp_e1, ppCat [pprOp sty v, pp_e2]]
215 pprExpr sty (SectionL expr op)
217 HsVar v -> pp_infixly v
220 pp_expr = pprParendExpr sty expr
222 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
223 4 (ppCat [pp_expr, ppStr "_x )"])
225 = ppSep [ ppBeside ppLparen pp_expr,
226 ppBeside (pprOp sty v) ppRparen ]
228 pprExpr sty (SectionR op expr)
230 HsVar v -> pp_infixly v
233 pp_expr = pprParendExpr sty expr
235 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppPStr SLIT("_x")])
236 4 (ppBeside pp_expr ppRparen)
238 = ppSep [ ppBeside ppLparen (pprOp sty v),
239 ppBeside pp_expr ppRparen ]
241 pprExpr sty (CCall fun args _ is_asm result_ty)
243 then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
244 else ppBeside (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
245 4 (ppSep (map (pprParendExpr sty) args))
247 pprExpr sty (HsSCC label expr)
248 = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
249 pprParendExpr sty expr ]
251 pprExpr sty (HsCase expr matches _)
252 = ppSep [ ppSep [ppPStr SLIT("case"), ppNest 4 (pprExpr sty expr), ppPStr SLIT("of")],
253 ppNest 2 (pprMatches sty (True, ppNil) matches) ]
255 pprExpr sty (ListComp expr quals)
256 = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
257 4 (ppSep [interpp'SP sty quals, ppRbrack])
259 -- special case: let ... in let ...
260 pprExpr sty (HsLet binds expr@(HsLet _ _))
261 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
264 pprExpr sty (HsLet binds expr)
265 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
266 ppHang (ppPStr SLIT("in")) 2 (ppr sty expr)]
268 pprExpr sty (HsDo stmts _)
269 = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
271 pprExpr sty (HsIf e1 e2 e3 _)
272 = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
273 ppNest 4 (pprExpr sty e2),
275 ppNest 4 (pprExpr sty e3)]
277 pprExpr sty (ExplicitList exprs)
278 = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
279 pprExpr sty (ExplicitListOut ty exprs)
280 = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
281 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
283 pprExpr sty (ExplicitTuple exprs)
284 = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
285 pprExpr sty (ExprWithTySig expr sig)
286 = ppHang (ppBesides [ppLparen, ppNest 2 (pprExpr sty expr), ppPStr SLIT(" ::")])
287 4 (ppBeside (ppr sty sig) ppRparen)
289 pprExpr sty (RecordCon con rbinds)
290 = pp_rbinds sty (ppr sty con) rbinds
292 pprExpr sty (RecordUpd aexp rbinds)
293 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
295 pprExpr sty (ArithSeqIn info)
296 = ppBracket (ppr sty info)
297 pprExpr sty (ArithSeqOut expr info)
300 ppBracket (ppr sty info)
302 ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
304 pprExpr sty (TyLam tyvars expr)
305 = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
308 pprExpr sty (TyApp expr [ty])
309 = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
311 pprExpr sty (TyApp expr tys)
312 = ppHang (pprExpr sty expr)
313 4 (ppBracket (interpp'SP sty tys))
315 pprExpr sty (DictLam dictvars expr)
316 = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
319 pprExpr sty (DictApp expr [dname])
320 = ppHang (pprExpr sty expr) 4 (ppr sty dname)
322 pprExpr sty (DictApp expr dnames)
323 = ppHang (pprExpr sty expr)
324 4 (ppBracket (interpp'SP sty dnames))
326 pprExpr sty (ClassDictLam dicts methods expr)
327 = ppHang (ppCat [ppStr "\\{-classdict-}",
328 ppBracket (interppSP sty dicts),
329 ppBracket (interppSP sty methods),
333 pprExpr sty (Dictionary dicts methods)
334 = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
335 ppBracket (interpp'SP sty dicts),
336 ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
338 pprExpr sty (SingleDict dname)
339 = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
342 Parenthesize unless very simple:
344 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
345 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
346 => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
348 pprParendExpr sty expr
350 pp_as_was = pprExpr sty expr
354 HsLitOut l _ -> ppr sty l
356 ExplicitList _ -> pp_as_was
357 ExplicitListOut _ _ -> pp_as_was
358 ExplicitTuple _ -> pp_as_was
359 _ -> ppParens pp_as_was
362 %************************************************************************
364 \subsection{Record binds}
366 %************************************************************************
369 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
370 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
371 => PprStyle -> Pretty
372 -> HsRecordBinds tyvar uvar id pat -> Pretty
374 pp_rbinds sty thing rbinds
376 (ppBesides [ppChar '{', ppInterleave ppComma (map (pp_rbind sty) rbinds), ppChar '}'])
378 pp_rbind sty (v, _, True{-pun-}) = ppr sty v
379 pp_rbind sty (v, e, _) = ppCat [ppr sty v, ppStr "<-", ppr sty e]
382 %************************************************************************
384 \subsection{Do stmts}
386 %************************************************************************
389 data Stmt tyvar uvar id pat
391 (HsExpr tyvar uvar id pat)
393 | ExprStmt (HsExpr tyvar uvar id pat)
395 | LetStmt (HsBinds tyvar uvar id pat)
399 instance (NamedThing id, Outputable id, Outputable pat,
400 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
401 Outputable (Stmt tyvar uvar id pat) where
402 ppr sty (BindStmt pat expr _)
403 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
404 ppr sty (LetStmt binds)
405 = ppCat [ppPStr SLIT("let"), ppr sty binds]
406 ppr sty (ExprStmt expr _)
410 %************************************************************************
412 \subsection{Enumerations and list comprehensions}
414 %************************************************************************
417 data ArithSeqInfo tyvar uvar id pat
418 = From (HsExpr tyvar uvar id pat)
419 | FromThen (HsExpr tyvar uvar id pat)
420 (HsExpr tyvar uvar id pat)
421 | FromTo (HsExpr tyvar uvar id pat)
422 (HsExpr tyvar uvar id pat)
423 | FromThenTo (HsExpr tyvar uvar id pat)
424 (HsExpr tyvar uvar id pat)
425 (HsExpr tyvar uvar id pat)
429 instance (NamedThing id, Outputable id, Outputable pat,
430 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
431 Outputable (ArithSeqInfo tyvar uvar id pat) where
432 ppr sty (From e1) = ppBesides [ppr sty e1, pp_dotdot]
433 ppr sty (FromThen e1 e2) = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
434 ppr sty (FromTo e1 e3) = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
435 ppr sty (FromThenTo e1 e2 e3)
436 = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
438 pp_dotdot = ppPStr SLIT(" .. ")
441 ``Qualifiers'' in list comprehensions:
443 data Qual tyvar uvar id pat
445 (HsExpr tyvar uvar id pat)
446 | LetQual (HsBinds tyvar uvar id pat)
447 | FilterQual (HsExpr tyvar uvar id pat)
451 instance (NamedThing id, Outputable id, Outputable pat,
452 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
453 Outputable (Qual tyvar uvar id pat) where
454 ppr sty (GeneratorQual pat expr)
455 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
456 ppr sty (LetQual binds)
457 = ppCat [ppPStr SLIT("let"), ppr sty binds]
458 ppr sty (FilterQual expr)