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:
49 -- NB Bracketed ops such as (+) come out as Vars.
51 -- NB We need an expr for the operator in an OpApp/Section since
52 -- the typechecker may need to apply the operator to a few types.
54 | OpApp (HsExpr tyvar uvar id pat) -- left operand
55 (HsExpr tyvar uvar id pat) -- operator
56 (HsExpr tyvar uvar id pat) -- right operand
58 -- We preserve prefix negation and parenthesis for the precedence parser.
60 | NegApp (HsExpr tyvar uvar id pat) -- negated expr
61 | HsPar (HsExpr tyvar uvar id pat) -- parenthesised expr
63 | SectionL (HsExpr tyvar uvar id pat) -- operand
64 (HsExpr tyvar uvar id pat) -- operator
65 | SectionR (HsExpr tyvar uvar id pat) -- operator
66 (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 | ExprWithTySig -- signature binding
113 (HsExpr tyvar uvar id pat)
115 | ArithSeqIn -- arithmetic sequence
116 (ArithSeqInfo tyvar uvar id pat)
118 (HsExpr tyvar uvar id pat) -- (typechecked, of course)
119 (ArithSeqInfo tyvar uvar id pat)
121 | CCall FAST_STRING -- call into the C world; string is
122 [HsExpr tyvar uvar id pat] -- the C function; exprs are the
123 -- arguments to pass.
124 Bool -- True <=> might cause Haskell
125 -- garbage-collection (must generate
126 -- more paranoid code)
127 Bool -- True <=> it's really a "casm"
128 -- NOTE: this CCall is the *boxed*
129 -- version; the desugarer will convert
130 -- it into the unboxed "ccall#".
131 (GenType tyvar uvar) -- The result type; will be *bottom*
132 -- until the typechecker gets ahold of it
134 | HsSCC FAST_STRING -- "set cost centre" (_scc_) annotation
135 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
138 Everything from here on appears only in typechecker output.
141 | TyLam -- TRANSLATION
143 (HsExpr tyvar uvar id pat)
144 | TyApp -- TRANSLATION
145 (HsExpr tyvar uvar id pat) -- generated by Spec
148 -- DictLam and DictApp are "inverses"
151 (HsExpr tyvar uvar id pat)
153 (HsExpr tyvar uvar id pat)
156 -- ClassDictLam and Dictionary are "inverses" (see note below)
158 [id] -- superclass dicts
160 (HsExpr tyvar uvar id pat)
162 [id] -- superclass dicts
165 | SingleDict -- a simple special case of Dictionary
166 id -- local dictionary name
168 type HsRecordBinds tyvar uvar id pat
169 = [(id, HsExpr tyvar uvar id pat, Bool)]
170 -- True <=> source code used "punning",
171 -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
174 A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
175 @ClassDictLam dictvars methods expr@ is, therefore:
177 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
181 instance (NamedThing id, Outputable id, Outputable pat,
182 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
183 Outputable (HsExpr tyvar uvar id pat) where
188 pprExpr sty (HsVar v)
189 = (if (isOpLexeme v) then ppParens else id) (ppr sty v)
191 pprExpr sty (HsLit lit) = ppr sty lit
192 pprExpr sty (HsLitOut lit _) = ppr sty lit
194 pprExpr sty (HsLam match)
195 = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
197 pprExpr sty expr@(HsApp e1 e2)
198 = let (fun, args) = collect_args expr [] in
199 ppHang (pprParendExpr sty fun) 4 (ppSep (map (pprParendExpr sty) args))
201 collect_args (HsApp fun arg) args = collect_args fun (arg:args)
202 collect_args fun args = (fun, args)
205 pprExpr sty (OpApp e1 op e2)
207 HsVar v -> pp_infixly v
210 pp_e1 = pprParendExpr sty e1
211 pp_e2 = pprParendExpr sty e2
214 = ppHang (pprParendExpr sty op) 4 (ppSep [pp_e1, pp_e2])
217 = ppSep [pp_e1, ppCat [pprOp sty v, pp_e2]]
219 pprExpr sty (NegApp e)
220 = ppBeside (ppChar '-') (ppParens (pprExpr sty e))
222 pprExpr sty (HsPar e)
223 = ppParens (pprExpr sty e)
226 pprExpr sty (SectionL expr op)
228 HsVar v -> pp_infixly v
231 pp_expr = pprParendExpr sty expr
233 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
234 4 (ppCat [pp_expr, ppStr "_x )"])
236 = ppSep [ ppBeside ppLparen pp_expr,
237 ppBeside (pprOp sty v) ppRparen ]
239 pprExpr sty (SectionR op expr)
241 HsVar v -> pp_infixly v
244 pp_expr = pprParendExpr sty expr
246 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppPStr SLIT("_x")])
247 4 (ppBeside pp_expr ppRparen)
249 = ppSep [ ppBeside ppLparen (pprOp sty v),
250 ppBeside pp_expr ppRparen ]
252 pprExpr sty (CCall fun args _ is_asm result_ty)
254 then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
255 else ppBeside (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
256 4 (ppSep (map (pprParendExpr sty) args))
258 pprExpr sty (HsSCC label expr)
259 = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
260 pprParendExpr sty expr ]
262 pprExpr sty (HsCase expr matches _)
263 = ppSep [ ppSep [ppPStr SLIT("case"), ppNest 4 (pprExpr sty expr), ppPStr SLIT("of")],
264 ppNest 2 (pprMatches sty (True, ppNil) matches) ]
266 pprExpr sty (ListComp expr quals)
267 = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
268 4 (ppSep [interpp'SP sty quals, ppRbrack])
270 -- special case: let ... in let ...
271 pprExpr sty (HsLet binds expr@(HsLet _ _))
272 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
275 pprExpr sty (HsLet binds expr)
276 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
277 ppHang (ppPStr SLIT("in")) 2 (ppr sty expr)]
279 pprExpr sty (HsDo stmts _)
280 = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
282 pprExpr sty (HsIf e1 e2 e3 _)
283 = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
284 ppNest 4 (pprExpr sty e2),
286 ppNest 4 (pprExpr sty e3)]
288 pprExpr sty (ExplicitList exprs)
289 = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
290 pprExpr sty (ExplicitListOut ty exprs)
291 = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
292 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
294 pprExpr sty (ExplicitTuple exprs)
295 = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
296 pprExpr sty (ExprWithTySig expr sig)
297 = ppHang (ppBesides [ppLparen, ppNest 2 (pprExpr sty expr), ppPStr SLIT(" ::")])
298 4 (ppBeside (ppr sty sig) ppRparen)
300 pprExpr sty (RecordCon con rbinds)
301 = pp_rbinds sty (ppr sty con) rbinds
303 pprExpr sty (RecordUpd aexp rbinds)
304 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
306 pprExpr sty (ArithSeqIn info)
307 = ppBracket (ppr sty info)
308 pprExpr sty (ArithSeqOut expr info)
311 ppBracket (ppr sty info)
313 ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
315 pprExpr sty (TyLam tyvars expr)
316 = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
319 pprExpr sty (TyApp expr [ty])
320 = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
322 pprExpr sty (TyApp expr tys)
323 = ppHang (pprExpr sty expr)
324 4 (ppBracket (interpp'SP sty tys))
326 pprExpr sty (DictLam dictvars expr)
327 = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
330 pprExpr sty (DictApp expr [dname])
331 = ppHang (pprExpr sty expr) 4 (ppr sty dname)
333 pprExpr sty (DictApp expr dnames)
334 = ppHang (pprExpr sty expr)
335 4 (ppBracket (interpp'SP sty dnames))
337 pprExpr sty (ClassDictLam dicts methods expr)
338 = ppHang (ppCat [ppStr "\\{-classdict-}",
339 ppBracket (interppSP sty dicts),
340 ppBracket (interppSP sty methods),
344 pprExpr sty (Dictionary dicts methods)
345 = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
346 ppBracket (interpp'SP sty dicts),
347 ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
349 pprExpr sty (SingleDict dname)
350 = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
353 Parenthesize unless very simple:
355 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
356 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
357 => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
359 pprParendExpr sty expr
361 pp_as_was = pprExpr sty expr
365 HsLitOut l _ -> ppr sty l
367 ExplicitList _ -> pp_as_was
368 ExplicitListOut _ _ -> pp_as_was
369 ExplicitTuple _ -> pp_as_was
370 _ -> ppParens pp_as_was
373 %************************************************************************
375 \subsection{Record binds}
377 %************************************************************************
380 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
381 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
382 => PprStyle -> Pretty
383 -> HsRecordBinds tyvar uvar id pat -> Pretty
385 pp_rbinds sty thing rbinds
387 (ppBesides [ppChar '{', ppInterleave ppComma (map (pp_rbind sty) rbinds), ppChar '}'])
389 pp_rbind sty (v, _, True{-pun-}) = ppr sty v
390 pp_rbind sty (v, e, _) = ppCat [ppr sty v, ppStr "<-", ppr sty e]
393 %************************************************************************
395 \subsection{Do stmts}
397 %************************************************************************
400 data Stmt tyvar uvar id pat
402 (HsExpr tyvar uvar id pat)
404 | ExprStmt (HsExpr tyvar uvar id pat)
406 | LetStmt (HsBinds tyvar uvar id pat)
410 instance (NamedThing id, Outputable id, Outputable pat,
411 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
412 Outputable (Stmt tyvar uvar id pat) where
413 ppr sty (BindStmt pat expr _)
414 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
415 ppr sty (LetStmt binds)
416 = ppCat [ppPStr SLIT("let"), ppr sty binds]
417 ppr sty (ExprStmt expr _)
421 %************************************************************************
423 \subsection{Enumerations and list comprehensions}
425 %************************************************************************
428 data ArithSeqInfo tyvar uvar id pat
429 = From (HsExpr tyvar uvar id pat)
430 | FromThen (HsExpr tyvar uvar id pat)
431 (HsExpr tyvar uvar id pat)
432 | FromTo (HsExpr tyvar uvar id pat)
433 (HsExpr tyvar uvar id pat)
434 | FromThenTo (HsExpr tyvar uvar id pat)
435 (HsExpr tyvar uvar id pat)
436 (HsExpr tyvar uvar id pat)
440 instance (NamedThing id, Outputable id, Outputable pat,
441 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
442 Outputable (ArithSeqInfo tyvar uvar id pat) where
443 ppr sty (From e1) = ppBesides [ppr sty e1, pp_dotdot]
444 ppr sty (FromThen e1 e2) = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
445 ppr sty (FromTo e1 e3) = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
446 ppr sty (FromThenTo e1 e2 e3)
447 = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
449 pp_dotdot = ppPStr SLIT(" .. ")
452 ``Qualifiers'' in list comprehensions:
454 data Qual tyvar uvar id pat
456 (HsExpr tyvar uvar id pat)
457 | LetQual (HsBinds tyvar uvar id pat)
458 | FilterQual (HsExpr tyvar uvar id pat)
462 instance (NamedThing id, Outputable id, Outputable pat,
463 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
464 Outputable (Qual tyvar uvar id pat) where
465 ppr sty (GeneratorQual pat expr)
466 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
467 ppr sty (LetQual binds)
468 = ppCat [ppPStr SLIT("let"), ppr sty binds]
469 ppr sty (FilterQual expr)