[project @ 1996-01-08 20:28:12 by partain]
[ghc.git] / ghc / compiler / coreSyn / CoreSyn.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
3 %
4 \section[CoreSyn]{A data type for the Haskell compiler midsection}
5
6 \begin{code}
7 #include "HsVersions.h"
8
9 module CoreSyn (
10         CoreBinding(..), CoreExpr(..), CoreAtom(..),
11         CoreCaseAlternatives(..), CoreCaseDefault(..),
12 #ifdef DPH
13         CoreParQuals(..),
14         CoreParCommunicate(..),
15 #endif {- Data Parallel Haskell -}
16         mkCoTyApp,
17         pprCoreBinding, pprCoreExpr,
18
19         CoreArg(..), applyToArgs, decomposeArgs, collectArgs,
20
21         -- and to make the interface self-sufficient ...
22         Id, UniType, TyVar, TyCon, PrimOp, BasicLit,
23         PprStyle, PrettyRep, CostCentre, Maybe
24     ) where
25
26 import AbsPrel          ( PrimOp, PrimKind
27                           IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
28                           IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
29                         )
30 import AbsUniType       ( isPrimType, pprParendUniType, TyVar, TyCon, UniType
31                           IF_ATTACK_PRAGMAS(COMMA cmpTyCon COMMA cmpTyVar)
32                           IF_ATTACK_PRAGMAS(COMMA cmpUniType)
33                         )
34 import BasicLit         ( BasicLit )
35 import Id               ( getIdUniType, isBottomingId, Id
36                           IF_ATTACK_PRAGMAS(COMMA bottomIsGuaranteed)
37                         )
38 import Outputable
39 import Pretty
40 import CostCentre       ( showCostCentre, CostCentre )
41 import Util
42 \end{code}
43
44 %************************************************************************
45 %*                                                                      *
46 \subsection[CoreTopBinding_and_CoreBinding]{@CoreTopBinding@ and @CoreBinding@}
47 %*                                                                      *
48 %************************************************************************
49
50 Core programs, bindings, expressions, etc., are parameterised with
51 respect to the information kept about binding and bound occurrences of
52 variables, called {\em binders} and {\em bindees}, respectively.  [I
53 don't really like the pair of names; I prefer {\em binder} and {\em
54 bounder}.  Or {\em binder} and {\em var}.]
55
56 A @CoreBinding@ is either a single non-recursive binding of a
57 ``binder'' to an expression, or a mutually-recursive blob of same.
58 \begin{code}
59 data CoreBinding binder bindee
60   = CoNonRec    binder (CoreExpr binder bindee)
61   | CoRec       [(binder, CoreExpr binder bindee)]
62 \end{code}
63
64 %************************************************************************
65 %*                                                                      *
66 \subsection[CoreAtom]{Core atoms: @CoreAtom@}
67 %*                                                                      *
68 %************************************************************************
69
70 Same deal as @StgAtoms@, except that, for @Core@, the atomic object
71 may need to be applied to some types.
72
73 \begin{code}
74 data CoreAtom bindee
75   = CoVarAtom   bindee
76   | CoLitAtom   BasicLit
77 \end{code}
78
79 %************************************************************************
80 %*                                                                      *
81 \subsection[CoreExpr]{Core expressions: @CoreExpr@}
82 %*                                                                      *
83 %************************************************************************
84
85 @CoreExpr@ is the heart of the ``core'' data types; it is
86 (more-or-less) boiled-down second-order polymorphic lambda calculus.
87 For types in the core world, we just keep using @UniTypes@.
88 \begin{code}
89 data CoreExpr binder bindee
90      = CoVar    bindee
91      | CoLit    BasicLit        -- literal constants
92 \end{code}
93
94 @CoCons@ and @CoPrims@ are saturated constructor and primitive-op
95 applications (see the comment).  Note: @CoCon@s are only set up by the
96 simplifier (and by the desugarer when it knows what it's doing).  The
97 desugarer sets up constructors as applications of global @CoVars@s.
98 \begin{code}
99      | CoCon        Id [UniType] [CoreAtom bindee]
100                     -- saturated constructor application:
101                     -- the constructor is a function of the form:
102                     --  /\ a1 -> ... /\ am -> \ b1 -> ... \ bn ->
103                     -- <expr> where "/\" is a type lambda and "\" the
104                     -- regular kind; there will be "m" UniTypes and
105                     -- "n" bindees in the CoCon args.
106
107      | CoPrim       PrimOp [UniType] [CoreAtom bindee]
108                     -- saturated primitive operation;
109                     -- comment on CoCons applies here, too.
110                     -- The types work the same way
111                     -- (PrimitiveOps may be polymorphic).
112 \end{code}
113
114 Lambdas have multiple binders; this is good for the lambda lifter.
115 Single binders may be simulated easily with multiple binders; vice
116 versa is a pain.
117 \begin{code}
118      | CoLam        [binder]    -- lambda var_1 ... var_n -> CoreExpr
119                     (CoreExpr binder bindee)
120      | CoTyLam      TyVar       -- Lambda TyVar -> CoreExpr
121                     (CoreExpr binder bindee)
122
123      | CoApp        (CoreExpr binder bindee)
124                     (CoreAtom bindee)
125      | CoTyApp      (CoreExpr binder bindee)
126                     UniType     -- type application
127 \end{code}
128
129 Case expressions (\tr{case CoreExpr of <List of alternatives>}): there
130 are really two flavours masquerading here---those for scrutinising
131 {\em algebraic} types and those for {\em primitive} types.  Please see
132 under @CoreCaseAlternatives@.
133 \begin{code}
134      | CoCase       (CoreExpr binder bindee)
135                     (CoreCaseAlternatives binder bindee)
136 \end{code}
137
138 A Core case expression \tr{case e of v -> ...} implies evaluation of
139 \tr{e}; it is not equivalent to \tr{let v = in ...} (as with a Haskell
140 \tr{case}).
141
142 Non-recursive @CoLets@ only have one binding; having more than one
143 doesn't buy you much, and it is an easy way to mess up variable
144 scoping.
145 \begin{code}
146      | CoLet        (CoreBinding binder bindee)
147                     (CoreExpr binder bindee)
148                     -- both recursive and non-.
149                     -- The "CoreBinding" records that information
150 \end{code}
151
152 @build@ as a function is a *PAIN*. See Andy's thesis for
153 futher details. This is equivalent to:
154 @
155         build unitype (/\ tyvar \ c n -> expr)
156 @
157 \begin{code}
158 --ANDY:
159 --   | CoBuild UniType TyVar binder binder (CoreExpr binder bindee)
160 \end{code}
161
162 @CoZfExpr@ exist in the core language, along with their qualifiers. After
163 succesive optimisations to the sequential bindings, we desugar the 
164 @CoZfExpr@ into a subset of the core language without them - ``podization''.
165 \begin{code}
166 #ifdef DPH
167      | CoZfExpr     (CoreExpr binder bindee) 
168                     (CoreParQuals binder bindee)
169 #endif {- Data Parallel Haskell -}
170 \end{code}
171
172 @CoParCon@ is the parallel equivalent to the sequential @CoCon@ expression. 
173 They are introduced into the core syntax by a pass of the compiler that
174 removes the parallel ZF expressions, and {\em vectorises} ordinary sequential
175 functions.
176 \begin{code}
177 #ifdef DPH
178       | CoParCon  Id Int [UniType] [CoreExpr binder bindee] --ToDo:DPH: CoreAtom
179 #endif {- Data Parallel Haskell -}
180 \end{code}
181
182 @CoParCommunicate@ constructs are introduced by the desugaring of parallel
183 ZF expressions. 
184 \begin{code}
185 #ifdef DPH
186      | CoParComm
187                      Int
188                     (CoreExpr binder bindee)
189                     (CoreParCommunicate binder bindee)
190 #endif {- Data Parallel Haskell -}
191 \end{code}
192
193 @CoParZipWith@ constructs are introduced whenever podization fails during the
194 desuagring of ZF expressions. These constructs represent zipping the function
195 represented by the first @CoreExpr@ with the list of @CoreExpr@'s (hopefully
196 we wont see this that often in the resultant program :-).
197
198 \begin{code}
199 #ifdef DPH
200      | CoParZipWith
201                    Int
202                    (CoreExpr binder bindee)
203                    [CoreExpr binder bindee]
204 #endif {- Data Parallel Haskell -}
205 \end{code}
206
207 For cost centre scc expressions we introduce a new core construct
208 @CoSCC@ so transforming passes have to deal with it explicitly. The
209 alternative of using a new PrimativeOp may result in a bad
210 transformations of which we are unaware.
211 \begin{code}
212      | CoSCC        CostCentre                  -- label of scc
213                     (CoreExpr binder bindee)    -- scc expression
214
215 -- end of CoreExpr
216 \end{code}
217
218
219 %************************************************************************
220 %*                                                                      *
221 \subsection[CoreParQualifiers]{Parallel qualifiers in @CoreExpr@}
222 %*                                                                      *
223 %************************************************************************
224
225 \begin{code}
226 #ifdef DPH
227 data CoreParQuals binder bindee
228    = CoAndQuals  (CoreParQuals binder bindee)
229                  (CoreParQuals binder bindee)
230    | CoParFilter (CoreExpr binder bindee)
231    | CoDrawnGen  [binder]
232                  (binder)
233                  (CoreExpr binder bindee)       
234    | CoIndexGen  [CoreExpr binder bindee]
235                  (binder)
236                  (CoreExpr binder bindee)       
237 #endif {- Data Parallel Haskell -}
238 \end{code}
239
240 %************************************************************************
241 %*                                                                      *
242 \subsection[ParCommunicate]{Parallel Communication primitives}
243 %*                                                                      *
244 %************************************************************************
245 \begin{code}
246 #ifdef DPH
247 data CoreParCommunicate binder bindee
248   = CoParSend   [CoreExpr binder bindee]     -- fns of form Integer -> Integer
249   | CoParFetch  [CoreExpr binder bindee]     -- to determine where moved
250   | CoToPodized
251   | CoFromPodized
252 #endif {- Data Parallel Haskell -}
253 \end{code}
254
255 %************************************************************************
256 %*                                                                      *
257 \subsection[CoreCaseAlternatives]{Case alternatives in @CoreExpr@}
258 %*                                                                      *
259 %************************************************************************
260
261 We have different kinds of @case@s, the differences being reflected in
262 the kinds of alternatives a case has.  We maintain a distinction
263 between cases for scrutinising algebraic datatypes, as opposed to
264 primitive types.  In both cases, we carry around a @TyCon@, as a
265 handle with which we can get info about the case (e.g., total number
266 of data constructors for this type).
267
268 For example:
269 \begin{verbatim}
270 let# x=e in b
271 \end{verbatim}
272 becomes
273 \begin{verbatim}
274 CoCase e [ CoBindDefaultAlt x -> b ]
275 \end{verbatim}
276
277 \begin{code}
278 data CoreCaseAlternatives binder bindee
279
280   = CoAlgAlts   [(Id,                           -- alts: data constructor,
281                   [binder],                     -- constructor's parameters,
282                   CoreExpr binder bindee)]      -- rhs.
283                 (CoreCaseDefault binder bindee)
284
285   | CoPrimAlts  [(BasicLit,                     -- alts: unboxed literal,
286                   CoreExpr binder bindee)]      -- rhs.
287                 (CoreCaseDefault binder bindee)
288 #ifdef DPH
289   | CoParAlgAlts 
290                 TyCon
291                 Int
292                 [binder]
293                 [(Id,
294                   CoreExpr binder bindee)]
295                 (CoreCaseDefault binder bindee)
296
297   | CoParPrimAlts
298                 TyCon
299                 Int
300                 [(BasicLit,
301                   CoreExpr binder bindee)]
302                 (CoreCaseDefault binder bindee)
303 #endif {- Data Parallel Haskell -}
304
305 -- obvious things: if there are no alts in the list, then the default
306 -- can't be CoNoDefault.
307
308 data CoreCaseDefault binder bindee
309   = CoNoDefault                                 -- small con family: all
310                                                 -- constructor accounted for
311   | CoBindDefault   binder                      -- form: var -> expr;
312                     (CoreExpr binder bindee)    -- "binder" may or may not
313                                                 -- be used in RHS.
314 \end{code}
315
316 %************************************************************************
317 %*                                                                      *
318 \subsection[CoreSyn-arguments]{Core ``argument'' wrapper type}
319 %*                                                                      *
320 %************************************************************************
321
322 \begin{code}
323 data CoreArg bindee
324   = TypeArg UniType
325   | ValArg  (CoreAtom bindee)
326
327 instance Outputable bindee => Outputable (CoreArg bindee) where
328   ppr sty (ValArg atom) = ppr sty atom
329   ppr sty (TypeArg ty)  = ppr sty ty
330 \end{code}
331
332 \begin{code}
333 mkCoTyApp expr ty = CoTyApp expr ty
334
335 {- OLD: unboxed tyapps now allowed!
336 mkCoTyApp expr ty
337 #ifdef DEBUG
338   | isPrimType ty && not (error_app expr)
339   = pprPanic "mkCoTyApp:" (ppr PprDebug ty)
340 #endif
341   | otherwise = ty_app
342   where
343     ty_app = CoTyApp expr ty
344
345     error_app (CoVar id) {-| isBottomingId id-} = True -- debugging
346         -- OOPS! can't do this because it forces
347         -- the bindee type to be Id (ToDo: what?) WDP 95/02
348     error_app _ = False
349 -}
350 \end{code}
351
352 \begin{code}
353 applyToArgs :: CoreExpr binder bindee
354             -> [CoreArg bindee]
355             -> CoreExpr binder bindee
356
357 applyToArgs fun []                  = fun
358 applyToArgs fun (ValArg val : args) = applyToArgs (CoApp     fun val) args
359 applyToArgs fun (TypeArg ty : args) = applyToArgs (mkCoTyApp fun ty)  args
360 \end{code}
361
362 @decomposeArgs@ just pulls of the contiguous TypeArg-then-ValArg block
363 on the front of the args.  Pretty common.
364
365 \begin{code}
366 decomposeArgs :: [CoreArg bindee]
367               -> ([UniType], [CoreAtom bindee], [CoreArg bindee])
368
369 decomposeArgs [] = ([],[],[])
370
371 decomposeArgs (TypeArg ty : args)
372   = case (decomposeArgs args) of { (tys, vals, rest) ->
373     (ty:tys, vals, rest) }
374
375 decomposeArgs (ValArg val : args)
376   = case (do_vals args) of { (vals, rest) ->
377     ([], val:vals, rest) }
378   where
379     do_vals (ValArg val : args)
380       = case (do_vals args) of { (vals, rest) ->
381         (val:vals, rest) }
382         
383     do_vals args = ([], args)
384 \end{code}
385
386 @collectArgs@ takes an application expression, returning the function
387 and the arguments to which it is applied.
388
389 \begin{code}
390 collectArgs :: CoreExpr binder bindee
391             -> (CoreExpr binder bindee, [CoreArg bindee])
392
393 collectArgs expr
394   = collect expr []
395   where
396     collect (CoApp fun arg)  args = collect fun (ValArg arg : args)
397     collect (CoTyApp fun ty) args = collect fun (TypeArg ty : args)
398     collect other_expr args       = (other_expr, args)
399 \end{code}
400
401 %************************************************************************
402 %*                                                                      *
403 \subsection[CoreSyn-output]{Instance declarations for output}
404 %*                                                                      *
405 %************************************************************************
406
407 @pprCoreBinding@ and @pprCoreExpr@ let you give special printing
408 function for ``major'' binders (those next to equal signs :-),
409 ``minor'' ones (lambda-bound, case-bound), and bindees.  They would
410 usually be called through some intermediary.
411
412 \begin{code}
413 pprCoreBinding
414         :: PprStyle
415         -> (PprStyle -> bndr -> Pretty) -- to print "major" binders
416         -> (PprStyle -> bndr -> Pretty) -- to print "minor" binders
417         -> (PprStyle -> bdee -> Pretty) -- to print bindees
418         -> CoreBinding bndr bdee
419         -> Pretty
420
421 pprCoreBinding sty pbdr1 pbdr2 pbdee (CoNonRec binder expr)
422   = ppHang (ppCat [pbdr1 sty binder, ppEquals])
423          4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
424
425 pprCoreBinding sty pbdr1 pbdr2 pbdee (CoRec binds)
426   = ppAboves [ifPprDebug sty (ppStr "{- CoRec -}"),
427               ppAboves (map ppr_bind binds),
428               ifPprDebug sty (ppStr "{- end CoRec -}")]
429   where
430     ppr_bind (binder, expr)
431       = ppHang (ppCat [pbdr1 sty binder, ppEquals])
432              4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
433 \end{code}
434
435 \begin{code}
436 instance (Outputable bndr, Outputable bdee)
437                 => Outputable (CoreBinding bndr bdee) where
438     ppr sty bind = pprCoreBinding sty ppr ppr ppr bind
439
440 instance (Outputable bndr, Outputable bdee)
441                 => Outputable (CoreExpr bndr bdee) where
442     ppr sty expr = pprCoreExpr sty ppr ppr ppr expr
443
444 instance Outputable bdee => Outputable (CoreAtom bdee) where
445     ppr sty atom = pprCoreAtom sty ppr atom
446 \end{code}
447
448 \begin{code}
449 pprCoreAtom
450         :: PprStyle
451         -> (PprStyle -> bdee -> Pretty) -- to print bindees
452         -> CoreAtom bdee
453         -> Pretty
454
455 pprCoreAtom sty pbdee (CoLitAtom lit) = ppr sty lit
456 pprCoreAtom sty pbdee (CoVarAtom v)   = pbdee sty v
457 \end{code}
458
459 \begin{code}
460 pprCoreExpr, pprParendCoreExpr
461         :: PprStyle
462         -> (PprStyle -> bndr -> Pretty) -- to print "major" binders
463         -> (PprStyle -> bndr -> Pretty) -- to print "minor" binders
464         -> (PprStyle -> bdee -> Pretty) -- to print bindees
465         -> CoreExpr bndr bdee
466         -> Pretty
467
468 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoVar name) = pbdee sty name
469
470 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoLit literal) = ppr sty literal
471
472 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoCon con [] []) = ppr sty con
473
474 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoCon con types args)
475   = ppHang (ppBesides [ppr sty con, ppChar '!'])
476          4 (ppSep (  (map (pprParendUniType sty) types)
477                   ++ (map (pprCoreAtom sty pbdee) args)))
478
479 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoPrim prim tys args)
480   = ppHang (ppBesides [ppr sty prim, ppChar '!'])
481          4 (ppSep (  (map (pprParendUniType sty) tys)
482                   ++ (map (pprCoreAtom sty pbdee) args) ))
483
484 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoLam binders expr)
485   = ppHang (ppCat [ppStr "\\", ppInterleave ppSP (map (pbdr2 sty) binders), ppStr "->"])
486          4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
487
488 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoTyLam tyvar expr)
489   = ppHang (ppCat [ppStr "/\\", interppSP sty (tyvar:tyvars),
490                    ppStr "->", pp_varss var_lists])
491            4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr_after)
492   where
493     (tyvars, var_lists, expr_after) = collect_tyvars expr
494
495     collect_tyvars (CoTyLam tyv e) = ( tyv:tyvs, vs, e_after )
496       where (tyvs, vs, e_after) = collect_tyvars e
497     collect_tyvars e@(CoLam _ _)   = ( [], vss, e_after )
498       where (vss, e_after) = collect_vars e
499     collect_tyvars other_e         = ( [], [], other_e )
500
501     collect_vars (CoLam vars e) = (vars:varss, e_after)
502       where (varss, e_after) = collect_vars e
503     collect_vars other_e           = ( [], other_e )
504
505     pp_varss [] = ppNil
506     pp_varss (vars:varss)
507       = ppCat [ppStr "\\", ppInterleave ppSP (map (pbdr2 sty) vars),
508                ppStr "->", pp_varss varss]
509
510 pprCoreExpr sty pbdr1 pbdr2 pbdee expr@(CoApp fun_expr atom)
511   = let
512         (fun, args) = collect_args expr []
513     in
514     ppHang (pprParendCoreExpr sty pbdr1 pbdr2 pbdee fun)
515          4 (ppSep (map (pprCoreAtom sty pbdee) args))
516   where
517     collect_args (CoApp fun arg) args = collect_args fun (arg:args)
518     collect_args fun             args = (fun, args)
519
520 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoTyApp expr ty)
521   = ppHang (ppBeside pp_note (pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr))
522          4 (pprParendUniType sty ty)
523   where
524     pp_note = ifPprShowAll sty (ppStr "{-CoTyApp-} ")
525
526 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoCase expr alts)
527   = ppSep [ppSep [ppStr "case", ppNest 4 (pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr),
528                      ppStr "of {"],
529            ppNest 2 (pprCoreCaseAlts sty pbdr1 pbdr2 pbdee alts),
530            ppStr "}"]
531
532 -- special cases: let ... in let ...
533 -- ("disgusting" SLPJ)
534
535 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoLet bind@(CoNonRec binder rhs@(CoLet _ _)) body)
536   = ppAboves [
537       ppCat [ppStr "let {", pbdr1 sty binder, ppEquals],
538       ppNest 2 (pprCoreExpr sty pbdr1 pbdr2 pbdee rhs),
539       ppStr "} in",
540       pprCoreExpr sty pbdr1 pbdr2 pbdee body ]
541
542 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoLet bind@(CoNonRec binder rhs) expr@(CoLet _ _))
543   = ppAbove
544       (ppHang (ppStr "let {")
545             2 (ppCat [ppHang (ppCat [pbdr1 sty binder, ppEquals])
546                            4 (pprCoreExpr sty pbdr1 pbdr2 pbdee rhs),
547        ppStr "} in"]))
548       (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
549
550 -- general case (recursive case, too)
551 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoLet bind expr)
552   = ppSep [ppHang (ppStr "let {") 2 (pprCoreBinding sty pbdr1 pbdr2 pbdee bind),
553            ppHang (ppStr "} in ") 2 (pprCoreExpr    sty pbdr1 pbdr2 pbdee expr)]
554
555 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoSCC cc expr)
556   = ppSep [ ppCat [ppStr "_scc_", ppStr (showCostCentre sty True{-as string-} cc)],
557             pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr ]
558 #ifdef DPH
559 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoZfExpr expr quals)
560     = ppHang (ppCat [ppStr "<<" , pprCoreExpr sty pbdr1 pbdr2 pbdee expr , ppStr "|"])
561          4 (ppSep [pprParQuals sty pbdr1 pbdr2 pbdee quals, ppStr ">>"])
562
563 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoParCon con dim types args)
564   = ppHang (ppBesides [ppr sty con, ppStr "!<<" , ppr sty dim , ppStr ">>"])
565            4 (ppSep (  (map (pprParendUniType sty) types)
566                     ++ (map (pprParendCoreExpr sty pbdr1 pbdr2 pbdee) args) ))
567
568 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoParComm dim expr comType)
569   = ppSep [ppSep [ppStr "COMM",
570                   ppNest 2 (pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr),ppStr "{"],
571            ppNest 2 (ppr sty comType),
572            ppStr "}"]
573
574 pprCoreExpr sty pbdr1 pbdr2 pbdee (CoParZipWith dim expr exprs)
575   = ppHang (ppBesides [ ppStr "CoParZipWith {" , ppr sty dim , ppStr "}",
576                         pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr])
577            4 (ppr sty exprs)
578 #endif {- Data Parallel Haskell -}
579 \end{code}
580
581 \begin{code}
582 pprParendCoreExpr sty pbdr1 pbdr2 pbdee e@(CoVar _) = pprCoreExpr sty pbdr1 pbdr2 pbdee e
583 pprParendCoreExpr sty pbdr1 pbdr2 pbdee e@(CoLit _) = pprCoreExpr sty pbdr1 pbdr2 pbdee e
584 pprParendCoreExpr sty pbdr1 pbdr2 pbdee other_e
585   = ppBesides [ppLparen, pprCoreExpr sty pbdr1 pbdr2 pbdee other_e, ppRparen]
586 \end{code}
587
588 \begin{code}
589 instance (Outputable bndr, Outputable bdee)
590                 => Outputable (CoreCaseAlternatives bndr bdee) where
591     ppr sty alts = pprCoreCaseAlts sty ppr ppr ppr alts
592 \end{code}
593
594 \begin{code}
595 pprCoreCaseAlts
596         :: PprStyle
597         -> (PprStyle -> bndr -> Pretty) -- to print "major" binders
598         -> (PprStyle -> bndr -> Pretty) -- to print "minor" binders
599         -> (PprStyle -> bdee -> Pretty) -- to print bindees
600         -> CoreCaseAlternatives bndr bdee
601         -> Pretty
602
603 pprCoreCaseAlts sty pbdr1 pbdr2 pbdee (CoAlgAlts alts deflt)
604   = ppAboves [ ppAboves (map ppr_alt alts),
605                pprCoreCaseDefault sty pbdr1 pbdr2 pbdee deflt ]
606   where
607     ppr_alt (con, params, expr)
608       = ppHang (ppCat [ppr_con con,
609                        ppInterleave ppSP (map (pbdr2 sty) params),
610                        ppStr "->"])
611                 4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
612       where
613         ppr_con con
614           = if isOpLexeme con
615             then ppBesides [ppLparen, ppr sty con, ppRparen]
616             else ppr sty con
617
618 pprCoreCaseAlts sty pbdr1 pbdr2 pbdee (CoPrimAlts alts deflt)
619   = ppAboves [ ppAboves (map ppr_alt alts),
620                pprCoreCaseDefault sty pbdr1 pbdr2 pbdee deflt ]
621   where
622     ppr_alt (lit, expr)
623       = ppHang (ppCat [ppr sty lit, ppStr "->"])
624              4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
625
626 #ifdef DPH
627 -- ToDo: niceties of printing
628 -- using special binder/bindee printing funs, rather than just "ppr"
629
630 pprCoreCaseAlts sty pbdr1 pbdr2 pbdee (CoParAlgAlts tycon dim params alts deflt)
631   = ppAboves [ ifPprShowAll sty (ppr sty tycon),
632                ppBeside (ppCat (map (ppr sty) params))
633                         (ppCat [ppStr "|" , ppr sty dim , ppStr "|"]),
634                ppAboves (map (ppr_alt sty) alts),
635                ppr sty deflt ]
636   where
637     ppr_alt sty (con, expr)
638       = ppHang (ppCat [ppStr "\\/", ppr_con sty con, ppStr "->"])
639                 4 (ppr sty expr)
640       where
641         ppr_con sty con
642           = if isOpLexeme con
643             then ppBesides [ppLparen, ppr sty con, ppRparen]
644             else ppr sty con
645
646 pprCoreCaseAlts sty pbdr1 pbdr2 pbdee (CoParPrimAlts tycon dim alts deflt)
647   = ppAboves [ ifPprShowAll sty (ppr sty tycon),
648                ppCat [ppStr "|" , ppr sty dim , ppStr "|"],
649                ppAboves (map (ppr_alt sty) alts),
650                ppr sty deflt ]
651   where
652     ppr_alt sty (lit, expr)
653       = ppHang (ppCat [ppStr "\\/", ppr sty lit, ppStr "->"]) 4 (ppr sty expr)
654
655 #endif /* Data Parallel Haskell */
656 \end{code}
657
658 \begin{code}
659 instance (Outputable bndr, Outputable bdee)
660                 => Outputable (CoreCaseDefault bndr bdee) where
661     ppr sty deflt  = pprCoreCaseDefault sty ppr ppr ppr deflt
662 \end{code}
663
664 \begin{code}
665 pprCoreCaseDefault
666         :: PprStyle
667         -> (PprStyle -> bndr -> Pretty) -- to print "major" binders
668         -> (PprStyle -> bndr -> Pretty) -- to print "minor" binders
669         -> (PprStyle -> bdee -> Pretty) -- to print bindees
670         -> CoreCaseDefault bndr bdee
671         -> Pretty
672
673 pprCoreCaseDefault sty pbdr1 pbdr2 pbdee CoNoDefault = ppNil
674
675 pprCoreCaseDefault sty pbdr1 pbdr2 pbdee (CoBindDefault binder expr)
676   = ppHang (ppCat [pbdr2 sty binder, ppStr "->"])
677          4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
678 \end{code}
679
680 \begin{code}
681 #ifdef DPH
682 instance (Outputable bndr, Outputable bdee)
683                 => Outputable (CoreParQuals bndr bdee) where
684     ppr sty qual = pprParQuals sty ppr ppr ppr qual
685
686 pprParQuals sty pbdr1 pbdr2 pbdee (CoAndQuals x y) 
687      = ppAboves [(ppBesides [pprParQuals sty pbdr1 pbdr2 pbdee x , ppComma]) , pprParQuals sty pbdr1 pbdr2 pbdee y]
688
689 pprParQuals sty pbdr1 pbdr2 pbdee (CoDrawnGen pats pat expr)
690      = ppCat [ppStr "(|",
691               ppInterleave ppComma (map (ppr sty) pats),
692               ppSemi, ppr sty pat,ppStr "|)",
693               ppStr "<<-", pprCoreExpr sty pbdr1 pbdr2 pbdee expr]
694
695 pprParQuals sty pbdr1 pbdr2 pbdee (CoIndexGen exprs pat expr)
696      = ppCat [ppStr "(|",
697               ppInterleave ppComma (map (pprCoreExpr sty pbdr1 pbdr2 pbdee) exprs),
698               ppSemi, ppr sty pat,ppStr "|)",
699               ppStr "<<=", pprCoreExpr sty pbdr1 pbdr2 pbdee expr]
700
701 pprParQuals sty pbdr1 pbdr2 pbdee (CoParFilter expr)
702      = pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr
703 #endif {- Data Parallel Haskell -}
704 \end{code}
705
706 \begin{code}
707 #ifdef DPH
708 instance (Outputable bndr, Outputable bdee)
709                 => Outputable (CoreParCommunicate bndr bdee) where
710     ppr sty c = pprCoreParCommunicate sty ppr ppr ppr c
711
712 pprCoreParCommunicate sty pbdr1 pbdr2 pbdee (CoParSend fns)
713   = ppHang 
714        (ppStr "SEND") 
715         4 
716         (ppAboves (zipWith ppSendFns fns ([1..]::[Int])))
717   where
718      ppSendFns expr dim 
719         = ppCat [ppStr "Dim" , ppr sty dim , ppStr "=" , 
720                  pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr ]
721
722 pprCoreParCommunicate sty pbdr1 pbdr2 pbdee (CoParFetch fns)
723   = ppHang 
724         (ppStr "FETCH") 
725         4 
726         (ppAboves (zipWith ppSendFns fns ([1..]::[Int])))
727   where
728      ppSendFns expr dim 
729         = ppCat [ppStr "Dim" , ppr sty dim , ppStr "=" , 
730                  pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr ]
731
732 pprCoreParCommunicate sty pbdr1 pbdr2 pbdee (CoToPodized)
733   = ppStr "ConvertToPodized"
734
735 pprCoreParCommunicate sty pbdr1 pbdr2 pbdee (CoFromPodized)
736   = ppStr "ConvertFromPodized"
737 #endif {- Data Parallel Haskell -}
738 \end{code}