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 ( isOpLexeme, pprOp )
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
70 | HsCase (HsExpr tyvar uvar id pat)
71 [Match tyvar uvar id pat] -- must have at least one Match
74 | HsIf (HsExpr tyvar uvar id pat) -- predicate
75 (HsExpr tyvar uvar id pat) -- then part
76 (HsExpr tyvar uvar id pat) -- else part
79 | HsLet (HsBinds tyvar uvar id pat) -- let(rec)
80 (HsExpr tyvar uvar id pat)
82 | HsDo [Stmt tyvar uvar id pat] -- "do":one or more stmts
85 | HsDoOut [Stmt tyvar uvar id pat] -- "do":one or more stmts
86 id id -- Monad and MonadZero dicts
89 | ListComp (HsExpr tyvar uvar id pat) -- list comprehension
90 [Qual tyvar uvar id pat] -- at least one Qual(ifier)
92 | ExplicitList -- syntactic list
93 [HsExpr tyvar uvar id pat]
94 | ExplicitListOut -- TRANSLATION
95 (GenType tyvar uvar) -- Gives type of components of list
96 [HsExpr tyvar uvar id pat]
98 | ExplicitTuple -- tuple
99 [HsExpr tyvar uvar id pat]
100 -- NB: Unit is ExplicitTuple []
101 -- for tuples, we can get the types
102 -- direct from the components
104 -- Record construction
105 | RecordCon (HsExpr tyvar uvar id pat) -- Always (HsVar id) until type checker,
106 -- but the latter adds its type args too
107 (HsRecordBinds tyvar uvar id pat)
110 | RecordUpd (HsExpr tyvar uvar id pat)
111 (HsRecordBinds tyvar uvar id pat)
113 | RecordUpdOut (HsExpr tyvar uvar id pat) -- TRANSLATION
114 [id] -- Dicts needed for construction
115 (HsRecordBinds tyvar uvar id pat)
117 | ExprWithTySig -- signature binding
118 (HsExpr tyvar uvar id pat)
120 | ArithSeqIn -- arithmetic sequence
121 (ArithSeqInfo tyvar uvar id pat)
123 (HsExpr tyvar uvar id pat) -- (typechecked, of course)
124 (ArithSeqInfo tyvar uvar id pat)
126 | CCall FAST_STRING -- call into the C world; string is
127 [HsExpr tyvar uvar id pat] -- the C function; exprs are the
128 -- arguments to pass.
129 Bool -- True <=> might cause Haskell
130 -- garbage-collection (must generate
131 -- more paranoid code)
132 Bool -- True <=> it's really a "casm"
133 -- NOTE: this CCall is the *boxed*
134 -- version; the desugarer will convert
135 -- it into the unboxed "ccall#".
136 (GenType tyvar uvar) -- The result type; will be *bottom*
137 -- until the typechecker gets ahold of it
139 | HsSCC FAST_STRING -- "set cost centre" (_scc_) annotation
140 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
143 Everything from here on appears only in typechecker output.
146 | TyLam -- TRANSLATION
148 (HsExpr tyvar uvar id pat)
149 | TyApp -- TRANSLATION
150 (HsExpr tyvar uvar id pat) -- generated by Spec
153 -- DictLam and DictApp are "inverses"
156 (HsExpr tyvar uvar id pat)
158 (HsExpr tyvar uvar id pat)
161 -- ClassDictLam and Dictionary are "inverses" (see note below)
163 [id] -- superclass dicts
165 (HsExpr tyvar uvar id pat)
167 [id] -- superclass dicts
170 | SingleDict -- a simple special case of Dictionary
171 id -- local dictionary name
173 | HsCon -- TRANSLATION; a constructor application
174 Id -- used only in the RHS of constructor definitions
176 [HsExpr tyvar uvar id pat]
178 type HsRecordBinds tyvar uvar id pat
179 = [(id, HsExpr tyvar uvar id pat, Bool)]
180 -- True <=> source code used "punning",
181 -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
184 A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
185 @ClassDictLam dictvars methods expr@ is, therefore:
187 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
191 instance (NamedThing id, Outputable id, Outputable pat,
192 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
193 Outputable (HsExpr tyvar uvar id pat) where
198 pprExpr sty (HsVar v)
199 = (if (isOpLexeme v) then ppParens else id) (ppr sty v)
201 pprExpr sty (HsLit lit) = ppr sty lit
202 pprExpr sty (HsLitOut lit _) = ppr sty lit
204 pprExpr sty (HsLam match)
205 = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
207 pprExpr sty expr@(HsApp e1 e2)
208 = let (fun, args) = collect_args expr [] in
209 ppHang (pprParendExpr sty fun) 4 (ppSep (map (pprParendExpr sty) args))
211 collect_args (HsApp fun arg) args = collect_args fun (arg:args)
212 collect_args fun args = (fun, args)
215 pprExpr sty (OpApp e1 op e2)
217 HsVar v -> pp_infixly v
220 pp_e1 = pprParendExpr sty e1
221 pp_e2 = pprParendExpr sty e2
224 = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
227 = ppSep [pp_e1, ppCat [pprOp sty v, pp_e2]]
229 pprExpr sty (NegApp e)
230 = ppBeside (ppChar '-') (ppParens (pprExpr sty e))
232 pprExpr sty (HsPar e)
233 = ppParens (pprExpr sty e)
236 pprExpr sty (SectionL expr op)
238 HsVar v -> pp_infixly v
241 pp_expr = pprParendExpr sty expr
243 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
244 4 (ppCat [pp_expr, ppStr "_x )"])
246 = ppSep [ ppBeside ppLparen pp_expr,
247 ppBeside (pprOp sty v) ppRparen ]
249 pprExpr sty (SectionR op expr)
251 HsVar v -> pp_infixly v
254 pp_expr = pprParendExpr sty expr
256 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppPStr SLIT("_x")])
257 4 (ppBeside pp_expr ppRparen)
259 = ppSep [ ppBeside ppLparen (pprOp sty v),
260 ppBeside pp_expr ppRparen ]
262 pprExpr sty (CCall fun args _ is_asm result_ty)
264 then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
265 else ppBeside (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
266 4 (ppSep (map (pprParendExpr sty) args))
268 pprExpr sty (HsSCC label expr)
269 = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
270 pprParendExpr sty expr ]
272 pprExpr sty (HsCase expr matches _)
273 = ppSep [ ppSep [ppPStr SLIT("case"), ppNest 4 (pprExpr sty expr), ppPStr SLIT("of")],
274 ppNest 2 (pprMatches sty (True, ppNil) matches) ]
276 pprExpr sty (ListComp expr quals)
277 = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
278 4 (ppSep [interpp'SP sty quals, ppRbrack])
280 -- special case: let ... in let ...
281 pprExpr sty (HsLet binds expr@(HsLet _ _))
282 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
285 pprExpr sty (HsLet binds expr)
286 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
287 ppHang (ppPStr SLIT("in")) 2 (ppr sty expr)]
289 pprExpr sty (HsDo stmts _)
290 = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
292 pprExpr sty (HsIf e1 e2 e3 _)
293 = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
294 ppNest 4 (pprExpr sty e2),
296 ppNest 4 (pprExpr sty e3)]
298 pprExpr sty (ExplicitList exprs)
299 = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
300 pprExpr sty (ExplicitListOut ty exprs)
301 = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
302 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
304 pprExpr sty (ExplicitTuple exprs)
305 = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
306 pprExpr sty (ExprWithTySig expr sig)
307 = ppHang (ppBesides [ppLparen, ppNest 2 (pprExpr sty expr), ppPStr SLIT(" ::")])
308 4 (ppBeside (ppr sty sig) ppRparen)
310 pprExpr sty (RecordCon con rbinds)
311 = pp_rbinds sty (ppr sty con) rbinds
313 pprExpr sty (RecordUpd aexp rbinds)
314 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
316 pprExpr sty (ArithSeqIn info)
317 = ppBracket (ppr sty info)
318 pprExpr sty (ArithSeqOut expr info)
321 ppBracket (ppr sty info)
323 ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
325 pprExpr sty (TyLam tyvars expr)
326 = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
329 pprExpr sty (TyApp expr [ty])
330 = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
332 pprExpr sty (TyApp expr tys)
333 = ppHang (pprExpr sty expr)
334 4 (ppBracket (interpp'SP sty tys))
336 pprExpr sty (DictLam dictvars expr)
337 = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
340 pprExpr sty (DictApp expr [dname])
341 = ppHang (pprExpr sty expr) 4 (ppr sty dname)
343 pprExpr sty (DictApp expr dnames)
344 = ppHang (pprExpr sty expr)
345 4 (ppBracket (interpp'SP sty dnames))
347 pprExpr sty (ClassDictLam dicts methods expr)
348 = ppHang (ppCat [ppStr "\\{-classdict-}",
349 ppBracket (interppSP sty dicts),
350 ppBracket (interppSP sty methods),
354 pprExpr sty (Dictionary dicts methods)
355 = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
356 ppBracket (interpp'SP sty dicts),
357 ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
359 pprExpr sty (SingleDict dname)
360 = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
363 Parenthesize unless very simple:
365 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
366 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
367 => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
369 pprParendExpr sty expr
371 pp_as_was = pprExpr sty expr
375 HsLitOut l _ -> ppr sty l
377 ExplicitList _ -> pp_as_was
378 ExplicitListOut _ _ -> pp_as_was
379 ExplicitTuple _ -> pp_as_was
380 _ -> ppParens pp_as_was
383 %************************************************************************
385 \subsection{Record binds}
387 %************************************************************************
390 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
391 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
392 => PprStyle -> Pretty
393 -> HsRecordBinds tyvar uvar id pat -> Pretty
395 pp_rbinds sty thing rbinds
397 (ppBesides [ppChar '{', ppInterleave ppComma (map (pp_rbind sty) rbinds), ppChar '}'])
399 pp_rbind sty (v, _, True{-pun-}) = ppr sty v
400 pp_rbind sty (v, e, _) = ppCat [ppr sty v, ppStr "<-", ppr sty e]
403 %************************************************************************
405 \subsection{Do stmts}
407 %************************************************************************
410 data Stmt tyvar uvar id pat
412 (HsExpr tyvar uvar id pat)
414 | ExprStmt (HsExpr tyvar uvar id pat)
416 | LetStmt (HsBinds tyvar uvar id pat)
420 instance (NamedThing id, Outputable id, Outputable pat,
421 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
422 Outputable (Stmt tyvar uvar id pat) where
423 ppr sty (BindStmt pat expr _)
424 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
425 ppr sty (LetStmt binds)
426 = ppCat [ppPStr SLIT("let"), ppr sty binds]
427 ppr sty (ExprStmt expr _)
431 %************************************************************************
433 \subsection{Enumerations and list comprehensions}
435 %************************************************************************
438 data ArithSeqInfo tyvar uvar id pat
439 = From (HsExpr tyvar uvar id pat)
440 | FromThen (HsExpr tyvar uvar id pat)
441 (HsExpr tyvar uvar id pat)
442 | FromTo (HsExpr tyvar uvar id pat)
443 (HsExpr tyvar uvar id pat)
444 | FromThenTo (HsExpr tyvar uvar id pat)
445 (HsExpr tyvar uvar id pat)
446 (HsExpr tyvar uvar id pat)
450 instance (NamedThing id, Outputable id, Outputable pat,
451 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
452 Outputable (ArithSeqInfo tyvar uvar id pat) where
453 ppr sty (From e1) = ppBesides [ppr sty e1, pp_dotdot]
454 ppr sty (FromThen e1 e2) = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
455 ppr sty (FromTo e1 e3) = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
456 ppr sty (FromThenTo e1 e2 e3)
457 = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
459 pp_dotdot = ppPStr SLIT(" .. ")
462 ``Qualifiers'' in list comprehensions:
464 data Qual tyvar uvar id pat
466 (HsExpr tyvar uvar id pat)
467 | LetQual (HsBinds tyvar uvar id pat)
468 | FilterQual (HsExpr tyvar uvar id pat)
472 instance (NamedThing id, Outputable id, Outputable pat,
473 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
474 Outputable (Qual tyvar uvar id pat) where
475 ppr sty (GeneratorQual pat expr)
476 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
477 ppr sty (LetQual binds)
478 = ppCat [ppPStr SLIT("let"), ppr sty binds]
479 ppr sty (FilterQual expr)