2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[CoreSyn]{A data type for the Haskell compiler midsection}
8 GenCoreBinding(..), GenCoreExpr(..),
9 GenCoreArg(..), GenCoreBinder(..), GenCoreCaseAlts(..),
10 GenCoreCaseDefault(..), CoreNote(..),
12 bindersOf, pairsFromCoreBinds, rhssOfBind,
14 mkGenApp, mkValApp, mkTyApp,
18 collectBinders, collectValBinders, collectTyBinders,
19 isValBinder, notValBinder,
21 collectArgs, initialTyArgs, initialValArgs, isValArg, notValArg, numValArgs,
23 mkCoLetAny, mkCoLetNoUnboxed, mkCoLetUnboxedToCase,
24 mkCoLetsAny, mkCoLetsNoUnboxed, mkCoLetsUnboxedToCase,
25 mkCoLetrecAny, mkCoLetrecNoUnboxed,
29 -- Common type instantiation...
37 -- And not-so-common type instantiations...
43 TaggedCoreCaseDefault,
45 SimplifiableCoreBinding,
47 SimplifiableCoreBinder,
49 SimplifiableCoreCaseAlts,
50 SimplifiableCoreCaseDefault
53 #include "HsVersions.h"
55 import CostCentre ( CostCentre )
56 import Id ( idType, Id )
57 import Type ( isUnboxedType,GenType, Type )
58 import TyVar ( GenTyVar, TyVar )
59 import Util ( panic, assertPanic )
60 import BinderInfo ( BinderInfo )
61 import BasicTypes ( Unused )
62 import Literal ( Literal )
63 import PrimOp ( PrimOp )
66 %************************************************************************
68 \subsection[CoreTopBinding_and_CoreBinding]{@CoreTopBinding@ and @GenCoreBinding@}
70 %************************************************************************
72 Core programs, bindings, expressions, etc., are parameterised with
73 respect to the information kept about binding and bound occurrences of
74 variables, called {\em binders} and {\em val_occ tyvar uvars}, respectively. [I
75 don't really like the pair of names; I prefer {\em binder} and {\em
76 bounder}. Or {\em binder} and {\em var}.]
78 A @GenCoreBinding@ is either a single non-recursive binding of a
79 ``binder'' to an expression, or a mutually-recursive blob of same.
81 data GenCoreBinding val_bdr val_occ flexi
82 = NonRec val_bdr (GenCoreExpr val_bdr val_occ flexi)
83 | Rec [(val_bdr, GenCoreExpr val_bdr val_occ flexi)]
87 bindersOf :: GenCoreBinding val_bdr val_occ flexi -> [val_bdr]
90 [GenCoreBinding val_bdr val_occ flexi] ->
91 [(val_bdr, GenCoreExpr val_bdr val_occ flexi)]
93 rhssOfBind :: GenCoreBinding val_bdr val_occ flexi -> [GenCoreExpr val_bdr val_occ flexi]
95 bindersOf (NonRec binder _) = [binder]
96 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
98 pairsFromCoreBinds [] = []
99 pairsFromCoreBinds ((NonRec b e) : bs) = (b,e) : pairsFromCoreBinds bs
100 pairsFromCoreBinds ((Rec pairs) : bs) = pairs ++ pairsFromCoreBinds bs
102 rhssOfBind (NonRec _ rhs) = [rhs]
103 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
106 %************************************************************************
108 \subsection[GenCoreExpr]{Core expressions: @GenCoreExpr@}
110 %************************************************************************
112 @GenCoreExpr@ is the heart of the ``core'' data types; it is
113 (more-or-less) boiled-down second-order polymorphic lambda calculus.
114 For types in the core world, we just keep using @Types@.
116 data GenCoreExpr val_bdr val_occ flexi
118 | Lit Literal -- literal constants
121 @Cons@ and @Prims@ are saturated constructor and primitive-op
122 applications (see the comment). Note: @Con@s are only set up by the
123 simplifier (and by the desugarer when it knows what it's doing). The
124 desugarer sets up constructors as applications of global @Vars@s.
127 | Con Id [GenCoreArg val_occ flexi]
128 -- Saturated constructor application:
129 -- The constructor is a function of the form:
130 -- /\ a1 -> ... /\ am -> \ b1 -> ... \ bn ->
131 -- <expr> where "/\" is a type lambda and "\" the
132 -- regular kind; there will be "m" Types and
133 -- "n" bindees in the Con args.
135 | Prim PrimOp [GenCoreArg val_occ flexi]
136 -- saturated primitive operation;
138 -- comment on Cons applies here, too.
141 Ye olde abstraction and application operators.
143 | Lam (GenCoreBinder val_bdr flexi)
144 (GenCoreExpr val_bdr val_occ flexi)
146 | App (GenCoreExpr val_bdr val_occ flexi)
147 (GenCoreArg val_occ flexi)
150 Case expressions (\tr{case <expr> of <List of alternatives>}): there
151 are really two flavours masquerading here---those for scrutinising
152 {\em algebraic} types and those for {\em primitive} types. Please see
153 under @GenCoreCaseAlts@.
155 | Case (GenCoreExpr val_bdr val_occ flexi)
156 (GenCoreCaseAlts val_bdr val_occ flexi)
159 A Core case expression \tr{case e of v -> ...} implies evaluation of
160 \tr{e}; it is not equivalent to \tr{let v = in ...} (as with a Haskell
163 Non-recursive @Lets@ only have one binding; having more than one
164 doesn't buy you much, and it is an easy way to mess up variable
167 | Let (GenCoreBinding val_bdr val_occ flexi)
168 (GenCoreExpr val_bdr val_occ flexi)
169 -- both recursive and non-.
170 -- The "GenCoreBinding" records that information
173 A @Note@ annotates a @CoreExpr@ with useful information
176 | Note (CoreNote flexi)
177 (GenCoreExpr val_bdr val_occ flexi)
181 %************************************************************************
183 \subsection{Core-notes}
185 %************************************************************************
193 (GenType flexi) -- The to-type: type of whole coerce expression
194 (GenType flexi) -- The from-type: type of enclosed expression
196 | InlineCall -- Instructs simplifier to inline
202 %************************************************************************
204 \subsection{Core-constructing functions with checking}
206 %************************************************************************
208 When making @Lets@, we may want to take evasive action if the thing
209 being bound has unboxed type. We have different variants ...
211 @mkCoLet(s|rec)Any@ let-binds any binding, regardless of type
212 @mkCoLet(s|rec)NoUnboxed@ prohibits unboxed bindings
213 @mkCoLet(s)UnboxedToCase@ converts an unboxed binding to a case
214 (unboxed bindings in a letrec are still prohibited)
217 mkCoLetAny :: GenCoreBinding Id Id flexi
218 -> GenCoreExpr Id Id flexi
219 -> GenCoreExpr Id Id flexi
220 mkCoLetsAny :: [GenCoreBinding Id Id flexi] ->
221 GenCoreExpr Id Id flexi ->
222 GenCoreExpr Id Id flexi
224 mkCoLetrecAny :: [(val_bdr, GenCoreExpr val_bdr val_occ flexi)]
225 -> GenCoreExpr val_bdr val_occ flexi
226 -> GenCoreExpr val_bdr val_occ flexi
228 mkCoLetrecAny [] body = body
229 mkCoLetrecAny binds body = Let (Rec binds) body
231 mkCoLetsAny [] expr = expr
232 mkCoLetsAny binds expr = foldr mkCoLetAny expr binds
234 mkCoLetAny bind@(Rec binds) body = mkCoLetrecAny binds body
235 mkCoLetAny bind@(NonRec binder rhs) body = Let bind body
239 mkCoLetNoUnboxed bind@(Rec binds) body
240 = mkCoLetrecNoUnboxed binds body
242 mkCoLetNoUnboxed bind@(NonRec binder rhs) body
243 = --ASSERT (not (isUnboxedType (idType binder)))
245 Var binder2 | binder == binder2
246 -> rhs -- hey, I have the rhs
250 mkCoLetsNoUnboxed [] expr = expr
251 mkCoLetsNoUnboxed binds expr = foldr mkCoLetNoUnboxed expr binds
253 mkCoLetrecNoUnboxed [] body = body
254 mkCoLetrecNoUnboxed binds body
255 = ASSERT (all is_boxed_bind binds)
258 is_boxed_bind (binder, rhs)
259 = (not . isUnboxedType . idType) binder
263 mkCoLetUnboxedToCase bind@(Rec binds) body
264 = mkCoLetrecNoUnboxed binds body
266 mkCoLetUnboxedToCase bind@(NonRec binder rhs) body
268 Var binder2 | binder == binder2
269 -> rhs -- hey, I have the rhs
271 -> if (not (isUnboxedType (idType binder))) then
272 Let bind body -- boxed...
274 Case rhs -- unboxed...
276 (BindDefault binder body))
278 mkCoLetsUnboxedToCase [] expr = expr
279 mkCoLetsUnboxedToCase binds expr = foldr mkCoLetUnboxedToCase expr binds
282 %************************************************************************
284 \subsection{Case alternatives in @GenCoreExpr@}
286 %************************************************************************
288 We have different kinds of @case@s, the differences being reflected in
289 the kinds of alternatives a case has. We maintain a distinction
290 between cases for scrutinising algebraic datatypes, as opposed to
291 primitive types. In both cases, we carry around a @TyCon@, as a
292 handle with which we can get info about the case (e.g., total number
293 of data constructors for this type).
301 Case e [ BindDefaultAlt x -> b ]
305 data GenCoreCaseAlts val_bdr val_occ flexi
306 = AlgAlts [(Id, -- alts: data constructor,
307 [val_bdr], -- constructor's parameters,
308 GenCoreExpr val_bdr val_occ flexi)] -- rhs.
309 (GenCoreCaseDefault val_bdr val_occ flexi)
311 | PrimAlts [(Literal, -- alts: unboxed literal,
312 GenCoreExpr val_bdr val_occ flexi)] -- rhs.
313 (GenCoreCaseDefault val_bdr val_occ flexi)
315 -- obvious things: if there are no alts in the list, then the default
316 -- can't be NoDefault.
318 data GenCoreCaseDefault val_bdr val_occ flexi
319 = NoDefault -- small con family: all
320 -- constructor accounted for
321 | BindDefault val_bdr -- form: var -> expr;
322 (GenCoreExpr val_bdr val_occ flexi) -- "val_bdr" may or may not
327 rhssOfAlts (AlgAlts alts deflt) = rhssOfDeflt deflt ++ [rhs | (_,_,rhs) <- alts]
328 rhssOfAlts (PrimAlts alts deflt) = rhssOfDeflt deflt ++ [rhs | (_,rhs) <- alts]
330 rhssOfDeflt NoDefault = []
331 rhssOfDeflt (BindDefault _ rhs) = [rhs]
334 %************************************************************************
336 \subsection{Core binders}
338 %************************************************************************
341 data GenCoreBinder val_bdr flexi
343 | TyBinder (GenTyVar flexi)
345 isValBinder (ValBinder _) = True
346 isValBinder _ = False
348 notValBinder = not . isValBinder
351 Clump Lams together if possible.
354 mkValLam :: [val_bdr]
355 -> GenCoreExpr val_bdr val_occ flexi
356 -> GenCoreExpr val_bdr val_occ flexi
357 mkTyLam :: [GenTyVar flexi]
358 -> GenCoreExpr val_bdr val_occ flexi
359 -> GenCoreExpr val_bdr val_occ flexi
361 mkValLam binders body = foldr (Lam . ValBinder) body binders
362 mkTyLam binders body = foldr (Lam . TyBinder) body binders
364 mkLam :: [GenTyVar flexi] -> [val_bdr] -- ToDo: could add a [uvar] arg...
365 -> GenCoreExpr val_bdr val_occ flexi
366 -> GenCoreExpr val_bdr val_occ flexi
368 mkLam tyvars valvars body
369 = mkTyLam tyvars (mkValLam valvars body)
372 We often want to strip off leading lambdas before getting down to
373 business. @collectBinders@ is your friend.
375 We expect (by convention) usage-, type-, and value- lambdas in that
380 GenCoreExpr val_bdr val_occ flexi ->
381 ([GenTyVar flexi], [val_bdr], GenCoreExpr val_bdr val_occ flexi)
384 = case collectValBinders body1 of { (vals,body) -> (tyvars, vals, body) }
386 (tyvars, body1) = collectTyBinders expr
388 collectTyBinders expr
391 tyvars (Lam (TyBinder t) body) tacc = tyvars body (t:tacc)
392 tyvars other tacc = (reverse tacc, other)
394 collectValBinders :: GenCoreExpr val_bdr val_occ flexi ->
395 ([val_bdr], GenCoreExpr val_bdr val_occ flexi)
396 collectValBinders expr
399 go acc (Lam (ValBinder v) b) = go (v:acc) b
400 go acc body = (reverse acc, body)
404 %************************************************************************
406 \subsection{Core arguments (atoms)}
408 %************************************************************************
411 data GenCoreArg val_occ flexi
414 | TyArg (GenType flexi)
417 General and specific forms:
419 mkGenApp :: GenCoreExpr val_bdr val_occ flexi
420 -> [GenCoreArg val_occ flexi]
421 -> GenCoreExpr val_bdr val_occ flexi
422 mkTyApp :: GenCoreExpr val_bdr val_occ flexi
424 -> GenCoreExpr val_bdr val_occ flexi
425 mkValApp :: GenCoreExpr val_bdr val_occ flexi
426 -> [GenCoreArg val_occ flexi] -- but we ASSERT they are LitArg or VarArg
427 -> GenCoreExpr val_bdr val_occ flexi
429 mkGenApp f args = foldl App f args
430 mkTyApp f args = foldl (\ e a -> App e (TyArg a)) f args
431 mkValApp f args = foldl (\ e a -> App e (is_Lit_or_Var a)) f args
437 = if isValArg a then a else panic "CoreSyn.mkValApps:not LitArg or VarArg"
440 isValArg (LitArg _) = True -- often used for sanity-checking
441 isValArg (VarArg _) = True
444 notValArg = not . isValArg -- exists only because it's a common use of isValArg
446 numValArgs as = length [ a | a <- as, isValArg a ] -- again, convenience
450 mkApp fun = mk_thing (mkGenApp fun)
451 mkCon con = mk_thing (Con con)
452 mkPrim op = mk_thing (Prim op)
454 mk_thing :: ([GenCoreArg val_occ flexi] -> GenCoreExpr val_bdr val_occ flexi)
456 -> [GenCoreArg val_occ flexi]
457 -> GenCoreExpr val_bdr val_occ flexi
458 mk_thing thing tys vals
459 = ASSERT( all isValArg vals )
460 thing (map TyArg tys ++ vals)
463 @collectArgs@ takes an application expression, returning the function
464 and the arguments to which it is applied.
467 collectArgs :: GenCoreExpr val_bdr val_occ flexi
468 -> (GenCoreExpr val_bdr val_occ flexi,
470 [GenCoreArg val_occ flexi]{-ValArgs-})
475 valvars (App fun v) vacc | isValArg v = valvars fun (v:vacc)
477 = case (tyvars fun []) of { (expr, tacc) ->
480 tyvars (App fun (TyArg t)) tacc = tyvars fun (t:tacc)
481 tyvars fun tacc = (expr, tacc)
486 initialTyArgs :: [GenCoreArg val_occ flexi]
487 -> ([GenType flexi], [GenCoreArg val_occ flexi])
488 initialTyArgs (TyArg ty : args) = (ty:tys, args')
490 (tys, args') = initialTyArgs args
491 initialTyArgs other = ([],other)
493 initialValArgs :: [GenCoreArg val_occ flexi]
494 -> ([GenCoreArg val_occ flexi], [GenCoreArg val_occ flexi])
495 initialValArgs args = span isValArg args
499 %************************************************************************
501 \subsection{The main @Core*@ instantiation of the @GenCore*@ types}
503 %************************************************************************
506 type CoreBinding = GenCoreBinding Id Id Unused
507 type CoreExpr = GenCoreExpr Id Id Unused
508 type CoreBinder = GenCoreBinder Id Unused
509 type CoreArg = GenCoreArg Id Unused
511 type CoreCaseAlts = GenCoreCaseAlts Id Id Unused
512 type CoreCaseDefault = GenCoreCaseDefault Id Id Unused
515 %************************************************************************
517 \subsection{The @TaggedCore*@ instantiation of the @GenCore*@ types}
519 %************************************************************************
521 Binders are ``tagged'' with a \tr{t}:
523 type Tagged t = (Id, t)
525 type TaggedCoreBinding t = GenCoreBinding (Tagged t) Id Unused
526 type TaggedCoreExpr t = GenCoreExpr (Tagged t) Id Unused
527 type TaggedCoreBinder t = GenCoreBinder (Tagged t) Unused
528 type TaggedCoreArg t = GenCoreArg Id Unused
530 type TaggedCoreCaseAlts t = GenCoreCaseAlts (Tagged t) Id Unused
531 type TaggedCoreCaseDefault t = GenCoreCaseDefault (Tagged t) Id Unused
534 %************************************************************************
536 \subsection{The @SimplifiableCore*@ instantiation of the @GenCore*@ types}
538 %************************************************************************
540 Binders are tagged with @BinderInfo@:
542 type Simplifiable = (Id, BinderInfo)
544 type SimplifiableCoreBinding = GenCoreBinding Simplifiable Id Unused
545 type SimplifiableCoreExpr = GenCoreExpr Simplifiable Id Unused
546 type SimplifiableCoreBinder = GenCoreBinder Simplifiable Unused
547 type SimplifiableCoreArg = GenCoreArg Id Unused
549 type SimplifiableCoreCaseAlts = GenCoreCaseAlts Simplifiable Id Unused
550 type SimplifiableCoreCaseDefault = GenCoreCaseDefault Simplifiable Id Unused