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 ( 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 -- Monad and MonadZero dicts
91 | ListComp (HsExpr tyvar uvar id pat) -- list comprehension
92 [Qual tyvar uvar id pat] -- at least one Qual(ifier)
94 | ExplicitList -- syntactic list
95 [HsExpr tyvar uvar id pat]
96 | ExplicitListOut -- TRANSLATION
97 (GenType tyvar uvar) -- Gives type of components of list
98 [HsExpr tyvar uvar id pat]
100 | ExplicitTuple -- tuple
101 [HsExpr tyvar uvar id pat]
102 -- NB: Unit is ExplicitTuple []
103 -- for tuples, we can get the types
104 -- direct from the components
106 -- Record construction
107 | RecordCon (HsExpr tyvar uvar id pat) -- Always (HsVar id) until type checker,
108 -- but the latter adds its type args too
109 (HsRecordBinds tyvar uvar id pat)
112 | RecordUpd (HsExpr tyvar uvar id pat)
113 (HsRecordBinds tyvar uvar id pat)
115 | RecordUpdOut (HsExpr tyvar uvar id pat) -- TRANSLATION
116 [id] -- Dicts needed for construction
117 (HsRecordBinds tyvar uvar id pat)
119 | ExprWithTySig -- signature binding
120 (HsExpr tyvar uvar id pat)
122 | ArithSeqIn -- arithmetic sequence
123 (ArithSeqInfo tyvar uvar id pat)
125 (HsExpr tyvar uvar id pat) -- (typechecked, of course)
126 (ArithSeqInfo tyvar uvar id pat)
128 | CCall FAST_STRING -- call into the C world; string is
129 [HsExpr tyvar uvar id pat] -- the C function; exprs are the
130 -- arguments to pass.
131 Bool -- True <=> might cause Haskell
132 -- garbage-collection (must generate
133 -- more paranoid code)
134 Bool -- True <=> it's really a "casm"
135 -- NOTE: this CCall is the *boxed*
136 -- version; the desugarer will convert
137 -- it into the unboxed "ccall#".
138 (GenType tyvar uvar) -- The result type; will be *bottom*
139 -- until the typechecker gets ahold of it
141 | HsSCC FAST_STRING -- "set cost centre" (_scc_) annotation
142 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
145 Everything from here on appears only in typechecker output.
148 | TyLam -- TRANSLATION
150 (HsExpr tyvar uvar id pat)
151 | TyApp -- TRANSLATION
152 (HsExpr tyvar uvar id pat) -- generated by Spec
155 -- DictLam and DictApp are "inverses"
158 (HsExpr tyvar uvar id pat)
160 (HsExpr tyvar uvar id pat)
163 -- ClassDictLam and Dictionary are "inverses" (see note below)
165 [id] -- superclass dicts
167 (HsExpr tyvar uvar id pat)
169 [id] -- superclass dicts
172 | SingleDict -- a simple special case of Dictionary
173 id -- local dictionary name
175 | HsCon -- TRANSLATION; a constructor application
176 Id -- used only in the RHS of constructor definitions
178 [HsExpr tyvar uvar id pat]
180 type HsRecordBinds tyvar uvar id pat
181 = [(id, HsExpr tyvar uvar id pat, Bool)]
182 -- True <=> source code used "punning",
183 -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
186 A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
187 @ClassDictLam dictvars methods expr@ is, therefore:
189 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
193 instance (NamedThing id, Outputable id, Outputable pat,
194 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
195 Outputable (HsExpr tyvar uvar id pat) where
200 pprExpr sty (HsVar v) = pprNonSym sty v
202 pprExpr sty (HsLit lit) = ppr sty lit
203 pprExpr sty (HsLitOut lit _) = ppr sty lit
205 pprExpr sty (HsLam match)
206 = ppCat [ppStr "\\", ppNest 2 (pprMatch sty True match)]
208 pprExpr sty expr@(HsApp e1 e2)
209 = let (fun, args) = collect_args expr [] in
210 ppHang (pprExpr sty fun) 4 (ppSep (map (pprExpr sty) args))
212 collect_args (HsApp fun arg) args = collect_args fun (arg:args)
213 collect_args fun args = (fun, args)
215 pprExpr sty (OpApp e1 op e2)
217 HsVar v -> pp_infixly v
220 pp_e1 = pprExpr sty e1
221 pp_e2 = pprExpr sty e2
224 = ppHang (pprExpr sty op) 4 (ppSep [pp_e1, pp_e2])
227 = ppSep [pp_e1, ppCat [pprSym sty v, pp_e2]]
229 pprExpr sty (NegApp e _)
230 = ppBeside (ppChar '-') (pprParendExpr sty e)
232 pprExpr sty (HsPar e)
233 = ppParens (pprExpr sty e)
235 pprExpr sty (SectionL expr op)
237 HsVar v -> pp_infixly v
240 pp_expr = pprParendExpr sty expr
242 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op])
243 4 (ppCat [pp_expr, ppStr "_x )"])
245 = ppSep [ ppBeside ppLparen pp_expr,
246 ppBeside (pprSym sty v) ppRparen ]
248 pprExpr sty (SectionR op expr)
250 HsVar v -> pp_infixly v
253 pp_expr = pprParendExpr sty expr
255 pp_prefixly = ppHang (ppCat [ppStr "( \\ _x ->", ppr sty op, ppPStr SLIT("_x")])
256 4 (ppBeside pp_expr ppRparen)
258 = ppSep [ ppBeside ppLparen (pprSym sty v),
259 ppBeside pp_expr ppRparen ]
261 pprExpr sty (HsCase expr matches _)
262 = ppSep [ ppSep [ppPStr SLIT("case"), ppNest 4 (pprExpr sty expr), ppPStr SLIT("of")],
263 ppNest 2 (pprMatches sty (True, ppNil) matches) ]
265 pprExpr sty (HsIf e1 e2 e3 _)
266 = ppSep [ppCat [ppPStr SLIT("if"), ppNest 2 (pprExpr sty e1), ppPStr SLIT("then")],
267 ppNest 4 (pprExpr sty e2),
269 ppNest 4 (pprExpr sty e3)]
271 -- special case: let ... in let ...
272 pprExpr sty (HsLet binds expr@(HsLet _ _))
273 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppCat [ppr sty binds, ppPStr SLIT("in")]),
276 pprExpr sty (HsLet binds expr)
277 = ppSep [ppHang (ppPStr SLIT("let")) 2 (ppr sty binds),
278 ppHang (ppPStr SLIT("in")) 2 (ppr sty expr)]
280 pprExpr sty (HsDo stmts _)
281 = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
282 pprExpr sty (HsDoOut stmts _ _ _)
283 = ppCat [ppPStr SLIT("do"), ppAboves (map (ppr sty) stmts)]
285 pprExpr sty (ListComp expr quals)
286 = ppHang (ppCat [ppLbrack, pprExpr sty expr, ppChar '|'])
287 4 (ppSep [interpp'SP sty quals, ppRbrack])
289 pprExpr sty (ExplicitList exprs)
290 = ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs))
291 pprExpr sty (ExplicitListOut ty exprs)
292 = ppBesides [ ppBracket (ppInterleave ppComma (map (pprExpr sty) exprs)),
293 ifnotPprForUser sty (ppBeside ppSP (ppParens (pprGenType sty ty))) ]
295 pprExpr sty (ExplicitTuple exprs)
296 = ppParens (ppInterleave ppComma (map (pprExpr sty) exprs))
298 pprExpr sty (RecordCon con rbinds)
299 = pp_rbinds sty (ppr sty con) rbinds
301 pprExpr sty (RecordUpd aexp rbinds)
302 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
303 pprExpr sty (RecordUpdOut aexp _ rbinds)
304 = pp_rbinds sty (pprParendExpr sty aexp) rbinds
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 (ArithSeqIn info)
311 = ppBracket (ppr sty info)
312 pprExpr sty (ArithSeqOut expr info)
315 ppBracket (ppr sty info)
317 ppBesides [ppLbrack, ppParens (ppr sty expr), ppr sty info, ppRbrack]
319 pprExpr sty (CCall fun args _ is_asm result_ty)
321 then ppBesides [ppStr "_casm_ ``", ppPStr fun, ppStr "''"]
322 else ppBeside (ppPStr SLIT("_ccall_ ")) (ppPStr fun))
323 4 (ppSep (map (pprParendExpr sty) args))
325 pprExpr sty (HsSCC label expr)
326 = ppSep [ ppBeside (ppPStr SLIT("_scc_ ")) (ppBesides [ppChar '"', ppPStr label, ppChar '"']),
327 pprParendExpr sty expr ]
329 pprExpr sty (TyLam tyvars expr)
330 = ppHang (ppCat [ppStr "/\\", interppSP sty tyvars, ppStr "->"])
333 pprExpr sty (TyApp expr [ty])
334 = ppHang (pprExpr sty expr) 4 (pprParendGenType sty ty)
336 pprExpr sty (TyApp expr tys)
337 = ppHang (pprExpr sty expr)
338 4 (ppBracket (interpp'SP sty tys))
340 pprExpr sty (DictLam dictvars expr)
341 = ppHang (ppCat [ppStr "\\{-dict-}", interppSP sty dictvars, ppStr "->"])
344 pprExpr sty (DictApp expr [dname])
345 = ppHang (pprExpr sty expr) 4 (ppr sty dname)
347 pprExpr sty (DictApp expr dnames)
348 = ppHang (pprExpr sty expr)
349 4 (ppBracket (interpp'SP sty dnames))
351 pprExpr sty (ClassDictLam dicts methods expr)
352 = ppHang (ppCat [ppStr "\\{-classdict-}",
353 ppBracket (interppSP sty dicts),
354 ppBracket (interppSP sty methods),
358 pprExpr sty (Dictionary dicts methods)
359 = ppSep [ppBesides [ppLparen, ppPStr SLIT("{-dict-}")],
360 ppBracket (interpp'SP sty dicts),
361 ppBesides [ppBracket (interpp'SP sty methods), ppRparen]]
363 pprExpr sty (SingleDict dname)
364 = ppCat [ppPStr SLIT("{-singleDict-}"), ppr sty dname]
366 pprExpr sty (HsCon con tys exprs)
367 = ppCat [ppPStr SLIT("{-HsCon-}"), ppr sty con, interppSP sty tys, interppSP sty exprs]
370 Parenthesize unless very simple:
372 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
373 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
374 => PprStyle -> HsExpr tyvar uvar id pat -> Pretty
376 pprParendExpr sty expr
378 pp_as_was = pprExpr sty expr
382 HsLitOut l _ -> ppr sty l
384 ExplicitList _ -> pp_as_was
385 ExplicitListOut _ _ -> pp_as_was
386 ExplicitTuple _ -> pp_as_was
387 _ -> ppParens pp_as_was
390 %************************************************************************
392 \subsection{Record binds}
394 %************************************************************************
397 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
398 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
399 => PprStyle -> Pretty
400 -> HsRecordBinds tyvar uvar id pat -> Pretty
402 pp_rbinds sty thing rbinds
404 (ppBesides [ppChar '{', ppInterleave ppComma (map (pp_rbind sty) rbinds), ppChar '}'])
406 pp_rbind PprForUser (v, _, True) = ppr PprForUser v
407 pp_rbind sty (v, e, _) = ppCat [ppr sty v, ppStr "=", ppr sty e]
410 %************************************************************************
412 \subsection{Do stmts}
414 %************************************************************************
417 data Stmt tyvar uvar id pat
419 (HsExpr tyvar uvar id pat)
421 | ExprStmt (HsExpr tyvar uvar id pat)
423 | LetStmt (HsBinds tyvar uvar id pat)
427 instance (NamedThing id, Outputable id, Outputable pat,
428 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
429 Outputable (Stmt tyvar uvar id pat) where
430 ppr sty (BindStmt pat expr _)
431 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
432 ppr sty (LetStmt binds)
433 = ppCat [ppPStr SLIT("let"), ppr sty binds]
434 ppr sty (ExprStmt expr _)
438 %************************************************************************
440 \subsection{Enumerations and list comprehensions}
442 %************************************************************************
445 data ArithSeqInfo tyvar uvar id pat
446 = From (HsExpr tyvar uvar id pat)
447 | FromThen (HsExpr tyvar uvar id pat)
448 (HsExpr tyvar uvar id pat)
449 | FromTo (HsExpr tyvar uvar id pat)
450 (HsExpr tyvar uvar id pat)
451 | FromThenTo (HsExpr tyvar uvar id pat)
452 (HsExpr tyvar uvar id pat)
453 (HsExpr tyvar uvar id pat)
457 instance (NamedThing id, Outputable id, Outputable pat,
458 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
459 Outputable (ArithSeqInfo tyvar uvar id pat) where
460 ppr sty (From e1) = ppBesides [ppr sty e1, pp_dotdot]
461 ppr sty (FromThen e1 e2) = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot]
462 ppr sty (FromTo e1 e3) = ppBesides [ppr sty e1, pp_dotdot, ppr sty e3]
463 ppr sty (FromThenTo e1 e2 e3)
464 = ppBesides [ppr sty e1, pp'SP, ppr sty e2, pp_dotdot, ppr sty e3]
466 pp_dotdot = ppPStr SLIT(" .. ")
469 ``Qualifiers'' in list comprehensions:
471 data Qual tyvar uvar id pat
473 (HsExpr tyvar uvar id pat)
474 | LetQual (HsBinds tyvar uvar id pat)
475 | FilterQual (HsExpr tyvar uvar id pat)
479 instance (NamedThing id, Outputable id, Outputable pat,
480 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
481 Outputable (Qual tyvar uvar id pat) where
482 ppr sty (GeneratorQual pat expr)
483 = ppCat [ppr sty pat, ppStr "<-", ppr sty expr]
484 ppr sty (LetQual binds)
485 = ppCat [ppPStr SLIT("let"), ppr sty binds]
486 ppr sty (FilterQual expr)