2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[StgSyn]{Shared term graph (STG) syntax for spineless-tagless code generation}
6 This data type represents programs just before code generation
7 (conversion to @AbstractC@): basically, what we have is a stylised
8 form of @CoreSyntax@, the style being one that happens to be ideally
9 suited to spineless tagless code generation.
16 GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
17 GenStgCaseAlts(..), GenStgCaseDefault(..),
19 UpdateFlag(..), isUpdatable,
22 stgArgOcc, stgUnsatOcc, stgStdHeapOcc, stgNoUpdHeapOcc,
23 stgNormalOcc, stgFakeFunAppOcc,
26 -- a set of synonyms for the most common (only :-) parameterisation
28 StgBinding, StgExpr, StgRhs,
29 StgCaseAlts, StgCaseDefault,
34 pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs,
35 getArgPrimRep, pprStgAlts,
36 isLitLitArg, isDllConApp, isStgTypeArg,
44 #include "HsVersions.h"
46 import CostCentre ( CostCentreStack, CostCentre )
47 import Id ( Id, idName, idPrimRep, idType )
48 import Name ( isDllName )
49 import Literal ( Literal, literalType, isLitLitLit, literalPrimRep )
50 import DataCon ( DataCon, dataConName )
51 import PrimOp ( PrimOp )
54 import TyCon ( TyCon )
55 import UniqSet ( isEmptyUniqSet, uniqSetToList, UniqSet )
58 %************************************************************************
60 \subsection{@GenStgBinding@}
62 %************************************************************************
64 As usual, expressions are interesting; other things are boring. Here
65 are the boring things [except note the @GenStgRhs@], parameterised
66 with respect to binder and occurrence information (just as in
70 data GenStgBinding bndr occ
71 = StgNonRec bndr (GenStgRhs bndr occ)
72 | StgRec [(bndr, GenStgRhs bndr occ)]
75 %************************************************************************
77 \subsection{@GenStgArg@}
79 %************************************************************************
85 | StgTypeArg Type -- For when we want to preserve all type info
89 getArgPrimRep (StgVarArg local) = idPrimRep local
90 getArgPrimRep (StgLitArg lit) = literalPrimRep lit
92 isLitLitArg (StgLitArg lit) = isLitLitLit lit
95 isStgTypeArg (StgTypeArg _) = True
96 isStgTypeArg other = False
98 isDllArg :: StgArg -> Bool
99 -- Does this argument refer to something in a different DLL?
100 isDllArg (StgVarArg v) = isDllName (idName v)
101 isDllArg (StgLitArg lit) = isLitLitLit lit
103 isDllConApp :: DataCon -> [StgArg] -> Bool
104 -- Does this constructor application refer to
105 -- anything in a different DLL?
106 -- If so, we can't allocate it statically
107 isDllConApp con args = isDllName (dataConName con) || any isDllArg args
109 stgArgType :: StgArg -> Type
110 -- Very half baked becase we have lost the type arguments
111 stgArgType (StgVarArg v) = idType v
112 stgArgType (StgLitArg lit) = literalType lit
115 %************************************************************************
117 \subsection{STG expressions}
119 %************************************************************************
121 The @GenStgExpr@ data type is parameterised on binder and occurrence
124 %************************************************************************
126 \subsubsection{@GenStgExpr@ application}
128 %************************************************************************
130 An application is of a function to a list of atoms [not expressions].
131 Operationally, we want to push the arguments on the stack and call the
132 function. (If the arguments were expressions, we would have to build
133 their closures first.)
135 There is no constructor for a lone variable; it would appear as
138 type GenStgLiveVars occ = UniqSet occ
140 data GenStgExpr bndr occ
143 [GenStgArg occ] -- arguments; may be empty
146 %************************************************************************
148 \subsubsection{@StgConApp@ and @StgPrimApp@---saturated applications}
150 %************************************************************************
152 There are a specialised forms of application, for
153 constructors, primitives, and literals.
158 [GenStgArg occ] -- Saturated
161 [GenStgArg occ] -- Saturated
162 Type -- Result type; we need to know the result type
163 -- so that we can assign result registers.
166 %************************************************************************
168 \subsubsection{@StgLam@}
170 %************************************************************************
172 StgLam is used *only* during CoreToStg's work. Before CoreToStg has finished
173 it encodes (\x -> e) as (let f = \x -> e in f)
177 Type -- Type of whole lambda (useful when making a binder for it)
179 StgExpr -- Body of lambda
183 %************************************************************************
185 \subsubsection{@GenStgExpr@: case-expressions}
187 %************************************************************************
189 This has the same boxed/unboxed business as Core case expressions.
192 (GenStgExpr bndr occ)
193 -- the thing to examine
195 (GenStgLiveVars occ) -- Live vars of whole case
196 -- expression; i.e., those which mustn't be
199 (GenStgLiveVars occ) -- Live vars of RHSs;
200 -- i.e., those which must be saved before eval.
202 -- note that an alt's constructor's
203 -- binder-variables are NOT counted in the
204 -- free vars for the alt's RHS
206 bndr -- binds the result of evaluating the scrutinee
208 SRT -- The SRT for the continuation
210 (GenStgCaseAlts bndr occ)
213 %************************************************************************
215 \subsubsection{@GenStgExpr@: @let(rec)@-expressions}
217 %************************************************************************
219 The various forms of let(rec)-expression encode most of the
220 interesting things we want to do.
224 let-closure x = [free-vars] expr [args]
229 let x = (\free-vars -> \args -> expr) free-vars
231 \tr{args} may be empty (and is for most closures). It isn't under
232 circumstances like this:
238 let-closure x = [z] [y] (y+z)
240 The idea is that we compile code for @(y+z)@ in an environment in which
241 @z@ is bound to an offset from \tr{Node}, and @y@ is bound to an
242 offset from the stack pointer.
244 (A let-closure is an @StgLet@ with a @StgRhsClosure@ RHS.)
248 let-constructor x = Constructor [args]
252 (A let-constructor is an @StgLet@ with a @StgRhsCon@ RHS.)
255 Letrec-expressions are essentially the same deal as
256 let-closure/let-constructor, so we use a common structure and
257 distinguish between them with an @is_recursive@ boolean flag.
261 let-unboxed u = an arbitrary arithmetic expression in unboxed values
264 All the stuff on the RHS must be fully evaluated. No function calls either!
266 (We've backed away from this toward case-expressions with
267 suitably-magical alts ...)
270 ~[Advanced stuff here! Not to start with, but makes pattern matching
271 generate more efficient code.]
274 let-escapes-not fail = expr
277 Here the idea is that @e'@ guarantees not to put @fail@ in a data structure,
278 or pass it to another function. All @e'@ will ever do is tail-call @fail@.
279 Rather than build a closure for @fail@, all we need do is to record the stack
280 level at the moment of the @let-escapes-not@; then entering @fail@ is just
281 a matter of adjusting the stack pointer back down to that point and entering
286 f x y = let z = huge-expression in
292 (A let-escapes-not is an @StgLetNoEscape@.)
295 We may eventually want:
297 let-literal x = Literal
301 (ToDo: is this obsolete?)
304 And so the code for let(rec)-things:
307 (GenStgBinding bndr occ) -- right hand sides (see below)
308 (GenStgExpr bndr occ) -- body
310 | StgLetNoEscape -- remember: ``advanced stuff''
311 (GenStgLiveVars occ) -- Live in the whole let-expression
312 -- Mustn't overwrite these stack slots
313 -- *Doesn't* include binders of the let(rec).
315 (GenStgLiveVars occ) -- Live in the right hand sides (only)
316 -- These are the ones which must be saved on
317 -- the stack if they aren't there already
318 -- *Does* include binders of the let(rec) if recursive.
320 (GenStgBinding bndr occ) -- right hand sides (see below)
321 (GenStgExpr bndr occ) -- body
324 %************************************************************************
326 \subsubsection{@GenStgExpr@: @scc@ expressions}
328 %************************************************************************
330 Finally for @scc@ expressions we introduce a new STG construct.
334 CostCentre -- label of SCC expression
335 (GenStgExpr bndr occ) -- scc expression
339 %************************************************************************
341 \subsection{STG right-hand sides}
343 %************************************************************************
345 Here's the rest of the interesting stuff for @StgLet@s; the first
346 flavour is for closures:
348 data GenStgRhs bndr occ
350 CostCentreStack -- CCS to be attached (default is CurrentCCS)
351 StgBinderInfo -- Info about how this binder is used (see below)
352 SRT -- The closures's SRT
353 [occ] -- non-global free vars; a list, rather than
354 -- a set, because order is important
355 UpdateFlag -- ReEntrant | Updatable | SingleEntry
356 [bndr] -- arguments; if empty, then not a function;
357 -- as above, order is important.
358 (GenStgExpr bndr occ) -- body
360 An example may be in order. Consider:
362 let t = \x -> \y -> ... x ... y ... p ... q in e
364 Pulling out the free vars and stylising somewhat, we get the equivalent:
366 let t = (\[p,q] -> \[x,y] -> ... x ... y ... p ...q) p q
368 Stg-operationally, the @[x,y]@ are on the stack, the @[p,q]@ are
369 offsets from @Node@ into the closure, and the code ptr for the closure
370 will be exactly that in parentheses above.
372 The second flavour of right-hand-side is for constructors (simple but important):
375 CostCentreStack -- CCS to be attached (default is CurrentCCS).
376 -- Top-level (static) ones will end up with
377 -- DontCareCCS, because we don't count static
378 -- data in heap profiles, and we don't set CCCS
379 -- from static closure.
380 DataCon -- constructor
381 [GenStgArg occ] -- args
384 Here's the @StgBinderInfo@ type, and its combining op:
389 Bool -- At least one occurrence as an argument
391 Bool -- At least one occurrence in an unsaturated application
393 Bool -- This thing (f) has at least occurrence of the form:
394 -- x = [..] \u [] -> f a b c
395 -- where the application is saturated
397 Bool -- Ditto for non-updatable x.
399 Bool -- At least one fake application occurrence, that is
400 -- an StgApp f args where args is an empty list
401 -- This is due to the fact that we do not have a
402 -- StgVar constructor.
403 -- Used by the lambda lifter.
404 -- True => "at least one unsat app" is True too
406 stgArgOcc = StgBinderInfo True False False False False
407 stgUnsatOcc = StgBinderInfo False True False False False
408 stgStdHeapOcc = StgBinderInfo False False True False False
409 stgNoUpdHeapOcc = StgBinderInfo False False False True False
410 stgNormalOcc = StgBinderInfo False False False False False
411 -- [Andre] can't think of a good name for the last one.
412 stgFakeFunAppOcc = StgBinderInfo False True False False True
414 combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
416 combineStgBinderInfo NoStgBinderInfo info2 = info2
417 combineStgBinderInfo info1 NoStgBinderInfo = info1
418 combineStgBinderInfo (StgBinderInfo arg1 unsat1 std_heap1 upd_heap1 fkap1)
419 (StgBinderInfo arg2 unsat2 std_heap2 upd_heap2 fkap2)
420 = StgBinderInfo (arg1 || arg2)
422 (std_heap1 || std_heap2)
423 (upd_heap1 || upd_heap2)
427 %************************************************************************
429 \subsection[Stg-case-alternatives]{STG case alternatives}
431 %************************************************************************
433 Just like in @CoreSyntax@ (except no type-world stuff).
435 * Algebraic cases are done using
436 StgAlgAlts (Just tc) alts deflt
438 * Polymorphic cases, or case of a function type, are done using
439 StgAlgAlts Nothing [] (StgBindDefault e)
441 * Primitive cases are done using
442 StgPrimAlts tc alts deflt
444 We thought of giving polymorphic cases their own constructor,
445 but we get a bit more code sharing this way
447 The type constructor in StgAlgAlts/StgPrimAlts is guaranteed not
448 to be abstract; that is, we can see its representation. This is
449 important because the code generator uses it to determine return
450 conventions etc. But it's not trivial where there's a moduule loop
451 involved, because some versions of a type constructor might not have
452 all the constructors visible. So mkStgAlgAlts (in CoreToStg) ensures
453 that it gets the TyCon from the constructors or literals (which are
454 guaranteed to have the Real McCoy) rather than from the scrutinee type.
457 data GenStgCaseAlts bndr occ
458 = StgAlgAlts (Maybe TyCon) -- Just tc => scrutinee type is
459 -- an algebraic data type
460 -- Nothing => scrutinee type is a type
461 -- variable or function type
462 [(DataCon, -- alts: data constructor,
463 [bndr], -- constructor's parameters,
464 [Bool], -- "use mask", same length as
465 -- parameters; a True in a
466 -- param's position if it is
468 GenStgExpr bndr occ)] -- ...right-hand side.
469 (GenStgCaseDefault bndr occ)
472 [(Literal, -- alts: unboxed literal,
473 GenStgExpr bndr occ)] -- rhs.
474 (GenStgCaseDefault bndr occ)
476 data GenStgCaseDefault bndr occ
477 = StgNoDefault -- small con family: all
478 -- constructor accounted for
479 | StgBindDefault (GenStgExpr bndr occ)
482 %************************************************************************
484 \subsection[Stg]{The Plain STG parameterisation}
486 %************************************************************************
488 This happens to be the only one we use at the moment.
491 type StgBinding = GenStgBinding Id Id
492 type StgArg = GenStgArg Id
493 type StgLiveVars = GenStgLiveVars Id
494 type StgExpr = GenStgExpr Id Id
495 type StgRhs = GenStgRhs Id Id
496 type StgCaseAlts = GenStgCaseAlts Id Id
497 type StgCaseDefault = GenStgCaseDefault Id Id
500 %************************************************************************
502 \subsubsection[UpdateFlag-datatype]{@UpdateFlag@}
504 %************************************************************************
506 This is also used in @LambdaFormInfo@ in the @ClosureInfo@ module.
508 A @ReEntrant@ closure may be entered multiple times, but should not be
509 updated or blackholed. An @Updatable@ closure should be updated after
510 evaluation (and may be blackholed during evaluation). A @SingleEntry@
511 closure will only be entered once, and so need not be updated but may
512 safely be blackholed.
515 data UpdateFlag = ReEntrant | Updatable | SingleEntry
517 instance Outputable UpdateFlag where
519 = char (case u of { ReEntrant -> 'r'; Updatable -> 'u'; SingleEntry -> 's' })
521 isUpdatable ReEntrant = False
522 isUpdatable SingleEntry = False
523 isUpdatable Updatable = True
526 %************************************************************************
528 \subsubsection[Static Reference Tables]{@SRT@}
530 %************************************************************************
532 There is one SRT per top-level function group. Each local binding and
533 case expression within this binding group has a subrange of the whole
534 SRT, expressed as an offset and length.
538 | SRT !Int{-offset-} !Int{-length-}
543 pprSRT (NoSRT) = ptext SLIT("_no_srt_")
544 pprSRT (SRT off len) = parens (ppr off <> comma <> ppr len)
547 %************************************************************************
549 \subsection[Stg-pretty-printing]{Pretty-printing}
551 %************************************************************************
553 Robin Popplestone asked for semi-colon separators on STG binds; here's
554 hoping he likes terminators instead... Ditto for case alternatives.
557 pprGenStgBinding :: (Outputable bndr, Outputable bdee, Ord bdee)
558 => GenStgBinding bndr bdee -> SDoc
560 pprGenStgBinding (StgNonRec bndr rhs)
561 = hang (hsep [ppr bndr, equals])
562 4 ((<>) (ppr rhs) semi)
564 pprGenStgBinding (StgRec pairs)
565 = vcat ((ifPprDebug (ptext SLIT("{- StgRec (begin) -}"))) :
566 (map (ppr_bind) pairs) ++ [(ifPprDebug (ptext SLIT("{- StgRec (end) -}")))])
568 ppr_bind (bndr, expr)
569 = hang (hsep [ppr bndr, equals])
570 4 ((<>) (ppr expr) semi)
572 pprStgBinding :: StgBinding -> SDoc
573 pprStgBinding bind = pprGenStgBinding bind
575 pprStgBindings :: [StgBinding] -> SDoc
576 pprStgBindings binds = vcat (map pprGenStgBinding binds)
578 pprGenStgBindingWithSRT
579 :: (Outputable bndr, Outputable bdee, Ord bdee)
580 => (GenStgBinding bndr bdee,[Id]) -> SDoc
582 pprGenStgBindingWithSRT (bind,srt)
583 = vcat [ pprGenStgBinding bind,
584 ptext SLIT("SRT: ") <> ppr srt ]
586 pprStgBindingsWithSRTs :: [(StgBinding,[Id])] -> SDoc
587 pprStgBindingsWithSRTs binds = vcat (map pprGenStgBindingWithSRT binds)
591 instance (Outputable bdee) => Outputable (GenStgArg bdee) where
594 instance (Outputable bndr, Outputable bdee, Ord bdee)
595 => Outputable (GenStgBinding bndr bdee) where
596 ppr = pprGenStgBinding
598 instance (Outputable bndr, Outputable bdee, Ord bdee)
599 => Outputable (GenStgExpr bndr bdee) where
602 instance (Outputable bndr, Outputable bdee, Ord bdee)
603 => Outputable (GenStgRhs bndr bdee) where
604 ppr rhs = pprStgRhs rhs
608 pprStgArg :: (Outputable bdee) => GenStgArg bdee -> SDoc
610 pprStgArg (StgVarArg var) = ppr var
611 pprStgArg (StgLitArg con) = ppr con
612 pprStgArg (StgTypeArg ty) = char '@' <+> ppr ty
616 pprStgExpr :: (Outputable bndr, Outputable bdee, Ord bdee)
617 => GenStgExpr bndr bdee -> SDoc
619 pprStgExpr (StgLit lit) = ppr lit
622 pprStgExpr (StgApp func args)
624 4 (sep (map (ppr) args))
628 pprStgExpr (StgConApp con args)
629 = hsep [ ppr con, brackets (interppSP args)]
631 pprStgExpr (StgPrimApp op args _)
632 = hsep [ ppr op, brackets (interppSP args)]
634 pprStgExpr (StgLam _ bndrs body)
635 =sep [ char '\\' <+> ppr bndrs <+> ptext SLIT("->"),
640 -- special case: let v = <very specific thing>
646 -- Very special! Suspicious! (SLPJ)
648 pprStgExpr (StgLet (StgNonRec bndr (StgRhsClosure cc bi srt free_vars upd_flag args rhs))
651 (hang (hcat [ptext SLIT("let { "), ppr bndr, ptext SLIT(" = "),
654 ptext SLIT(" ["), ifPprDebug (interppSP free_vars), ptext SLIT("] \\"),
655 ppr upd_flag, ptext SLIT(" ["),
656 interppSP args, char ']'])
657 8 (sep [hsep [ppr rhs, ptext SLIT("} in")]]))
660 -- special case: let ... in let ...
662 pprStgExpr (StgLet bind expr@(StgLet _ _))
664 (sep [hang (ptext SLIT("let {")) 2 (hsep [pprGenStgBinding bind, ptext SLIT("} in")])])
668 pprStgExpr (StgLet bind expr)
669 = sep [hang (ptext SLIT("let {")) 2 (pprGenStgBinding bind),
670 hang (ptext SLIT("} in ")) 2 (ppr expr)]
672 pprStgExpr (StgLetNoEscape lvs_whole lvs_rhss bind expr)
673 = sep [hang (ptext SLIT("let-no-escape {"))
674 2 (pprGenStgBinding bind),
675 hang ((<>) (ptext SLIT("} in "))
678 hcat [ptext SLIT("-- lvs: ["), interppSP (uniqSetToList lvs_whole),
679 ptext SLIT("]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
685 pprStgExpr (StgSCC cc expr)
686 = sep [ hsep [ptext SLIT("_scc_"), ppr cc],
691 pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alts)
692 = sep [sep [ptext SLIT("case"),
693 nest 4 (hsep [pprStgExpr expr,
694 ifPprDebug (dcolon <+> pp_ty alts)]),
695 ptext SLIT("of"), ppr bndr, char '{'],
698 hcat [ptext SLIT("-- lvs: ["), interppSP (uniqSetToList lvs_whole),
699 ptext SLIT("]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
702 nest 2 (pprStgAlts alts),
705 pp_ty (StgAlgAlts maybe_tycon _ _) = ppr maybe_tycon
706 pp_ty (StgPrimAlts tycon _ _) = ppr tycon
708 pprStgAlts (StgAlgAlts _ alts deflt)
709 = vcat [ vcat (map (ppr_bxd_alt) alts),
710 pprStgDefault deflt ]
712 ppr_bxd_alt (con, params, use_mask, expr)
713 = hang (hsep [ppr con, interppSP params, ptext SLIT("->")])
714 4 ((<>) (ppr expr) semi)
716 pprStgAlts (StgPrimAlts _ alts deflt)
717 = vcat [ vcat (map (ppr_ubxd_alt) alts),
718 pprStgDefault deflt ]
720 ppr_ubxd_alt (lit, expr)
721 = hang (hsep [ppr lit, ptext SLIT("->")])
722 4 ((<>) (ppr expr) semi)
724 pprStgDefault StgNoDefault = empty
725 pprStgDefault (StgBindDefault expr) = hang (hsep [ptext SLIT("DEFAULT"), ptext SLIT("->")])
731 pprStgLVs :: Outputable occ => GenStgLiveVars occ -> SDoc
733 = getPprStyle $ \ sty ->
734 if userStyle sty || isEmptyUniqSet lvs then
737 hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"]
741 pprStgRhs :: (Outputable bndr, Outputable bdee, Ord bdee)
742 => GenStgRhs bndr bdee -> SDoc
745 pprStgRhs (StgRhsClosure cc bi srt [free_var] upd_flag [{-no args-}] (StgApp func []))
749 brackets (ifPprDebug (ppr free_var)),
750 ptext SLIT(" \\"), ppr upd_flag, ptext SLIT(" [] "), ppr func ]
753 pprStgRhs (StgRhsClosure cc bi srt free_vars upd_flag args body)
754 = hang (hcat [ppr cc,
757 brackets (ifPprDebug (interppSP free_vars)),
758 ptext SLIT(" \\"), ppr upd_flag, brackets (interppSP args)])
761 pprStgRhs (StgRhsCon cc con args)
763 space, ppr con, ptext SLIT("! "), brackets (interppSP args)]
765 pprMaybeSRT (NoSRT) = empty
766 pprMaybeSRT srt = ptext SLIT(" srt: ") <> pprSRT srt
770 pp_binder_info NoStgBinderInfo = empty
772 -- cases so boring that we print nothing
773 pp_binder_info (StgBinderInfo True b c d e) = empty
776 pp_binder_info (StgBinderInfo a b c d e)
777 = getPprStyle $ \ sty ->
778 if userStyle sty then
781 parens (hsep (punctuate comma (map ppr [a,b,c,d,e])))
784 Collect @IdInfo@ stuff that is most easily just snaffled straight
785 from the STG bindings.
788 stgArity :: StgRhs -> Int
790 stgArity (StgRhsCon _ _ _) = 0 -- it's a constructor, fully applied
791 stgArity (StgRhsClosure _ _ _ _ _ args _ ) = length args