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 GenStgAlt, AltType(..),
19 UpdateFlag(..), isUpdatable,
22 noBinderInfo, stgSatOcc, stgUnsatOcc, satCallsOnly,
25 -- a set of synonyms for the most common (only :-) parameterisation
27 StgBinding, StgExpr, StgRhs, StgAlt,
36 stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity,
37 isDllConApp, isStgTypeArg,
40 pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs
47 #include "HsVersions.h"
49 import CostCentre ( CostCentreStack, CostCentre )
50 import VarSet ( IdSet, isEmptyVarSet )
52 import Id ( Id, idName, idType, idCafInfo )
53 import IdInfo ( mayHaveCafRefs )
54 import Packages ( isDllName )
55 import Literal ( Literal, literalType )
56 import ForeignCall ( ForeignCall )
57 import DataCon ( DataCon, dataConName )
58 import CoreSyn ( AltCon )
59 import PprCore ( {- instances -} )
60 import PrimOp ( PrimOp )
63 import TyCon ( TyCon )
65 import Unique ( Unique )
67 import StaticFlags ( opt_SccProfilingOn )
72 %************************************************************************
74 \subsection{@GenStgBinding@}
76 %************************************************************************
78 As usual, expressions are interesting; other things are boring. Here
79 are the boring things [except note the @GenStgRhs@], parameterised
80 with respect to binder and occurrence information (just as in
83 There is one SRT for each group of bindings.
86 data GenStgBinding bndr occ
87 = StgNonRec bndr (GenStgRhs bndr occ)
88 | StgRec [(bndr, GenStgRhs bndr occ)]
91 %************************************************************************
93 \subsection{@GenStgArg@}
95 %************************************************************************
101 | StgTypeArg Type -- For when we want to preserve all type info
105 isStgTypeArg :: StgArg -> Bool
106 isStgTypeArg (StgTypeArg _) = True
107 isStgTypeArg _ = False
109 isDllArg :: PackageId -> StgArg -> Bool
110 -- Does this argument refer to something in a different DLL?
111 isDllArg this_pkg (StgVarArg v) = isDllName this_pkg (idName v)
114 isDllConApp :: PackageId -> DataCon -> [StgArg] -> Bool
115 -- Does this constructor application refer to
116 -- anything in a different DLL?
117 -- If so, we can't allocate it statically
118 isDllConApp this_pkg con args
119 = isDllName this_pkg (dataConName con) || any (isDllArg this_pkg) args
121 stgArgType :: StgArg -> Type
122 -- Very half baked becase we have lost the type arguments
123 stgArgType (StgVarArg v) = idType v
124 stgArgType (StgLitArg lit) = literalType lit
125 stgArgType (StgTypeArg _) = panic "stgArgType called on stgTypeArg"
128 %************************************************************************
130 \subsection{STG expressions}
132 %************************************************************************
134 The @GenStgExpr@ data type is parameterised on binder and occurrence
137 %************************************************************************
139 \subsubsection{@GenStgExpr@ application}
141 %************************************************************************
143 An application is of a function to a list of atoms [not expressions].
144 Operationally, we want to push the arguments on the stack and call the
145 function. (If the arguments were expressions, we would have to build
146 their closures first.)
148 There is no constructor for a lone variable; it would appear as
151 type GenStgLiveVars occ = UniqSet occ
153 data GenStgExpr bndr occ
156 [GenStgArg occ] -- arguments; may be empty
159 %************************************************************************
161 \subsubsection{@StgConApp@ and @StgPrimApp@---saturated applications}
163 %************************************************************************
165 There are a specialised forms of application, for
166 constructors, primitives, and literals.
170 -- StgConApp is vital for returning unboxed tuples
171 -- which can't be let-bound first
173 [GenStgArg occ] -- Saturated
175 | StgOpApp StgOp -- Primitive op or foreign call
176 [GenStgArg occ] -- Saturated
178 -- We need to know this so that we can
179 -- assign result registers
182 %************************************************************************
184 \subsubsection{@StgLam@}
186 %************************************************************************
188 StgLam is used *only* during CoreToStg's work. Before CoreToStg has finished
189 it encodes (\x -> e) as (let f = \x -> e in f)
193 Type -- Type of whole lambda (useful when making a binder for it)
195 StgExpr -- Body of lambda
199 %************************************************************************
201 \subsubsection{@GenStgExpr@: case-expressions}
203 %************************************************************************
205 This has the same boxed/unboxed business as Core case expressions.
208 (GenStgExpr bndr occ)
209 -- the thing to examine
211 (GenStgLiveVars occ) -- Live vars of whole case expression,
212 -- plus everything that happens after the case
213 -- i.e., those which mustn't be overwritten
215 (GenStgLiveVars occ) -- Live vars of RHSs (plus what happens afterwards)
216 -- i.e., those which must be saved before eval.
218 -- note that an alt's constructor's
219 -- binder-variables are NOT counted in the
220 -- free vars for the alt's RHS
222 bndr -- binds the result of evaluating the scrutinee
224 SRT -- The SRT for the continuation
228 [GenStgAlt bndr occ] -- The DEFAULT case is always *first*
229 -- if it is there at all
232 %************************************************************************
234 \subsubsection{@GenStgExpr@: @let(rec)@-expressions}
236 %************************************************************************
238 The various forms of let(rec)-expression encode most of the
239 interesting things we want to do.
243 let-closure x = [free-vars] expr [args]
248 let x = (\free-vars -> \args -> expr) free-vars
250 \tr{args} may be empty (and is for most closures). It isn't under
251 circumstances like this:
257 let-closure x = [z] [y] (y+z)
259 The idea is that we compile code for @(y+z)@ in an environment in which
260 @z@ is bound to an offset from \tr{Node}, and @y@ is bound to an
261 offset from the stack pointer.
263 (A let-closure is an @StgLet@ with a @StgRhsClosure@ RHS.)
267 let-constructor x = Constructor [args]
271 (A let-constructor is an @StgLet@ with a @StgRhsCon@ RHS.)
274 Letrec-expressions are essentially the same deal as
275 let-closure/let-constructor, so we use a common structure and
276 distinguish between them with an @is_recursive@ boolean flag.
280 let-unboxed u = an arbitrary arithmetic expression in unboxed values
283 All the stuff on the RHS must be fully evaluated. No function calls either!
285 (We've backed away from this toward case-expressions with
286 suitably-magical alts ...)
289 ~[Advanced stuff here! Not to start with, but makes pattern matching
290 generate more efficient code.]
293 let-escapes-not fail = expr
296 Here the idea is that @e'@ guarantees not to put @fail@ in a data structure,
297 or pass it to another function. All @e'@ will ever do is tail-call @fail@.
298 Rather than build a closure for @fail@, all we need do is to record the stack
299 level at the moment of the @let-escapes-not@; then entering @fail@ is just
300 a matter of adjusting the stack pointer back down to that point and entering
305 f x y = let z = huge-expression in
311 (A let-escapes-not is an @StgLetNoEscape@.)
314 We may eventually want:
316 let-literal x = Literal
320 (ToDo: is this obsolete?)
323 And so the code for let(rec)-things:
326 (GenStgBinding bndr occ) -- right hand sides (see below)
327 (GenStgExpr bndr occ) -- body
329 | StgLetNoEscape -- remember: ``advanced stuff''
330 (GenStgLiveVars occ) -- Live in the whole let-expression
331 -- Mustn't overwrite these stack slots
332 -- *Doesn't* include binders of the let(rec).
334 (GenStgLiveVars occ) -- Live in the right hand sides (only)
335 -- These are the ones which must be saved on
336 -- the stack if they aren't there already
337 -- *Does* include binders of the let(rec) if recursive.
339 (GenStgBinding bndr occ) -- right hand sides (see below)
340 (GenStgExpr bndr occ) -- body
343 %************************************************************************
345 \subsubsection{@GenStgExpr@: @scc@ expressions}
347 %************************************************************************
349 Finally for @scc@ expressions we introduce a new STG construct.
353 CostCentre -- label of SCC expression
354 (GenStgExpr bndr occ) -- scc expression
357 %************************************************************************
359 \subsubsection{@GenStgExpr@: @hpc@ expressions}
361 %************************************************************************
363 Finally for @scc@ expressions we introduce a new STG construct.
367 Module -- the module of the source of this tick
369 (GenStgExpr bndr occ) -- sub expression
373 %************************************************************************
375 \subsection{STG right-hand sides}
377 %************************************************************************
379 Here's the rest of the interesting stuff for @StgLet@s; the first
380 flavour is for closures:
382 data GenStgRhs bndr occ
384 CostCentreStack -- CCS to be attached (default is CurrentCCS)
385 StgBinderInfo -- Info about how this binder is used (see below)
386 [occ] -- non-global free vars; a list, rather than
387 -- a set, because order is important
388 !UpdateFlag -- ReEntrant | Updatable | SingleEntry
389 SRT -- The SRT reference
390 [bndr] -- arguments; if empty, then not a function;
391 -- as above, order is important.
392 (GenStgExpr bndr occ) -- body
394 An example may be in order. Consider:
396 let t = \x -> \y -> ... x ... y ... p ... q in e
398 Pulling out the free vars and stylising somewhat, we get the equivalent:
400 let t = (\[p,q] -> \[x,y] -> ... x ... y ... p ...q) p q
402 Stg-operationally, the @[x,y]@ are on the stack, the @[p,q]@ are
403 offsets from @Node@ into the closure, and the code ptr for the closure
404 will be exactly that in parentheses above.
406 The second flavour of right-hand-side is for constructors (simple but important):
409 CostCentreStack -- CCS to be attached (default is CurrentCCS).
410 -- Top-level (static) ones will end up with
411 -- DontCareCCS, because we don't count static
412 -- data in heap profiles, and we don't set CCCS
413 -- from static closure.
414 DataCon -- constructor
415 [GenStgArg occ] -- args
419 stgRhsArity :: StgRhs -> Int
420 stgRhsArity (StgRhsClosure _ _ _ _ _ bndrs _)
421 = ASSERT( all isId bndrs ) length bndrs
422 -- The arity never includes type parameters, but they should have gone by now
423 stgRhsArity (StgRhsCon _ _ _) = 0
427 stgBindHasCafRefs :: GenStgBinding bndr Id -> Bool
428 stgBindHasCafRefs (StgNonRec _ rhs) = rhsHasCafRefs rhs
429 stgBindHasCafRefs (StgRec binds) = any rhsHasCafRefs (map snd binds)
431 rhsHasCafRefs :: GenStgRhs bndr Id -> Bool
432 rhsHasCafRefs (StgRhsClosure _ _ _ upd srt _ _)
433 = isUpdatable upd || nonEmptySRT srt
434 rhsHasCafRefs (StgRhsCon _ _ args)
435 = any stgArgHasCafRefs args
437 stgArgHasCafRefs :: GenStgArg Id -> Bool
438 stgArgHasCafRefs (StgVarArg id) = mayHaveCafRefs (idCafInfo id)
439 stgArgHasCafRefs _ = False
442 Here's the @StgBinderInfo@ type, and its combining op:
446 | SatCallsOnly -- All occurrences are *saturated* *function* calls
447 -- This means we don't need to build an info table and
448 -- slow entry code for the thing
449 -- Thunks never get this value
451 noBinderInfo, stgUnsatOcc, stgSatOcc :: StgBinderInfo
452 noBinderInfo = NoStgBinderInfo
453 stgUnsatOcc = NoStgBinderInfo
454 stgSatOcc = SatCallsOnly
456 satCallsOnly :: StgBinderInfo -> Bool
457 satCallsOnly SatCallsOnly = True
458 satCallsOnly NoStgBinderInfo = False
460 combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
461 combineStgBinderInfo SatCallsOnly SatCallsOnly = SatCallsOnly
462 combineStgBinderInfo _ _ = NoStgBinderInfo
465 pp_binder_info :: StgBinderInfo -> SDoc
466 pp_binder_info NoStgBinderInfo = empty
467 pp_binder_info SatCallsOnly = ptext (sLit "sat-only")
470 %************************************************************************
472 \subsection[Stg-case-alternatives]{STG case alternatives}
474 %************************************************************************
476 Very like in @CoreSyntax@ (except no type-world stuff).
478 The type constructor is guaranteed not to be abstract; that is, we can
479 see its representation. This is important because the code generator
480 uses it to determine return conventions etc. But it's not trivial
481 where there's a moduule loop involved, because some versions of a type
482 constructor might not have all the constructors visible. So
483 mkStgAlgAlts (in CoreToStg) ensures that it gets the TyCon from the
484 constructors or literals (which are guaranteed to have the Real McCoy)
485 rather than from the scrutinee type.
488 type GenStgAlt bndr occ
489 = (AltCon, -- alts: data constructor,
490 [bndr], -- constructor's parameters,
491 [Bool], -- "use mask", same length as
492 -- parameters; a True in a
493 -- param's position if it is
495 GenStgExpr bndr occ) -- ...right-hand side.
498 = PolyAlt -- Polymorphic (a type variable)
499 | UbxTupAlt TyCon -- Unboxed tuple
500 | AlgAlt TyCon -- Algebraic data type; the AltCons will be DataAlts
501 | PrimAlt TyCon -- Primitive data type; the AltCons will be LitAlts
504 %************************************************************************
506 \subsection[Stg]{The Plain STG parameterisation}
508 %************************************************************************
510 This happens to be the only one we use at the moment.
513 type StgBinding = GenStgBinding Id Id
514 type StgArg = GenStgArg Id
515 type StgLiveVars = GenStgLiveVars Id
516 type StgExpr = GenStgExpr Id Id
517 type StgRhs = GenStgRhs Id Id
518 type StgAlt = GenStgAlt Id Id
521 %************************************************************************
523 \subsubsection[UpdateFlag-datatype]{@UpdateFlag@}
525 %************************************************************************
527 This is also used in @LambdaFormInfo@ in the @ClosureInfo@ module.
529 A @ReEntrant@ closure may be entered multiple times, but should not be
530 updated or blackholed. An @Updatable@ closure should be updated after
531 evaluation (and may be blackholed during evaluation). A @SingleEntry@
532 closure will only be entered once, and so need not be updated but may
533 safely be blackholed.
536 data UpdateFlag = ReEntrant | Updatable | SingleEntry
538 instance Outputable UpdateFlag where
540 = char (case u of { ReEntrant -> 'r'; Updatable -> 'u'; SingleEntry -> 's' })
542 isUpdatable :: UpdateFlag -> Bool
543 isUpdatable ReEntrant = False
544 isUpdatable SingleEntry = False
545 isUpdatable Updatable = True
548 %************************************************************************
550 \subsubsection{StgOp}
552 %************************************************************************
554 An StgOp allows us to group together PrimOps and ForeignCalls.
555 It's quite useful to move these around together, notably
556 in StgOpApp and COpStmt.
559 data StgOp = StgPrimOp PrimOp
561 | StgFCallOp ForeignCall Unique
562 -- The Unique is occasionally needed by the C pretty-printer
563 -- (which lacks a unique supply), notably when generating a
564 -- typedef for foreign-export-dynamic
568 %************************************************************************
570 \subsubsection[Static Reference Tables]{@SRT@}
572 %************************************************************************
574 There is one SRT per top-level function group. Each local binding and
575 case expression within this binding group has a subrange of the whole
576 SRT, expressed as an offset and length.
578 In CoreToStg we collect the list of CafRefs at each SRT site, which is later
579 converted into the length and offset form by the SRT pass.
584 -- generated by CoreToStg
585 | SRT !Int{-offset-} !Int{-length-} !Bitmap{-bitmap-}
586 -- generated by computeSRTs
588 nonEmptySRT :: SRT -> Bool
589 nonEmptySRT NoSRT = False
590 nonEmptySRT (SRTEntries vs) = not (isEmptyVarSet vs)
593 pprSRT :: SRT -> SDoc
594 pprSRT (NoSRT) = ptext (sLit "_no_srt_")
595 pprSRT (SRTEntries ids) = text "SRT:" <> ppr ids
596 pprSRT (SRT off _ _) = parens (ppr off <> comma <> text "*bitmap*")
599 %************************************************************************
601 \subsection[Stg-pretty-printing]{Pretty-printing}
603 %************************************************************************
605 Robin Popplestone asked for semi-colon separators on STG binds; here's
606 hoping he likes terminators instead... Ditto for case alternatives.
609 pprGenStgBinding :: (Outputable bndr, Outputable bdee, Ord bdee)
610 => GenStgBinding bndr bdee -> SDoc
612 pprGenStgBinding (StgNonRec bndr rhs)
613 = hang (hsep [ppr bndr, equals])
614 4 ((<>) (ppr rhs) semi)
616 pprGenStgBinding (StgRec pairs)
617 = vcat ((ifPprDebug (ptext (sLit "{- StgRec (begin) -}"))) :
618 (map (ppr_bind) pairs) ++ [(ifPprDebug (ptext (sLit "{- StgRec (end) -}")))])
620 ppr_bind (bndr, expr)
621 = hang (hsep [ppr bndr, equals])
622 4 ((<>) (ppr expr) semi)
624 pprStgBinding :: StgBinding -> SDoc
625 pprStgBinding bind = pprGenStgBinding bind
627 pprStgBindings :: [StgBinding] -> SDoc
628 pprStgBindings binds = vcat (map pprGenStgBinding binds)
630 pprGenStgBindingWithSRT
631 :: (Outputable bndr, Outputable bdee, Ord bdee)
632 => (GenStgBinding bndr bdee,[(Id,[Id])]) -> SDoc
634 pprGenStgBindingWithSRT (bind,srts)
635 = vcat (pprGenStgBinding bind : map pprSRT srts)
636 where pprSRT (id,srt) =
637 ptext (sLit "SRT") <> parens (ppr id) <> ptext (sLit ": ") <> ppr srt
639 pprStgBindingsWithSRTs :: [(StgBinding,[(Id,[Id])])] -> SDoc
640 pprStgBindingsWithSRTs binds = vcat (map pprGenStgBindingWithSRT binds)
644 instance (Outputable bdee) => Outputable (GenStgArg bdee) where
647 instance (Outputable bndr, Outputable bdee, Ord bdee)
648 => Outputable (GenStgBinding bndr bdee) where
649 ppr = pprGenStgBinding
651 instance (Outputable bndr, Outputable bdee, Ord bdee)
652 => Outputable (GenStgExpr bndr bdee) where
655 instance (Outputable bndr, Outputable bdee, Ord bdee)
656 => Outputable (GenStgRhs bndr bdee) where
657 ppr rhs = pprStgRhs rhs
661 pprStgArg :: (Outputable bdee) => GenStgArg bdee -> SDoc
663 pprStgArg (StgVarArg var) = ppr var
664 pprStgArg (StgLitArg con) = ppr con
665 pprStgArg (StgTypeArg ty) = char '@' <+> ppr ty
669 pprStgExpr :: (Outputable bndr, Outputable bdee, Ord bdee)
670 => GenStgExpr bndr bdee -> SDoc
672 pprStgExpr (StgLit lit) = ppr lit
675 pprStgExpr (StgApp func args)
677 4 (sep (map (ppr) args))
681 pprStgExpr (StgConApp con args)
682 = hsep [ ppr con, brackets (interppSP args)]
684 pprStgExpr (StgOpApp op args _)
685 = hsep [ pprStgOp op, brackets (interppSP args)]
687 pprStgExpr (StgLam _ bndrs body)
688 =sep [ char '\\' <+> ppr bndrs <+> ptext (sLit "->"),
693 -- special case: let v = <very specific thing>
699 -- Very special! Suspicious! (SLPJ)
702 pprStgExpr (StgLet srt (StgNonRec bndr (StgRhsClosure cc bi free_vars upd_flag args rhs))
705 (hang (hcat [ptext (sLit "let { "), ppr bndr, ptext (sLit " = "),
708 ptext (sLit " ["), ifPprDebug (interppSP free_vars), ptext (sLit "] \\"),
709 ppr upd_flag, ptext (sLit " ["),
710 interppSP args, char ']'])
711 8 (sep [hsep [ppr rhs, ptext (sLit "} in")]]))
715 -- special case: let ... in let ...
717 pprStgExpr (StgLet bind expr@(StgLet _ _))
719 (sep [hang (ptext (sLit "let {"))
720 2 (hsep [pprGenStgBinding bind, ptext (sLit "} in")])])
724 pprStgExpr (StgLet bind expr)
725 = sep [hang (ptext (sLit "let {")) 2 (pprGenStgBinding bind),
726 hang (ptext (sLit "} in ")) 2 (ppr expr)]
728 pprStgExpr (StgLetNoEscape lvs_whole lvs_rhss bind expr)
729 = sep [hang (ptext (sLit "let-no-escape {"))
730 2 (pprGenStgBinding bind),
731 hang ((<>) (ptext (sLit "} in "))
734 hcat [ptext (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
735 ptext (sLit "]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
739 pprStgExpr (StgSCC cc expr)
740 = sep [ hsep [ptext (sLit "_scc_"), ppr cc],
743 pprStgExpr (StgTick m n expr)
744 = sep [ hsep [ptext (sLit "_tick_"), pprModule m,text (show n)],
747 pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
748 = sep [sep [ptext (sLit "case"),
749 nest 4 (hsep [pprStgExpr expr,
750 ifPprDebug (dcolon <+> ppr alt_type)]),
751 ptext (sLit "of"), ppr bndr, char '{'],
754 hcat [ptext (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
755 ptext (sLit "]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
758 nest 2 (vcat (map pprStgAlt alts)),
761 pprStgAlt :: (Outputable bndr, Outputable occ, Ord occ)
762 => GenStgAlt bndr occ -> SDoc
763 pprStgAlt (con, params, _use_mask, expr)
764 = hang (hsep [ppr con, interppSP params, ptext (sLit "->")])
767 pprStgOp :: StgOp -> SDoc
768 pprStgOp (StgPrimOp op) = ppr op
769 pprStgOp (StgFCallOp op _) = ppr op
771 instance Outputable AltType where
772 ppr PolyAlt = ptext (sLit "Polymorphic")
773 ppr (UbxTupAlt tc) = ptext (sLit "UbxTup") <+> ppr tc
774 ppr (AlgAlt tc) = ptext (sLit "Alg") <+> ppr tc
775 ppr (PrimAlt tc) = ptext (sLit "Prim") <+> ppr tc
780 pprStgLVs :: Outputable occ => GenStgLiveVars occ -> SDoc
782 = getPprStyle $ \ sty ->
783 if userStyle sty || isEmptyUniqSet lvs then
786 hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"]
791 pprStgRhs :: (Outputable bndr, Outputable bdee, Ord bdee)
792 => GenStgRhs bndr bdee -> SDoc
795 pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag srt [{-no args-}] (StgApp func []))
798 brackets (ifPprDebug (ppr free_var)),
799 ptext (sLit " \\"), ppr upd_flag, pprMaybeSRT srt, ptext (sLit " [] "), ppr func ]
802 pprStgRhs (StgRhsClosure cc bi free_vars upd_flag srt args body)
803 = hang (hsep [if opt_SccProfilingOn then ppr cc else empty,
805 ifPprDebug (brackets (interppSP free_vars)),
806 char '\\' <> ppr upd_flag, pprMaybeSRT srt, brackets (interppSP args)])
809 pprStgRhs (StgRhsCon cc con args)
811 space, ppr con, ptext (sLit "! "), brackets (interppSP args)]
813 pprMaybeSRT :: SRT -> SDoc
814 pprMaybeSRT (NoSRT) = empty
815 pprMaybeSRT srt = ptext (sLit "srt:") <> pprSRT srt