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 ( PolyType )
21 import Id ( DictVar(..), GenId, 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 [Qual tyvar uvar id pat] -- at least one Qual(ifier)
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 | HsCon -- TRANSLATION; a constructor application
177 Id -- used only in the RHS of constructor definitions
179 [HsExpr tyvar uvar id pat]
181 type HsRecordBinds tyvar uvar id pat
182 = [(id, HsExpr tyvar uvar id pat, Bool)]
183 -- True <=> source code used "punning",
184 -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
187 A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
188 @ClassDictLam dictvars methods expr@ is, therefore:
190 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
194 instance (NamedThing id, Outputable id, Outputable pat,
195 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
196 Outputable (HsExpr tyvar uvar id pat) where
201 pprExpr sty (HsVar v) = pprNonSym sty v
203 pprExpr sty (HsLit lit) = ppr sty lit
204 pprExpr sty (HsLitOut lit _) = ppr sty lit
206 pprExpr sty (HsLam match)
207 = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
209 pprExpr sty expr@(HsApp e1 e2)
210 = let (fun, args) = collect_args expr [] in
211 ppHang (pprExpr sty fun) 4 (ppSep (map (pprExpr sty) args))
213 collect_args (HsApp fun arg) args = collect_args fun (arg:args)
214 collect_args fun args = (fun, args)
216 pprExpr sty (OpApp e1 op e2)
218 HsVar v -> pp_infixly v
221 pp_e1 = pprExpr sty e1
222 pp_e2 = pprExpr sty e2
225 = ppHang (pprExpr sty op) 4 (ppSep [pp_e1, pp_e2])
228 = ppSep [pp_e1, ppCat [pprSym sty v, pp_e2]]
230 pprExpr sty (NegApp e _)
231 = ppBeside (ppChar '-') (pprParendExpr sty e)
233 pprExpr sty (HsPar e)
234 = 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 (pprSym 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 (pprSym sty v),
260 ppBeside pp_expr ppRparen ]
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 (HsIf e1 e2 e3 _)
267 = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
268 ppNest 4 (pprExpr sty e2),
270 ppNest 4 (pprExpr sty e3)]
272 -- special case: let ... in let ...
273 pprExpr sty (HsLet binds expr@(HsLet _ _))
274 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
277 pprExpr sty (HsLet binds expr)
278 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
279 ppHang (ppPStr SLIT("in")) 2 (ppr sty expr)]
281 pprExpr sty (HsDo stmts _)
282 = ppHang (ppPStr SLIT("do")) 2 (ppAboves (map (ppr sty) stmts))
283 pprExpr sty (HsDoOut stmts _ _ _)
284 = ppHang (ppPStr SLIT("do")) 2 (ppAboves (map (ppr sty) stmts))
286 pprExpr sty (ListComp expr quals)
287 = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
288 4 (ppSep [interpp'SP sty quals, ppRbrack])
290 pprExpr sty (ExplicitList exprs)
291 = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
292 pprExpr sty (ExplicitListOut ty exprs)
293 = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
294 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
296 pprExpr sty (ExplicitTuple exprs)
297 = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
299 pprExpr sty (RecordCon con rbinds)
300 = pp_rbinds sty (ppr sty con) rbinds
302 pprExpr sty (RecordUpd aexp rbinds)
303 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
304 pprExpr sty (RecordUpdOut aexp _ rbinds)
305 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
307 pprExpr sty (ExprWithTySig expr sig)
308 = ppHang (ppBeside (ppNest 2 (pprExpr sty expr)) (ppPStr SLIT(" ::")))
311 pprExpr sty (ArithSeqIn info)
312 = ppBracket (ppr sty info)
313 pprExpr sty (ArithSeqOut expr info)
316 ppBracket (ppr sty info)
318 ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
320 pprExpr sty (CCall fun args _ is_asm result_ty)
322 then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
323 else ppBeside (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
324 4 (ppSep (map (pprParendExpr sty) args))
326 pprExpr sty (HsSCC label expr)
327 = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
328 pprParendExpr sty expr ]
330 pprExpr sty (TyLam tyvars expr)
331 = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
334 pprExpr sty (TyApp expr [ty])
335 = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
337 pprExpr sty (TyApp expr tys)
338 = ppHang (pprExpr sty expr)
339 4 (ppBracket (interpp'SP sty tys))
341 pprExpr sty (DictLam dictvars expr)
342 = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
345 pprExpr sty (DictApp expr [dname])
346 = ppHang (pprExpr sty expr) 4 (ppr sty dname)
348 pprExpr sty (DictApp expr dnames)
349 = ppHang (pprExpr sty expr)
350 4 (ppBracket (interpp'SP sty dnames))
352 pprExpr sty (ClassDictLam dicts methods expr)
353 = ppHang (ppCat [ppStr "\\{-classdict-}",
354 ppBracket (interppSP sty dicts),
355 ppBracket (interppSP sty methods),
359 pprExpr sty (Dictionary dicts methods)
360 = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
361 ppBracket (interpp'SP sty dicts),
362 ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
364 pprExpr sty (SingleDict dname)
365 = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
367 pprExpr sty (HsCon con tys exprs)
368 = ppCat [ppPStr SLIT("{-HsCon-}"), ppr sty con, interppSP sty tys, interppSP sty exprs]
371 Parenthesize unless very simple:
373 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
374 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
375 => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
377 pprParendExpr sty expr
379 pp_as_was = pprExpr sty expr
383 HsLitOut l _ -> ppr sty l
385 ExplicitList _ -> pp_as_was
386 ExplicitListOut _ _ -> pp_as_was
387 ExplicitTuple _ -> pp_as_was
388 _ -> ppParens pp_as_was
391 %************************************************************************
393 \subsection{Record binds}
395 %************************************************************************
398 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
399 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
400 => PprStyle -> Pretty
401 -> HsRecordBinds tyvar uvar id pat -> Pretty
403 pp_rbinds sty thing rbinds
405 (ppBesides [ppChar '{', ppInterleave ppComma (map (pp_rbind sty) rbinds), ppChar '}'])
407 pp_rbind PprForUser (v, _, True) = ppr PprForUser v
408 pp_rbind sty (v, e, _) = ppCat [ppr sty v, ppStr "=", ppr sty e]
411 %************************************************************************
413 \subsection{Do stmts}
415 %************************************************************************
418 data Stmt tyvar uvar id pat
420 (HsExpr tyvar uvar id pat)
422 | ExprStmt (HsExpr tyvar uvar id pat)
424 | LetStmt (HsBinds tyvar uvar id pat)
426 -- Translations; the types are the "a" and "b" types of the monad.
427 | BindStmtOut pat (HsExpr tyvar uvar id pat) SrcLoc (GenType tyvar uvar) (GenType tyvar uvar)
428 | ExprStmtOut (HsExpr tyvar uvar id pat) SrcLoc (GenType tyvar uvar) (GenType tyvar uvar)
432 instance (NamedThing id, Outputable id, Outputable pat,
433 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
434 Outputable (Stmt tyvar uvar id pat) where
435 ppr sty (BindStmt pat expr _)
436 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
437 ppr sty (LetStmt binds)
438 = ppCat [ppPStr SLIT("let"), ppr sty binds]
439 ppr sty (ExprStmt expr _)
441 ppr sty (BindStmtOut pat expr _ _ _)
442 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
443 ppr sty (ExprStmtOut expr _ _ _)
447 %************************************************************************
449 \subsection{Enumerations and list comprehensions}
451 %************************************************************************
454 data ArithSeqInfo tyvar uvar id pat
455 = From (HsExpr tyvar uvar id pat)
456 | FromThen (HsExpr tyvar uvar id pat)
457 (HsExpr tyvar uvar id pat)
458 | FromTo (HsExpr tyvar uvar id pat)
459 (HsExpr tyvar uvar id pat)
460 | FromThenTo (HsExpr tyvar uvar id pat)
461 (HsExpr tyvar uvar id pat)
462 (HsExpr tyvar uvar id pat)
466 instance (NamedThing id, Outputable id, Outputable pat,
467 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
468 Outputable (ArithSeqInfo tyvar uvar id pat) where
469 ppr sty (From e1) = ppBesides [ppr sty e1, pp_dotdot]
470 ppr sty (FromThen e1 e2) = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
471 ppr sty (FromTo e1 e3) = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
472 ppr sty (FromThenTo e1 e2 e3)
473 = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
475 pp_dotdot = ppPStr SLIT(" .. ")
478 ``Qualifiers'' in list comprehensions:
480 data Qual tyvar uvar id pat
482 (HsExpr tyvar uvar id pat)
483 | LetQual (HsBinds tyvar uvar id pat)
484 | FilterQual (HsExpr tyvar uvar id pat)
488 instance (NamedThing id, Outputable id, Outputable pat,
489 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
490 Outputable (Qual tyvar uvar id pat) where
491 ppr sty (GeneratorQual pat expr)
492 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
493 ppr sty (LetQual binds)
494 = ppCat [ppPStr SLIT("let"), ppr sty binds]
495 ppr sty (FilterQual expr)