[project @ 1999-05-18 15:03:54 by simonpj]
[ghc-hetmet.git] / ghc / compiler / hsSyn / HsExpr.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[HsExpr]{Abstract Haskell syntax: expressions}
5
6 \begin{code}
7 module HsExpr where
8
9 #include "HsVersions.h"
10
11 -- friends:
12 import {-# SOURCE #-} HsMatches ( pprMatches, pprMatch, Match )
13
14 import HsBinds          ( HsBinds(..) )
15 import HsBasic          ( HsLit )
16 import BasicTypes       ( Fixity(..), FixityDirection(..) )
17 import HsTypes          ( HsType )
18
19 -- others:
20 import Name             ( Name, isLexId ) 
21 import Outputable       
22 import PprType          ( pprType, pprParendType )
23 import Type             ( Type )
24 import Var              ( TyVar, Id )
25 import DataCon          ( DataCon )
26 import SrcLoc           ( SrcLoc )
27 \end{code}
28
29 %************************************************************************
30 %*                                                                      *
31 \subsection{Expressions proper}
32 %*                                                                      *
33 %************************************************************************
34
35 \begin{code}
36 data HsExpr id pat
37   = HsVar       id                              -- variable
38   | HsLit       HsLit                           -- literal
39   | HsLitOut    HsLit                           -- TRANSLATION
40                 Type            -- (with its type)
41
42   | HsLam       (Match  id pat) -- lambda
43   | HsApp       (HsExpr id pat) -- application
44                 (HsExpr id pat)
45
46   -- Operator applications:
47   -- NB Bracketed ops such as (+) come out as Vars.
48
49   -- NB We need an expr for the operator in an OpApp/Section since
50   -- the typechecker may need to apply the operator to a few types.
51
52   | OpApp       (HsExpr id pat) -- left operand
53                 (HsExpr id pat) -- operator
54                 Fixity                          -- Renamer adds fixity; bottom until then
55                 (HsExpr id pat) -- right operand
56
57   -- We preserve prefix negation and parenthesis for the precedence parser.
58   -- They are eventually removed by the type checker.
59
60   | NegApp      (HsExpr id pat) -- negated expr
61                 (HsExpr id pat) -- the negate id (in a HsVar)
62
63   | HsPar       (HsExpr id pat) -- parenthesised expr
64
65   | SectionL    (HsExpr id pat) -- operand
66                 (HsExpr id pat) -- operator
67   | SectionR    (HsExpr id pat) -- operator
68                 (HsExpr id pat) -- operand
69                                 
70   | HsCase      (HsExpr id pat)
71                 [Match id pat]
72                 SrcLoc
73
74   | HsIf        (HsExpr id pat) --  predicate
75                 (HsExpr id pat) --  then part
76                 (HsExpr id pat) --  else part
77                 SrcLoc
78
79   | HsLet       (HsBinds id pat)        -- let(rec)
80                 (HsExpr  id pat)
81
82   | HsDo        StmtCtxt
83                 [Stmt id pat]   -- "do":one or more stmts
84                 SrcLoc
85
86   | HsDoOut     StmtCtxt
87                 [Stmt id pat]   -- "do":one or more stmts
88                 id              -- id for return
89                 id              -- id for >>=
90                 id                              -- id for zero
91                 Type            -- Type of the whole expression
92                 SrcLoc
93
94   | ExplicitList                -- syntactic list
95                 [HsExpr id pat]
96   | ExplicitListOut             -- TRANSLATION
97                 Type    -- Gives type of components of list
98                 [HsExpr id pat]
99
100   | ExplicitTuple               -- tuple
101                 [HsExpr id pat]
102                                 -- NB: Unit is ExplicitTuple []
103                                 -- for tuples, we can get the types
104                                 -- direct from the components
105                 Bool            -- boxed?
106
107   | HsCon DataCon               -- TRANSLATION; a saturated constructor application
108           [Type]
109           [HsExpr id pat]
110
111         -- Record construction
112   | RecordCon   id                              -- The constructor
113                 (HsRecordBinds id pat)
114
115   | RecordConOut DataCon
116                 (HsExpr id pat)         -- Data con Id applied to type args
117                 (HsRecordBinds id pat)
118
119
120         -- Record update
121   | RecordUpd   (HsExpr id pat)
122                 (HsRecordBinds id pat)
123
124   | RecordUpdOut (HsExpr id pat)        -- TRANSLATION
125                  Type           -- Type of *result* record (may differ from
126                                                 -- type of input record)
127                  [id]                           -- Dicts needed for construction
128                  (HsRecordBinds id pat)
129
130   | ExprWithTySig                       -- signature binding
131                 (HsExpr id pat)
132                 (HsType id)
133   | ArithSeqIn                          -- arithmetic sequence
134                 (ArithSeqInfo id pat)
135   | ArithSeqOut
136                 (HsExpr id pat)         -- (typechecked, of course)
137                 (ArithSeqInfo id pat)
138
139   | CCall       FAST_STRING     -- call into the C world; string is
140                 [HsExpr 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                 Type    -- The result type; will be *bottom*
150                                 -- until the typechecker gets ahold of it
151
152   | HsSCC       FAST_STRING     -- "set cost centre" (_scc_) annotation
153                 (HsExpr id pat) -- expr whose cost is to be measured
154 \end{code}
155
156 Everything from here on appears only in typechecker output.
157
158 \begin{code}
159   | TyLam                       -- TRANSLATION
160                 [TyVar]
161                 (HsExpr id pat)
162   | TyApp                       -- TRANSLATION
163                 (HsExpr id pat) -- generated by Spec
164                 [Type]
165
166   -- DictLam and DictApp are "inverses"
167   |  DictLam
168                 [id]
169                 (HsExpr id pat)
170   |  DictApp
171                 (HsExpr id pat)
172                 [id]
173
174 type HsRecordBinds id pat
175   = [(id, HsExpr id pat, Bool)]
176         -- True <=> source code used "punning",
177         -- i.e. {op1, op2} rather than {op1=e1, op2=e2}
178 \end{code}
179
180 A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
181 @ClassDictLam dictvars methods expr@ is, therefore:
182 \begin{verbatim}
183 \ x -> case x of ( dictvars-and-methods-tuple ) -> expr
184 \end{verbatim}
185
186 \begin{code}
187 instance (Outputable id, Outputable pat) =>
188                 Outputable (HsExpr id pat) where
189     ppr expr = pprExpr expr
190 \end{code}
191
192 \begin{code}
193 pprExpr :: (Outputable id, Outputable pat)
194         => HsExpr id pat -> SDoc
195
196 pprExpr e = pprDeeper (ppr_expr e)
197 pprBinds b = pprDeeper (ppr b)
198
199 ppr_expr (HsVar v) = ppr v
200
201 ppr_expr (HsLit    lit)   = ppr lit
202 ppr_expr (HsLitOut lit _) = ppr lit
203
204 ppr_expr (HsLam match)
205   = hsep [char '\\', nest 2 (pprMatch (True,empty) match)]
206
207 ppr_expr expr@(HsApp e1 e2)
208   = let (fun, args) = collect_args expr [] in
209     (ppr_expr fun) <+> (sep (map ppr_expr args))
210   where
211     collect_args (HsApp fun arg) args = collect_args fun (arg:args)
212     collect_args fun             args = (fun, args)
213
214 ppr_expr (OpApp e1 op fixity e2)
215   = case op of
216       HsVar v -> pp_infixly v
217       _       -> pp_prefixly
218   where
219     pp_e1 = pprParendExpr e1            -- Add parens to make precedence clear
220     pp_e2 = pprParendExpr e2
221
222     pp_prefixly
223       = hang (pprExpr op) 4 (sep [pp_e1, pp_e2])
224
225     pp_infixly v
226       = sep [pp_e1, hsep [pp_v_op, pp_e2]]
227       where
228         pp_v = ppr v
229         pp_v_op | isLexId (_PK_ (showSDoc pp_v)) = char '`' <> pp_v <> char '`'
230                 | otherwise                      = pp_v 
231         -- Put it in backquotes if it's not an operator already
232         -- We use (showSDoc pp_v), rather than isSymOcc (getOccName v) simply so
233         -- that we don't need NamedThing in the context of all these funcions.
234         -- Gruesome, but simple.
235
236 ppr_expr (NegApp e _)
237   = char '-' <+> pprParendExpr e
238
239 ppr_expr (HsPar e) = parens (ppr_expr e)
240
241 ppr_expr (SectionL expr op)
242   = case op of
243       HsVar v -> pp_infixly v
244       _       -> pp_prefixly
245   where
246     pp_expr = pprParendExpr expr
247
248     pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
249                        4 (hsep [pp_expr, ptext SLIT("x_ )")])
250     pp_infixly v = parens (sep [pp_expr, ppr v])
251
252 ppr_expr (SectionR op expr)
253   = case op of
254       HsVar v -> pp_infixly v
255       _       -> pp_prefixly
256   where
257     pp_expr = pprParendExpr expr
258
259     pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext SLIT("x_")])
260                        4 ((<>) pp_expr rparen)
261     pp_infixly v
262       = parens (sep [ppr v, pp_expr])
263
264 ppr_expr (HsCase expr matches _)
265   = sep [ sep [ptext SLIT("case"), nest 4 (pprExpr expr), ptext SLIT("of")],
266             nest 2 (pprMatches (True, empty) matches) ]
267
268 ppr_expr (HsIf e1 e2 e3 _)
269   = sep [hsep [ptext SLIT("if"), nest 2 (pprExpr e1), ptext SLIT("then")],
270            nest 4 (pprExpr e2),
271            ptext SLIT("else"),
272            nest 4 (pprExpr e3)]
273
274 -- special case: let ... in let ...
275 ppr_expr (HsLet binds expr@(HsLet _ _))
276   = sep [hang (ptext SLIT("let")) 2 (hsep [pprBinds binds, ptext SLIT("in")]),
277          pprExpr expr]
278
279 ppr_expr (HsLet binds expr)
280   = sep [hang (ptext SLIT("let")) 2 (pprBinds binds),
281          hang (ptext SLIT("in"))  2 (ppr expr)]
282
283 ppr_expr (HsDo do_or_list_comp stmts _)            = pprDo do_or_list_comp stmts
284 ppr_expr (HsDoOut do_or_list_comp stmts _ _ _ _ _) = pprDo do_or_list_comp stmts
285
286 ppr_expr (ExplicitList exprs)
287   = brackets (fsep (punctuate comma (map ppr_expr exprs)))
288 ppr_expr (ExplicitListOut ty exprs)
289   = hcat [ brackets (fsep (punctuate comma (map ppr_expr exprs))),
290            ifNotPprForUser ((<>) space (parens (pprType ty))) ]
291
292 ppr_expr (ExplicitTuple exprs True)
293   = parens (sep (punctuate comma (map ppr_expr exprs)))
294
295 ppr_expr (ExplicitTuple exprs False)
296   = ptext SLIT("(#") <> sep (punctuate comma (map ppr_expr exprs)) <> ptext SLIT("#)")
297
298 ppr_expr (HsCon con_id tys args)
299   = ppr con_id <+> sep (map pprParendType tys ++
300                         map pprParendExpr args)
301
302 ppr_expr (RecordCon con_id rbinds)
303   = pp_rbinds (ppr con_id) rbinds
304 ppr_expr (RecordConOut data_con con rbinds)
305   = pp_rbinds (ppr con) rbinds
306
307 ppr_expr (RecordUpd aexp rbinds)
308   = pp_rbinds (pprParendExpr aexp) rbinds
309 ppr_expr (RecordUpdOut aexp _ _ rbinds)
310   = pp_rbinds (pprParendExpr aexp) rbinds
311
312 ppr_expr (ExprWithTySig expr sig)
313   = hang (nest 2 (ppr_expr expr) <+> dcolon)
314          4 (ppr sig)
315
316 ppr_expr (ArithSeqIn info)
317   = brackets (ppr info)
318 ppr_expr (ArithSeqOut expr info)
319   = brackets (ppr info)
320
321 ppr_expr (CCall fun args _ is_asm result_ty)
322   = hang (if is_asm
323           then ptext SLIT("_casm_ ``") <> ptext fun <> ptext SLIT("''")
324           else ptext SLIT("_ccall_") <+> ptext fun)
325        4 (sep (map pprParendExpr args))
326
327 ppr_expr (HsSCC label expr)
328   = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ptext label), pprParendExpr expr ]
329
330 ppr_expr (TyLam tyvars expr)
331   = hang (hsep [ptext SLIT("/\\"), interppSP tyvars, ptext SLIT("->")])
332          4 (ppr_expr expr)
333
334 ppr_expr (TyApp expr [ty])
335   = hang (ppr_expr expr) 4 (pprParendType ty)
336
337 ppr_expr (TyApp expr tys)
338   = hang (ppr_expr expr)
339          4 (brackets (interpp'SP tys))
340
341 ppr_expr (DictLam dictvars expr)
342   = hang (hsep [ptext SLIT("\\{-dict-}"), interppSP dictvars, ptext SLIT("->")])
343          4 (ppr_expr expr)
344
345 ppr_expr (DictApp expr [dname])
346   = hang (ppr_expr expr) 4 (ppr dname)
347
348 ppr_expr (DictApp expr dnames)
349   = hang (ppr_expr expr)
350          4 (brackets (interpp'SP dnames))
351
352 \end{code}
353
354 Parenthesize unless very simple:
355 \begin{code}
356 pprParendExpr :: (Outputable id, Outputable pat)
357               => HsExpr id pat -> SDoc
358
359 pprParendExpr expr
360   = let
361         pp_as_was = pprExpr expr
362     in
363     case expr of
364       HsLit l               -> ppr l
365       HsLitOut l _          -> ppr l
366
367       HsVar _               -> pp_as_was
368       ExplicitList _        -> pp_as_was
369       ExplicitListOut _ _   -> pp_as_was
370       ExplicitTuple _ _     -> pp_as_was
371       HsPar _               -> pp_as_was
372
373       _                     -> parens pp_as_was
374 \end{code}
375
376 %************************************************************************
377 %*                                                                      *
378 \subsection{Record binds}
379 %*                                                                      *
380 %************************************************************************
381
382 \begin{code}
383 pp_rbinds :: (Outputable id, Outputable pat)
384               => SDoc 
385               -> HsRecordBinds id pat -> SDoc
386
387 pp_rbinds thing rbinds
388   = hang thing 
389          4 (braces (hsep (punctuate comma (map (pp_rbind) rbinds))))
390   where
391     pp_rbind (v, e, pun_flag) 
392       = getPprStyle $ \ sty ->
393         if pun_flag && userStyle sty then
394            ppr v
395         else
396            hsep [ppr v, char '=', ppr e]
397 \end{code}
398
399 %************************************************************************
400 %*                                                                      *
401 \subsection{Do stmts and list comprehensions}
402 %*                                                                      *
403 %************************************************************************
404
405 \begin{code}
406 data StmtCtxt   -- Context of a Stmt
407   = DoStmt              -- Do Statment
408   | ListComp            -- List comprehension
409   | CaseAlt             -- Guard on a case alternative
410   | PatBindRhs          -- Guard on a pattern binding
411   | FunRhs Name         -- Guard on a function defn for f
412   | LambdaBody          -- Body of a lambda abstraction
413                 
414 pprDo DoStmt stmts
415   = hang (ptext SLIT("do")) 2 (vcat (map ppr stmts))
416 pprDo ListComp stmts
417   = brackets $
418     hang (pprExpr expr <+> char '|')
419        4 (interpp'SP quals)
420   where
421     ReturnStmt expr = last stmts        -- Last stmt should be a ReturnStmt for list comps
422     quals           = init stmts
423 \end{code}
424
425 \begin{code}
426 data Stmt id pat
427   = BindStmt    pat
428                 (HsExpr id pat)
429                 SrcLoc
430
431   | LetStmt     (HsBinds id pat)
432
433   | GuardStmt   (HsExpr id pat)         -- List comps only
434                 SrcLoc
435
436   | ExprStmt    (HsExpr id pat)         -- Do stmts; and guarded things at the end
437                 SrcLoc
438
439   | ReturnStmt  (HsExpr id pat)         -- List comps only, at the end
440 \end{code}
441
442 \begin{code}
443 instance (Outputable id, Outputable pat) =>
444                 Outputable (Stmt id pat) where
445     ppr stmt = pprStmt stmt
446
447 pprStmt (BindStmt pat expr _)
448  = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
449 pprStmt (LetStmt binds)
450  = hsep [ptext SLIT("let"), pprBinds binds]
451 pprStmt (ExprStmt expr _)
452  = ppr expr
453 pprStmt (GuardStmt expr _)
454  = ppr expr
455 pprStmt (ReturnStmt expr)
456  = hsep [ptext SLIT("return"), ppr expr]    
457 \end{code}
458
459 %************************************************************************
460 %*                                                                      *
461 \subsection{Enumerations and list comprehensions}
462 %*                                                                      *
463 %************************************************************************
464
465 \begin{code}
466 data ArithSeqInfo id pat
467   = From            (HsExpr id pat)
468   | FromThen        (HsExpr id pat)
469                     (HsExpr id pat)
470   | FromTo          (HsExpr id pat)
471                     (HsExpr id pat)
472   | FromThenTo      (HsExpr id pat)
473                     (HsExpr id pat)
474                     (HsExpr id pat)
475 \end{code}
476
477 \begin{code}
478 instance (Outputable id, Outputable pat) =>
479                 Outputable (ArithSeqInfo id pat) where
480     ppr (From e1)               = hcat [ppr e1, pp_dotdot]
481     ppr (FromThen e1 e2)        = hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
482     ppr (FromTo e1 e3)  = hcat [ppr e1, pp_dotdot, ppr e3]
483     ppr (FromThenTo e1 e2 e3)
484       = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
485
486 pp_dotdot = ptext SLIT(" .. ")
487 \end{code}