2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
4 \section[HsExpr]{Abstract Haskell syntax: expressions}
7 #include "HsVersions.h"
14 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
15 IMPORT_DELOOPER(HsLoop) ( pprMatches, pprMatch, Match )
17 import {-# SOURCE #-} HsMatches ( pprMatches, pprMatch, Match )
20 import HsBinds ( HsBinds )
21 import HsBasic ( HsLit )
22 import BasicTypes ( Fixity(..), FixityDirection(..) )
23 import HsTypes ( HsType )
26 import Id ( SYN_IE(DictVar), GenId, SYN_IE(Id) )
27 import Outputable ( pprQuote, interppSP, interpp'SP, ifnotPprForUser,
28 PprStyle(..), userStyle, Outputable(..) )
29 import PprType ( pprGenType, pprParendGenType, GenType{-instance-} )
31 import SrcLoc ( SrcLoc )
32 import Usage ( GenUsage{-instance-} )
33 #if __GLASGOW_HASKELL__ >= 202
38 %************************************************************************
40 \subsection{Expressions proper}
42 %************************************************************************
45 data HsExpr tyvar uvar id pat
46 = HsVar id -- variable
47 | HsLit HsLit -- literal
48 | HsLitOut HsLit -- TRANSLATION
49 (GenType tyvar uvar) -- (with its type)
51 | HsLam (Match tyvar uvar id pat) -- lambda
52 | HsApp (HsExpr tyvar uvar id pat) -- application
53 (HsExpr tyvar uvar id pat)
55 -- Operator applications:
56 -- NB Bracketed ops such as (+) come out as Vars.
58 -- NB We need an expr for the operator in an OpApp/Section since
59 -- the typechecker may need to apply the operator to a few types.
61 | OpApp (HsExpr tyvar uvar id pat) -- left operand
62 (HsExpr tyvar uvar id pat) -- operator
63 Fixity -- Renamer adds fixity; bottom until then
64 (HsExpr tyvar uvar id pat) -- right operand
66 -- We preserve prefix negation and parenthesis for the precedence parser.
67 -- They are eventually removed by the type checker.
69 | NegApp (HsExpr tyvar uvar id pat) -- negated expr
70 (HsExpr tyvar uvar id pat) -- the negate id (in a HsVar)
72 | HsPar (HsExpr tyvar uvar id pat) -- parenthesised expr
74 | SectionL (HsExpr tyvar uvar id pat) -- operand
75 (HsExpr tyvar uvar id pat) -- operator
76 | SectionR (HsExpr tyvar uvar id pat) -- operator
77 (HsExpr tyvar uvar id pat) -- operand
79 | HsCase (HsExpr tyvar uvar id pat)
80 [Match tyvar uvar id pat] -- must have at least one Match
83 | HsIf (HsExpr tyvar uvar id pat) -- predicate
84 (HsExpr tyvar uvar id pat) -- then part
85 (HsExpr tyvar uvar id pat) -- else part
88 | HsLet (HsBinds tyvar uvar id pat) -- let(rec)
89 (HsExpr tyvar uvar id pat)
92 [Stmt tyvar uvar id pat] -- "do":one or more stmts
95 | HsDoOut DoOrListComp
96 [Stmt tyvar uvar id pat] -- "do":one or more stmts
100 (GenType tyvar uvar) -- Type of the whole expression
103 | ExplicitList -- syntactic list
104 [HsExpr tyvar uvar id pat]
105 | ExplicitListOut -- TRANSLATION
106 (GenType tyvar uvar) -- Gives type of components of list
107 [HsExpr tyvar uvar id pat]
109 | ExplicitTuple -- tuple
110 [HsExpr tyvar uvar id pat]
111 -- NB: Unit is ExplicitTuple []
112 -- for tuples, we can get the types
113 -- direct from the components
115 -- Record construction
116 | RecordCon (HsExpr tyvar uvar id pat) -- Always (HsVar id) until type checker,
117 -- but the latter adds its type args too
118 (HsRecordBinds tyvar uvar id pat)
121 | RecordUpd (HsExpr tyvar uvar id pat)
122 (HsRecordBinds tyvar uvar id pat)
124 | RecordUpdOut (HsExpr tyvar uvar id pat) -- TRANSLATION
125 (GenType tyvar uvar) -- Type of *result* record (may differ from
126 -- type of input record)
127 [id] -- Dicts needed for construction
128 (HsRecordBinds tyvar uvar id pat)
130 | ExprWithTySig -- signature binding
131 (HsExpr tyvar uvar id pat)
133 | ArithSeqIn -- arithmetic sequence
134 (ArithSeqInfo tyvar uvar id pat)
136 (HsExpr tyvar uvar id pat) -- (typechecked, of course)
137 (ArithSeqInfo tyvar uvar id pat)
139 | CCall FAST_STRING -- call into the C world; string is
140 [HsExpr tyvar uvar id pat] -- the C function; exprs are the
141 -- arguments to pass.
142 Bool -- True <=> might cause Haskell
143 -- garbage-collection (must generate
144 -- more paranoid code)
145 Bool -- True <=> it's really a "casm"
146 -- NOTE: this CCall is the *boxed*
147 -- version; the desugarer will convert
148 -- it into the unboxed "ccall#".
149 (GenType tyvar uvar) -- The result type; will be *bottom*
150 -- until the typechecker gets ahold of it
152 | HsSCC FAST_STRING -- "set cost centre" (_scc_) annotation
153 (HsExpr tyvar uvar id pat) -- expr whose cost is to be measured
156 Everything from here on appears only in typechecker output.
159 | TyLam -- TRANSLATION
161 (HsExpr tyvar uvar id pat)
162 | TyApp -- TRANSLATION
163 (HsExpr tyvar uvar id pat) -- generated by Spec
166 -- DictLam and DictApp are "inverses"
169 (HsExpr tyvar uvar id pat)
171 (HsExpr tyvar uvar id pat)
174 -- ClassDictLam and Dictionary are "inverses" (see note below)
176 [id] -- superclass dicts
178 (HsExpr tyvar uvar id pat)
180 [id] -- superclass dicts
183 | SingleDict -- a simple special case of Dictionary
184 id -- local dictionary name
186 type HsRecordBinds tyvar uvar id pat
187 = [(id, HsExpr tyvar uvar id pat, Bool)]
188 -- True <=> source code used "punning",
189 -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
192 A @Dictionary@, unless of length 0 or 1, becomes a tuple. A
193 @ClassDictLam dictvars methods expr@ is, therefore:
195 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
199 instance (NamedThing id, Outputable id, Outputable pat,
200 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
201 Outputable (HsExpr tyvar uvar id pat) where
202 ppr sty expr = pprQuote sty $ \ sty -> pprExpr sty expr
206 pprExpr :: (NamedThing id, Outputable id, Outputable pat,
207 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
208 => PprStyle -> HsExpr tyvar uvar id pat -> Doc
210 pprExpr sty (HsVar v) = ppr sty v
212 pprExpr sty (HsLit lit) = ppr sty lit
213 pprExpr sty (HsLitOut lit _) = ppr sty lit
215 pprExpr sty (HsLam match)
216 = hsep [char '\\', nest 2 (pprMatch sty True match)]
218 pprExpr sty expr@(HsApp e1 e2)
219 = let (fun, args) = collect_args expr [] in
220 (pprExpr sty fun) <+> (sep (map (pprExpr sty) args))
222 collect_args (HsApp fun arg) args = collect_args fun (arg:args)
223 collect_args fun args = (fun, args)
225 pprExpr sty (OpApp e1 op fixity e2)
227 HsVar v -> pp_infixly v
230 pp_e1 = pprParendExpr sty e1 -- Add parens to make precedence clear
231 pp_e2 = pprParendExpr sty e2
234 = hang (pprExpr sty op) 4 (sep [pp_e1, pp_e2])
237 = sep [pp_e1, hsep [ppr sty v, pp_e2]]
239 pprExpr sty (NegApp e _)
240 = (<>) (char '-') (pprParendExpr sty e)
242 pprExpr sty (HsPar e)
243 = parens (pprExpr sty e)
245 pprExpr sty (SectionL expr op)
247 HsVar v -> pp_infixly v
250 pp_expr = pprParendExpr sty expr
252 pp_prefixly = hang (hsep [text " \\ x_ ->", ppr sty op])
253 4 (hsep [pp_expr, ptext SLIT("x_ )")])
254 pp_infixly v = parens (sep [pp_expr, ppr sty v])
256 pprExpr sty (SectionR op expr)
258 HsVar v -> pp_infixly v
261 pp_expr = pprParendExpr sty expr
263 pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr sty op, ptext SLIT("x_")])
264 4 ((<>) pp_expr rparen)
266 = parens (sep [ppr sty v, pp_expr])
268 pprExpr sty (HsCase expr matches _)
269 = sep [ sep [ptext SLIT("case"), nest 4 (pprExpr sty expr), ptext SLIT("of")],
270 nest 2 (pprMatches sty (True, empty) matches) ]
272 pprExpr sty (HsIf e1 e2 e3 _)
273 = sep [hsep [ptext SLIT("if"), nest 2 (pprExpr sty e1), ptext SLIT("then")],
274 nest 4 (pprExpr sty e2),
276 nest 4 (pprExpr sty e3)]
278 -- special case: let ... in let ...
279 pprExpr sty (HsLet binds expr@(HsLet _ _))
280 = sep [hang (ptext SLIT("let")) 2 (hsep [ppr sty binds, ptext SLIT("in")]),
283 pprExpr sty (HsLet binds expr)
284 = sep [hang (ptext SLIT("let")) 2 (ppr sty binds),
285 hang (ptext SLIT("in")) 2 (ppr sty expr)]
287 pprExpr sty (HsDo do_or_list_comp stmts _) = pprDo do_or_list_comp sty stmts
288 pprExpr sty (HsDoOut do_or_list_comp stmts _ _ _ _ _) = pprDo do_or_list_comp sty stmts
290 pprExpr sty (ExplicitList exprs)
291 = brackets (fsep (punctuate comma (map (pprExpr sty) exprs)))
292 pprExpr sty (ExplicitListOut ty exprs)
293 = hcat [ brackets (fsep (punctuate comma (map (pprExpr sty) exprs))),
294 ifnotPprForUser sty ((<>) space (parens (pprGenType sty ty))) ]
296 pprExpr sty (ExplicitTuple exprs)
297 = parens (sep (punctuate comma (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 = hang ((<>) (nest 2 (pprExpr sty expr)) (ptext SLIT(" ::")))
311 pprExpr sty (ArithSeqIn info)
312 = brackets (ppr sty info)
313 pprExpr sty (ArithSeqOut expr info)
314 | userStyle sty = brackets (ppr sty info)
315 | otherwise = brackets (hcat [parens (ppr sty expr), space, ppr sty info])
317 pprExpr sty (CCall fun args _ is_asm result_ty)
319 then hcat [ptext SLIT("_casm_ ``"), ptext fun, ptext SLIT("''")]
320 else (<>) (ptext SLIT("_ccall_ ")) (ptext fun))
321 4 (sep (map (pprParendExpr sty) args))
323 pprExpr sty (HsSCC label expr)
324 = sep [ (<>) (ptext SLIT("_scc_ ")) (hcat [char '"', ptext label, char '"']),
325 pprParendExpr sty expr ]
327 pprExpr sty (TyLam tyvars expr)
328 = hang (hsep [ptext SLIT("/\\"), interppSP sty tyvars, ptext SLIT("->")])
331 pprExpr sty (TyApp expr [ty])
332 = hang (pprExpr sty expr) 4 (pprParendGenType sty ty)
334 pprExpr sty (TyApp expr tys)
335 = hang (pprExpr sty expr)
336 4 (brackets (interpp'SP sty tys))
338 pprExpr sty (DictLam dictvars expr)
339 = hang (hsep [ptext SLIT("\\{-dict-}"), interppSP sty dictvars, ptext SLIT("->")])
342 pprExpr sty (DictApp expr [dname])
343 = hang (pprExpr sty expr) 4 (ppr sty dname)
345 pprExpr sty (DictApp expr dnames)
346 = hang (pprExpr sty expr)
347 4 (brackets (interpp'SP sty dnames))
349 pprExpr sty (ClassDictLam dicts methods expr)
350 = hang (hsep [ptext SLIT("\\{-classdict-}"),
351 brackets (interppSP sty dicts),
352 brackets (interppSP sty methods),
356 pprExpr sty (Dictionary dicts methods)
357 = parens (sep [ptext SLIT("{-dict-}"),
358 brackets (interpp'SP sty dicts),
359 brackets (interpp'SP sty methods)])
361 pprExpr sty (SingleDict dname)
362 = hsep [ptext SLIT("{-singleDict-}"), ppr sty dname]
366 Parenthesize unless very simple:
368 pprParendExpr :: (NamedThing id, Outputable id, Outputable pat,
369 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
370 => PprStyle -> HsExpr tyvar uvar id pat -> Doc
372 pprParendExpr sty expr
374 pp_as_was = pprExpr sty expr
378 HsLitOut l _ -> ppr sty l
381 ExplicitList _ -> pp_as_was
382 ExplicitListOut _ _ -> pp_as_was
383 ExplicitTuple _ -> pp_as_was
386 _ -> parens pp_as_was
389 %************************************************************************
391 \subsection{Record binds}
393 %************************************************************************
396 pp_rbinds :: (NamedThing id, Outputable id, Outputable pat,
397 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
399 -> HsRecordBinds tyvar uvar id pat -> Doc
401 pp_rbinds sty thing rbinds
403 4 (braces (hsep (punctuate comma (map (pp_rbind sty) rbinds))))
405 pp_rbind sty (v, _, True) | userStyle sty = ppr sty v
406 pp_rbind sty (v, e, _) = hsep [ppr sty v, char '=', ppr sty e]
409 %************************************************************************
411 \subsection{Do stmts and list comprehensions}
413 %************************************************************************
416 data DoOrListComp = DoStmt | ListComp
418 pprDo DoStmt sty stmts
419 = hang (ptext SLIT("do")) 2 (vcat (map (ppr sty) stmts))
420 pprDo ListComp sty stmts
421 = hang (hsep [lbrack, pprExpr sty expr, char '|'])
422 4 (sep [interpp'SP sty quals, rbrack])
424 ReturnStmt expr = last stmts -- Last stmt should be a ReturnStmt for list comps
429 data Stmt tyvar uvar id pat
431 (HsExpr tyvar uvar id pat)
434 | LetStmt (HsBinds tyvar uvar id pat)
436 | GuardStmt (HsExpr tyvar uvar id pat) -- List comps only
439 | ExprStmt (HsExpr tyvar uvar id pat) -- Do stmts only
442 | ReturnStmt (HsExpr tyvar uvar id pat) -- List comps only, at the end
446 instance (NamedThing id, Outputable id, Outputable pat,
447 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
448 Outputable (Stmt tyvar uvar id pat) where
449 ppr sty stmt = pprQuote sty $ \ sty -> pprStmt sty stmt
451 pprStmt sty (BindStmt pat expr _)
452 = hsep [ppr sty pat, ptext SLIT("<-"), ppr sty expr]
453 pprStmt sty (LetStmt binds)
454 = hsep [ptext SLIT("let"), ppr sty binds]
455 pprStmt sty (ExprStmt expr _)
457 pprStmt sty (GuardStmt expr _)
459 pprStmt sty (ReturnStmt expr)
460 = hsep [ptext SLIT("return"), ppr sty expr]
463 %************************************************************************
465 \subsection{Enumerations and list comprehensions}
467 %************************************************************************
470 data ArithSeqInfo tyvar uvar id pat
471 = From (HsExpr tyvar uvar id pat)
472 | FromThen (HsExpr tyvar uvar id pat)
473 (HsExpr tyvar uvar id pat)
474 | FromTo (HsExpr tyvar uvar id pat)
475 (HsExpr tyvar uvar id pat)
476 | FromThenTo (HsExpr tyvar uvar id pat)
477 (HsExpr tyvar uvar id pat)
478 (HsExpr tyvar uvar id pat)
482 instance (NamedThing id, Outputable id, Outputable pat,
483 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) =>
484 Outputable (ArithSeqInfo tyvar uvar id pat) where
485 ppr sty (From e1) = hcat [ppr sty e1, pp_dotdot]
486 ppr sty (FromThen e1 e2) = hcat [ppr sty e1, comma, space, ppr sty e2, pp_dotdot]
487 ppr sty (FromTo e1 e3) = hcat [ppr sty e1, pp_dotdot, ppr sty e3]
488 ppr sty (FromThenTo e1 e2 e3)
489 = hcat [ppr sty e1, comma, space, ppr sty e2, pp_dotdot, ppr sty e3]
491 pp_dotdot = ptext SLIT(" .. ")