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(..),
13 bindersOf, pairsFromCoreBinds, rhssOfBind,
15 mkGenApp, mkValApp, mkTyApp,
19 collectBinders, collectValBinders, collectTyBinders,
20 isValBinder, notValBinder,
22 collectArgs, initialTyArgs, initialValArgs, isValArg, notValArg, numValArgs,
24 mkCoLetAny, mkCoLetNoUnboxed, mkCoLetUnboxedToCase,
25 mkCoLetsAny, mkCoLetsNoUnboxed, mkCoLetsUnboxedToCase,
26 mkCoLetrecAny, mkCoLetrecNoUnboxed,
30 -- Common type instantiation...
38 -- And not-so-common type instantiations...
44 TaggedCoreCaseDefault,
46 SimplifiableCoreBinding,
48 SimplifiableCoreBinder,
50 SimplifiableCoreCaseAlts,
51 SimplifiableCoreCaseDefault
54 #include "HsVersions.h"
56 import CostCentre ( showCostCentre, CostCentre )
57 import Id ( idType, GenId{-instance Eq-}, Id )
58 import Type ( isUnboxedType,GenType, Type )
59 import TyVar ( GenTyVar, TyVar )
60 import Util ( panic, assertPanic {-pprTrace:ToDo:rm-} )
61 import BinderInfo ( BinderInfo )
62 import BasicTypes ( Unused )
63 import Literal ( Literal )
64 import PrimOp ( PrimOp )
67 %************************************************************************
69 \subsection[CoreTopBinding_and_CoreBinding]{@CoreTopBinding@ and @GenCoreBinding@}
71 %************************************************************************
73 Core programs, bindings, expressions, etc., are parameterised with
74 respect to the information kept about binding and bound occurrences of
75 variables, called {\em binders} and {\em val_occ tyvar uvars}, respectively. [I
76 don't really like the pair of names; I prefer {\em binder} and {\em
77 bounder}. Or {\em binder} and {\em var}.]
79 A @GenCoreBinding@ is either a single non-recursive binding of a
80 ``binder'' to an expression, or a mutually-recursive blob of same.
82 data GenCoreBinding val_bdr val_occ flexi
83 = NonRec val_bdr (GenCoreExpr val_bdr val_occ flexi)
84 | Rec [(val_bdr, GenCoreExpr val_bdr val_occ flexi)]
88 bindersOf :: GenCoreBinding val_bdr val_occ flexi -> [val_bdr]
91 [GenCoreBinding val_bdr val_occ flexi] ->
92 [(val_bdr, GenCoreExpr val_bdr val_occ flexi)]
94 rhssOfBind :: GenCoreBinding val_bdr val_occ flexi -> [GenCoreExpr val_bdr val_occ flexi]
96 bindersOf (NonRec binder _) = [binder]
97 bindersOf (Rec pairs) = [binder | (binder, _) <- pairs]
99 pairsFromCoreBinds [] = []
100 pairsFromCoreBinds ((NonRec b e) : bs) = (b,e) : pairsFromCoreBinds bs
101 pairsFromCoreBinds ((Rec pairs) : bs) = pairs ++ pairsFromCoreBinds bs
103 rhssOfBind (NonRec _ rhs) = [rhs]
104 rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs]
107 %************************************************************************
109 \subsection[GenCoreExpr]{Core expressions: @GenCoreExpr@}
111 %************************************************************************
113 @GenCoreExpr@ is the heart of the ``core'' data types; it is
114 (more-or-less) boiled-down second-order polymorphic lambda calculus.
115 For types in the core world, we just keep using @Types@.
117 data GenCoreExpr val_bdr val_occ flexi
119 | Lit Literal -- literal constants
122 @Cons@ and @Prims@ are saturated constructor and primitive-op
123 applications (see the comment). Note: @Con@s are only set up by the
124 simplifier (and by the desugarer when it knows what it's doing). The
125 desugarer sets up constructors as applications of global @Vars@s.
128 | Con Id [GenCoreArg val_occ flexi]
129 -- Saturated constructor application:
130 -- The constructor is a function of the form:
131 -- /\ a1 -> ... /\ am -> \ b1 -> ... \ bn ->
132 -- <expr> where "/\" is a type lambda and "\" the
133 -- regular kind; there will be "m" Types and
134 -- "n" bindees in the Con args.
136 | Prim PrimOp [GenCoreArg val_occ flexi]
137 -- saturated primitive operation;
139 -- comment on Cons applies here, too.
142 Ye olde abstraction and application operators.
144 | Lam (GenCoreBinder val_bdr flexi)
145 (GenCoreExpr val_bdr val_occ flexi)
147 | App (GenCoreExpr val_bdr val_occ flexi)
148 (GenCoreArg val_occ flexi)
151 Case expressions (\tr{case <expr> of <List of alternatives>}): there
152 are really two flavours masquerading here---those for scrutinising
153 {\em algebraic} types and those for {\em primitive} types. Please see
154 under @GenCoreCaseAlts@.
156 | Case (GenCoreExpr val_bdr val_occ flexi)
157 (GenCoreCaseAlts val_bdr val_occ flexi)
160 A Core case expression \tr{case e of v -> ...} implies evaluation of
161 \tr{e}; it is not equivalent to \tr{let v = in ...} (as with a Haskell
164 Non-recursive @Lets@ only have one binding; having more than one
165 doesn't buy you much, and it is an easy way to mess up variable
168 | Let (GenCoreBinding val_bdr val_occ flexi)
169 (GenCoreExpr val_bdr val_occ flexi)
170 -- both recursive and non-.
171 -- The "GenCoreBinding" records that information
174 For cost centre scc expressions we introduce a new core construct
175 @SCC@ so transforming passes have to deal with it explicitly. The
176 alternative of using a new PrimativeOp may result in a bad
177 transformations of which we are unaware.
179 | SCC CostCentre -- label of scc
180 (GenCoreExpr val_bdr val_occ flexi) -- scc expression
183 Coercions arise from uses of the constructor of a @newtype@
184 declaration, either in construction (resulting in a @CoreceIn@) or
185 pattern matching (resulting in a @CoerceOut@).
189 (GenType flexi) -- Type of the whole expression
190 (GenCoreExpr val_bdr val_occ flexi)
194 data Coercion = CoerceIn Id -- Apply this constructor
195 | CoerceOut Id -- Strip this constructor
199 %************************************************************************
201 \subsection{Core-constructing functions with checking}
203 %************************************************************************
205 When making @Lets@, we may want to take evasive action if the thing
206 being bound has unboxed type. We have different variants ...
208 @mkCoLet(s|rec)Any@ let-binds any binding, regardless of type
209 @mkCoLet(s|rec)NoUnboxed@ prohibits unboxed bindings
210 @mkCoLet(s)UnboxedToCase@ converts an unboxed binding to a case
211 (unboxed bindings in a letrec are still prohibited)
214 mkCoLetAny :: GenCoreBinding Id Id flexi
215 -> GenCoreExpr Id Id flexi
216 -> GenCoreExpr Id Id flexi
217 mkCoLetsAny :: [GenCoreBinding Id Id flexi] ->
218 GenCoreExpr Id Id flexi ->
219 GenCoreExpr Id Id flexi
221 mkCoLetrecAny :: [(val_bdr, GenCoreExpr val_bdr val_occ flexi)]
222 -> GenCoreExpr val_bdr val_occ flexi
223 -> GenCoreExpr val_bdr val_occ flexi
225 mkCoLetrecAny [] body = body
226 mkCoLetrecAny binds body = Let (Rec binds) body
228 mkCoLetsAny [] expr = expr
229 mkCoLetsAny binds expr = foldr mkCoLetAny expr binds
231 mkCoLetAny bind@(Rec binds) body = mkCoLetrecAny binds body
232 mkCoLetAny bind@(NonRec binder rhs) body = Let bind body
236 mkCoLetNoUnboxed bind@(Rec binds) body
237 = mkCoLetrecNoUnboxed binds body
239 mkCoLetNoUnboxed bind@(NonRec binder rhs) body
240 = --ASSERT (not (isUnboxedType (idType binder)))
242 Var binder2 | binder == binder2
243 -> rhs -- hey, I have the rhs
247 mkCoLetsNoUnboxed [] expr = expr
248 mkCoLetsNoUnboxed binds expr = foldr mkCoLetNoUnboxed expr binds
250 mkCoLetrecNoUnboxed [] body = body
251 mkCoLetrecNoUnboxed binds body
252 = ASSERT (all is_boxed_bind binds)
255 is_boxed_bind (binder, rhs)
256 = (not . isUnboxedType . idType) binder
260 mkCoLetUnboxedToCase bind@(Rec binds) body
261 = mkCoLetrecNoUnboxed binds body
263 mkCoLetUnboxedToCase bind@(NonRec binder rhs) body
265 Var binder2 | binder == binder2
266 -> rhs -- hey, I have the rhs
268 -> if (not (isUnboxedType (idType binder))) then
269 Let bind body -- boxed...
271 Case rhs -- unboxed...
273 (BindDefault binder body))
275 mkCoLetsUnboxedToCase [] expr = expr
276 mkCoLetsUnboxedToCase binds expr = foldr mkCoLetUnboxedToCase expr binds
279 %************************************************************************
281 \subsection{Case alternatives in @GenCoreExpr@}
283 %************************************************************************
285 We have different kinds of @case@s, the differences being reflected in
286 the kinds of alternatives a case has. We maintain a distinction
287 between cases for scrutinising algebraic datatypes, as opposed to
288 primitive types. In both cases, we carry around a @TyCon@, as a
289 handle with which we can get info about the case (e.g., total number
290 of data constructors for this type).
298 Case e [ BindDefaultAlt x -> b ]
302 data GenCoreCaseAlts val_bdr val_occ flexi
303 = AlgAlts [(Id, -- alts: data constructor,
304 [val_bdr], -- constructor's parameters,
305 GenCoreExpr val_bdr val_occ flexi)] -- rhs.
306 (GenCoreCaseDefault val_bdr val_occ flexi)
308 | PrimAlts [(Literal, -- alts: unboxed literal,
309 GenCoreExpr val_bdr val_occ flexi)] -- rhs.
310 (GenCoreCaseDefault val_bdr val_occ flexi)
312 -- obvious things: if there are no alts in the list, then the default
313 -- can't be NoDefault.
315 data GenCoreCaseDefault val_bdr val_occ flexi
316 = NoDefault -- small con family: all
317 -- constructor accounted for
318 | BindDefault val_bdr -- form: var -> expr;
319 (GenCoreExpr val_bdr val_occ flexi) -- "val_bdr" may or may not
324 rhssOfAlts (AlgAlts alts deflt) = rhssOfDeflt deflt ++ [rhs | (_,_,rhs) <- alts]
325 rhssOfAlts (PrimAlts alts deflt) = rhssOfDeflt deflt ++ [rhs | (_,rhs) <- alts]
327 rhssOfDeflt NoDefault = []
328 rhssOfDeflt (BindDefault _ rhs) = [rhs]
331 %************************************************************************
333 \subsection{Core binders}
335 %************************************************************************
338 data GenCoreBinder val_bdr flexi
340 | TyBinder (GenTyVar flexi)
342 isValBinder (ValBinder _) = True
343 isValBinder _ = False
345 notValBinder = not . isValBinder
348 Clump Lams together if possible.
351 mkValLam :: [val_bdr]
352 -> GenCoreExpr val_bdr val_occ flexi
353 -> GenCoreExpr val_bdr val_occ flexi
354 mkTyLam :: [GenTyVar flexi]
355 -> GenCoreExpr val_bdr val_occ flexi
356 -> GenCoreExpr val_bdr val_occ flexi
358 mkValLam binders body = foldr (Lam . ValBinder) body binders
359 mkTyLam binders body = foldr (Lam . TyBinder) body binders
361 mkLam :: [GenTyVar flexi] -> [val_bdr] -- ToDo: could add a [uvar] arg...
362 -> GenCoreExpr val_bdr val_occ flexi
363 -> GenCoreExpr val_bdr val_occ flexi
365 mkLam tyvars valvars body
366 = mkTyLam tyvars (mkValLam valvars body)
369 We often want to strip off leading lambdas before getting down to
370 business. @collectBinders@ is your friend.
372 We expect (by convention) usage-, type-, and value- lambdas in that
377 GenCoreExpr val_bdr val_occ flexi ->
378 ([GenTyVar flexi], [val_bdr], GenCoreExpr val_bdr val_occ flexi)
381 = case collectValBinders body1 of { (vals,body) -> (tyvars, vals, body) }
383 (tyvars, body1) = collectTyBinders expr
385 collectTyBinders expr
388 tyvars (Lam (TyBinder t) body) tacc = tyvars body (t:tacc)
389 tyvars other tacc = (reverse tacc, other)
391 collectValBinders :: GenCoreExpr val_bdr val_occ flexi ->
392 ([val_bdr], GenCoreExpr val_bdr val_occ flexi)
393 collectValBinders expr
396 go acc (Lam (ValBinder v) b) = go (v:acc) b
397 go acc body = (reverse acc, body)
401 %************************************************************************
403 \subsection{Core arguments (atoms)}
405 %************************************************************************
408 data GenCoreArg val_occ flexi
411 | TyArg (GenType flexi)
414 General and specific forms:
416 mkGenApp :: GenCoreExpr val_bdr val_occ flexi
417 -> [GenCoreArg val_occ flexi]
418 -> GenCoreExpr val_bdr val_occ flexi
419 mkTyApp :: GenCoreExpr val_bdr val_occ flexi
421 -> GenCoreExpr val_bdr val_occ flexi
422 mkValApp :: GenCoreExpr val_bdr val_occ flexi
423 -> [GenCoreArg val_occ flexi] -- but we ASSERT they are LitArg or VarArg
424 -> GenCoreExpr val_bdr val_occ flexi
426 mkGenApp f args = foldl App f args
427 mkTyApp f args = foldl (\ e a -> App e (TyArg a)) f args
428 mkValApp f args = foldl (\ e a -> App e (is_Lit_or_Var a)) f args
434 = if isValArg a then a else panic "CoreSyn.mkValApps:not LitArg or VarArg"
437 isValArg (LitArg _) = True -- often used for sanity-checking
438 isValArg (VarArg _) = True
441 notValArg = not . isValArg -- exists only because it's a common use of isValArg
443 numValArgs as = length [ a | a <- as, isValArg a ] -- again, convenience
447 mkApp fun = mk_thing (mkGenApp fun)
448 mkCon con = mk_thing (Con con)
449 mkPrim op = mk_thing (Prim op)
451 mk_thing thing tys vals
452 = ASSERT( all isValArg vals )
453 thing (map TyArg tys ++ vals)
456 @collectArgs@ takes an application expression, returning the function
457 and the arguments to which it is applied.
460 collectArgs :: GenCoreExpr val_bdr val_occ flexi
461 -> (GenCoreExpr val_bdr val_occ flexi,
463 [GenCoreArg val_occ flexi]{-ValArgs-})
468 valvars (App fun v) vacc | isValArg v = valvars fun (v:vacc)
470 = case (tyvars fun []) of { (expr, tacc) ->
473 tyvars (App fun (TyArg t)) tacc = tyvars fun (t:tacc)
474 tyvars fun tacc = (expr, tacc)
479 initialTyArgs :: [GenCoreArg val_occ flexi]
480 -> ([GenType flexi], [GenCoreArg val_occ flexi])
481 initialTyArgs (TyArg ty : args) = (ty:tys, args')
483 (tys, args') = initialTyArgs args
484 initialTyArgs other = ([],other)
486 initialValArgs :: [GenCoreArg val_occ flexi]
487 -> ([GenCoreArg val_occ flexi], [GenCoreArg val_occ flexi])
488 initialValArgs args = span isValArg args
492 %************************************************************************
494 \subsection{The main @Core*@ instantiation of the @GenCore*@ types}
496 %************************************************************************
499 type CoreBinding = GenCoreBinding Id Id Unused
500 type CoreExpr = GenCoreExpr Id Id Unused
501 type CoreBinder = GenCoreBinder Id Unused
502 type CoreArg = GenCoreArg Id Unused
504 type CoreCaseAlts = GenCoreCaseAlts Id Id Unused
505 type CoreCaseDefault = GenCoreCaseDefault Id Id Unused
508 %************************************************************************
510 \subsection{The @TaggedCore*@ instantiation of the @GenCore*@ types}
512 %************************************************************************
514 Binders are ``tagged'' with a \tr{t}:
516 type Tagged t = (Id, t)
518 type TaggedCoreBinding t = GenCoreBinding (Tagged t) Id Unused
519 type TaggedCoreExpr t = GenCoreExpr (Tagged t) Id Unused
520 type TaggedCoreBinder t = GenCoreBinder (Tagged t) Unused
521 type TaggedCoreArg t = GenCoreArg Id Unused
523 type TaggedCoreCaseAlts t = GenCoreCaseAlts (Tagged t) Id Unused
524 type TaggedCoreCaseDefault t = GenCoreCaseDefault (Tagged t) Id Unused
527 %************************************************************************
529 \subsection{The @SimplifiableCore*@ instantiation of the @GenCore*@ types}
531 %************************************************************************
533 Binders are tagged with @BinderInfo@:
535 type Simplifiable = (Id, BinderInfo)
537 type SimplifiableCoreBinding = GenCoreBinding Simplifiable Id Unused
538 type SimplifiableCoreExpr = GenCoreExpr Simplifiable Id Unused
539 type SimplifiableCoreBinder = GenCoreBinder Simplifiable Unused
540 type SimplifiableCoreArg = GenCoreArg Id Unused
542 type SimplifiableCoreCaseAlts = GenCoreCaseAlts Simplifiable Id Unused
543 type SimplifiableCoreCaseDefault = GenCoreCaseDefault Simplifiable Id Unused