2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
4 \section[HsExpr]{Abstract Haskell syntax: expressions}
7 #include "HsVersions.h"
12 IMPORT_DELOOPER(HsLoop) -- for paranoia checking
15 import HsBinds ( HsBinds )
16 import HsLit ( HsLit )
17 import HsMatches ( pprMatches, pprMatch, Match )
18 import HsTypes ( HsType )
21 import Id ( SYN_IE(DictVar), GenId, SYN_IE(Id) )
22 import Name ( pprNonSym, 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.
60 -- They are eventually removed by the type checker.
62 | NegApp (HsExpr tyvar uvar id pat) -- negated expr
63 (HsExpr tyvar uvar id pat) -- the negate id (in a HsVar)
65 | HsPar (HsExpr tyvar uvar id pat) -- parenthesised expr
67 | SectionL (HsExpr tyvar uvar id pat) -- operand
68 (HsExpr tyvar uvar id pat) -- operator
69 | SectionR (HsExpr tyvar uvar id pat) -- operator
70 (HsExpr tyvar uvar id pat) -- operand
72 | HsCase (HsExpr tyvar uvar id pat)
73 [Match tyvar uvar id pat] -- must have at least one Match
76 | HsIf (HsExpr tyvar uvar id pat) -- predicate
77 (HsExpr tyvar uvar id pat) -- then part
78 (HsExpr tyvar uvar id pat) -- else part
81 | HsLet (HsBinds tyvar uvar id pat) -- let(rec)
82 (HsExpr tyvar uvar id pat)
84 | HsDo [Stmt tyvar uvar id pat] -- "do":one or more stmts
87 | HsDoOut [Stmt tyvar uvar id pat] -- "do":one or more stmts
88 id -- id for >>=, types applied
89 id -- id for zero, typed applied
92 | ListComp (HsExpr tyvar uvar id pat) -- list comprehension
93 [Qualifier tyvar uvar id pat] -- at least one Qualifier
95 | ExplicitList -- syntactic list
96 [HsExpr tyvar uvar id pat]
97 | ExplicitListOut -- TRANSLATION
98 (GenType tyvar uvar) -- Gives type of components of list
99 [HsExpr tyvar uvar id pat]
101 | ExplicitTuple -- tuple
102 [HsExpr tyvar uvar id pat]
103 -- NB: Unit is ExplicitTuple []
104 -- for tuples, we can get the types
105 -- direct from the components
107 -- Record construction
108 | RecordCon (HsExpr tyvar uvar id pat) -- Always (HsVar id) until type checker,
109 -- but the latter adds its type args too
110 (HsRecordBinds tyvar uvar id pat)
113 | RecordUpd (HsExpr tyvar uvar id pat)
114 (HsRecordBinds tyvar uvar id pat)
116 | RecordUpdOut (HsExpr tyvar uvar id pat) -- TRANSLATION
117 [id] -- Dicts needed for construction
118 (HsRecordBinds tyvar uvar id pat)
120 | ExprWithTySig -- signature binding
121 (HsExpr tyvar uvar id pat)
123 | ArithSeqIn -- arithmetic sequence
124 (ArithSeqInfo tyvar uvar id pat)
126 (HsExpr tyvar uvar id pat) -- (typechecked, of course)
127 (ArithSeqInfo tyvar uvar id pat)
129 | CCall FAST_STRING -- call into the C world; string is
130 [HsExpr tyvar uvar id pat] -- the C function; exprs are the
131 -- arguments to pass.
132 Bool -- True <=> might cause Haskell
133 -- garbage-collection (must generate
134 -- more paranoid code)
135 Bool -- True <=> it's really a "casm"
136 -- NOTE: this CCall is the *boxed*
137 -- version; the desugarer will convert
138 -- it into the unboxed "ccall#".
139 (GenType tyvar uvar) -- The result type; will be *bottom*
140 -- until the typechecker gets ahold of it
142 | HsSCC FAST_STRING -- "set cost centre" (_scc_) annotation
143 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
146 Everything from here on appears only in typechecker output.
149 | TyLam -- TRANSLATION
151 (HsExpr tyvar uvar id pat)
152 | TyApp -- TRANSLATION
153 (HsExpr tyvar uvar id pat) -- generated by Spec
156 -- DictLam and DictApp are "inverses"
159 (HsExpr tyvar uvar id pat)
161 (HsExpr tyvar uvar id pat)
164 -- ClassDictLam and Dictionary are "inverses" (see note below)
166 [id] -- superclass dicts
168 (HsExpr tyvar uvar id pat)
170 [id] -- superclass dicts
173 | SingleDict -- a simple special case of Dictionary
174 id -- local dictionary name
176 type HsRecordBinds tyvar uvar id pat
177 = [(id, HsExpr tyvar uvar id pat, Bool)]
178 -- True <=> source code used "punning",
179 -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
182 A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
183 @ClassDictLam dictvars methods expr@ is, therefore:
185 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
189 instance (NamedThing id, Outputable id, Outputable pat,
190 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
191 Outputable (HsExpr tyvar uvar id pat) where
196 pprExpr sty (HsVar v) = ppr sty v
198 pprExpr sty (HsLit lit) = ppr sty lit
199 pprExpr sty (HsLitOut lit _) = ppr sty lit
201 pprExpr sty (HsLam match)
202 = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
204 pprExpr sty expr@(HsApp e1 e2)
205 = let (fun, args) = collect_args expr [] in
206 ppHang (pprExpr sty fun) 4 (ppSep (map (pprExpr sty) args))
208 collect_args (HsApp fun arg) args = collect_args fun (arg:args)
209 collect_args fun args = (fun, args)
211 pprExpr sty (OpApp e1 op e2)
213 HsVar v -> pp_infixly v
216 pp_e1 = pprExpr sty e1
217 pp_e2 = pprExpr sty e2
220 = ppHang (pprExpr sty op) 4 (ppSep [pp_e1, pp_e2])
223 = ppSep [pp_e1, ppCat [ppr sty v, pp_e2]]
225 pprExpr sty (NegApp e _)
226 = ppBeside (ppChar '-') (pprParendExpr sty e)
228 pprExpr sty (HsPar e)
229 = ppParens (pprExpr sty e)
231 pprExpr sty (SectionL expr op)
233 HsVar v -> pp_infixly v
236 pp_expr = pprParendExpr sty expr
238 pp_prefixly = ppHang (ppCat [ppStr "( \\ x_ ->", ppr sty op])
239 4 (ppCat [pp_expr, ppStr "x_ )"])
241 = ppSep [ ppBeside ppLparen pp_expr,
242 ppBeside (ppr sty v) ppRparen ]
244 pprExpr sty (SectionR op expr)
246 HsVar v -> pp_infixly v
249 pp_expr = pprParendExpr sty expr
251 pp_prefixly = ppHang (ppCat [ppStr "( \\ x_ ->", ppr sty op, ppPStr SLIT("x_")])
252 4 (ppBeside pp_expr ppRparen)
254 = ppSep [ ppBeside ppLparen (ppr sty v),
255 ppBeside pp_expr ppRparen ]
257 pprExpr sty (HsCase expr matches _)
258 = ppSep [ ppSep [ppPStr SLIT("case"), ppNest 4 (pprExpr sty expr), ppPStr SLIT("of")],
259 ppNest 2 (pprMatches sty (True, ppNil) matches) ]
261 pprExpr sty (HsIf e1 e2 e3 _)
262 = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
263 ppNest 4 (pprExpr sty e2),
265 ppNest 4 (pprExpr sty e3)]
267 -- special case: let ... in let ...
268 pprExpr sty (HsLet binds expr@(HsLet _ _))
269 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
272 pprExpr sty (HsLet binds expr)
273 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
274 ppHang (ppPStr SLIT("in")) 2 (ppr sty expr)]
276 pprExpr sty (HsDo stmts _)
277 = ppHang (ppPStr SLIT("do")) 2 (ppAboves (map (ppr sty) stmts))
278 pprExpr sty (HsDoOut stmts _ _ _)
279 = ppHang (ppPStr SLIT("do")) 2 (ppAboves (map (ppr sty) stmts))
281 pprExpr sty (ListComp expr quals)
282 = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
283 4 (ppSep [interpp'SP sty quals, ppRbrack])
285 pprExpr sty (ExplicitList exprs)
286 = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
287 pprExpr sty (ExplicitListOut ty exprs)
288 = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
289 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
291 pprExpr sty (ExplicitTuple exprs)
292 = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
294 pprExpr sty (RecordCon con rbinds)
295 = pp_rbinds sty (ppr sty con) rbinds
297 pprExpr sty (RecordUpd aexp rbinds)
298 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
299 pprExpr sty (RecordUpdOut aexp _ rbinds)
300 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
302 pprExpr sty (ExprWithTySig expr sig)
303 = ppHang (ppBeside (ppNest 2 (pprExpr sty expr)) (ppPStr SLIT(" ::")))
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 (CCall fun args _ is_asm result_ty)
317 then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
318 else ppBeside (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
319 4 (ppSep (map (pprParendExpr sty) args))
321 pprExpr sty (HsSCC label expr)
322 = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
323 pprParendExpr sty expr ]
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]
364 Parenthesize unless very simple:
366 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
367 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
368 => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
370 pprParendExpr sty expr
372 pp_as_was = pprExpr sty expr
376 HsLitOut l _ -> ppr sty l
378 ExplicitList _ -> pp_as_was
379 ExplicitListOut _ _ -> pp_as_was
380 ExplicitTuple _ -> pp_as_was
381 _ -> ppParens pp_as_was
384 %************************************************************************
386 \subsection{Record binds}
388 %************************************************************************
391 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
392 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
393 => PprStyle -> Pretty
394 -> HsRecordBinds tyvar uvar id pat -> Pretty
396 pp_rbinds sty thing rbinds
398 4 (ppCurlies (ppIntersperse pp'SP (map (pp_rbind sty) rbinds)))
400 pp_rbind PprForUser (v, _, True) = ppr PprForUser v
401 pp_rbind sty (v, e, _) = ppCat [ppr sty v, ppStr "=", ppr sty e]
404 %************************************************************************
406 \subsection{Do stmts}
408 %************************************************************************
411 data Stmt tyvar uvar id pat
413 (HsExpr tyvar uvar id pat)
415 | ExprStmt (HsExpr tyvar uvar id pat)
417 | LetStmt (HsBinds tyvar uvar id pat)
419 -- Translations; the types are the "a" and "b" types of the monad.
420 | BindStmtOut pat (HsExpr tyvar uvar id pat) SrcLoc (GenType tyvar uvar) (GenType tyvar uvar)
421 | ExprStmtOut (HsExpr tyvar uvar id pat) SrcLoc (GenType tyvar uvar) (GenType tyvar uvar)
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 _)
434 ppr sty (BindStmtOut pat expr _ _ _)
435 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
436 ppr sty (ExprStmtOut expr _ _ _)
440 %************************************************************************
442 \subsection{Enumerations and list comprehensions}
444 %************************************************************************
447 data ArithSeqInfo tyvar uvar id pat
448 = From (HsExpr tyvar uvar id pat)
449 | FromThen (HsExpr tyvar uvar id pat)
450 (HsExpr tyvar uvar id pat)
451 | FromTo (HsExpr tyvar uvar id pat)
452 (HsExpr tyvar uvar id pat)
453 | FromThenTo (HsExpr tyvar uvar id pat)
454 (HsExpr tyvar uvar id pat)
455 (HsExpr tyvar uvar id pat)
459 instance (NamedThing id, Outputable id, Outputable pat,
460 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
461 Outputable (ArithSeqInfo tyvar uvar id pat) where
462 ppr sty (From e1) = ppBesides [ppr sty e1, pp_dotdot]
463 ppr sty (FromThen e1 e2) = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
464 ppr sty (FromTo e1 e3) = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
465 ppr sty (FromThenTo e1 e2 e3)
466 = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
468 pp_dotdot = ppPStr SLIT(" .. ")
471 ``Qualifiers'' in list comprehensions:
473 data Qualifier tyvar uvar id pat
475 (HsExpr tyvar uvar id pat)
476 | LetQual (HsBinds tyvar uvar id pat)
477 | FilterQual (HsExpr tyvar uvar id pat)
481 instance (NamedThing id, Outputable id, Outputable pat,
482 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
483 Outputable (Qualifier tyvar uvar id pat) where
484 ppr sty (GeneratorQual pat expr)
485 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
486 ppr sty (LetQual binds)
487 = ppCat [ppPStr SLIT("let"), ppr sty binds]
488 ppr sty (FilterQual expr)