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 )
53 import IdInfo ( mayHaveCafRefs )
54 import Literal ( Literal, literalType )
55 import ForeignCall ( ForeignCall )
56 import CoreSyn ( AltCon )
57 import PprCore ( {- instances -} )
58 import PrimOp ( PrimOp, PrimCall )
61 import TyCon ( TyCon )
63 import Unique ( Unique )
65 import StaticFlags ( opt_SccProfilingOn )
70 import Packages ( isDllName )
75 %************************************************************************
77 \subsection{@GenStgBinding@}
79 %************************************************************************
81 As usual, expressions are interesting; other things are boring. Here
82 are the boring things [except note the @GenStgRhs@], parameterised
83 with respect to binder and occurrence information (just as in
86 There is one SRT for each group of bindings.
89 data GenStgBinding bndr occ
90 = StgNonRec bndr (GenStgRhs bndr occ)
91 | StgRec [(bndr, GenStgRhs bndr occ)]
94 %************************************************************************
96 \subsection{@GenStgArg@}
98 %************************************************************************
104 | StgTypeArg Type -- For when we want to preserve all type info
108 isStgTypeArg :: StgArg -> Bool
109 isStgTypeArg (StgTypeArg _) = True
110 isStgTypeArg _ = False
112 isDllConApp :: PackageId -> DataCon -> [StgArg] -> Bool
113 -- Does this constructor application refer to
114 -- anything in a different *Windows* DLL?
115 -- If so, we can't allocate it statically
116 #if mingw32_TARGET_OS
117 isDllConApp this_pkg con args
118 = isDllName this_pkg (dataConName con) || any is_dll_arg args
120 is_dll_arg ::StgArg -> Bool
121 is_dll_arg (StgVarArg v) = isDllName this_pkg (idName v)
124 isDllConApp _ _ _ = False
127 stgArgType :: StgArg -> Type
128 -- Very half baked becase we have lost the type arguments
129 stgArgType (StgVarArg v) = idType v
130 stgArgType (StgLitArg lit) = literalType lit
131 stgArgType (StgTypeArg _) = panic "stgArgType called on stgTypeArg"
134 %************************************************************************
136 \subsection{STG expressions}
138 %************************************************************************
140 The @GenStgExpr@ data type is parameterised on binder and occurrence
143 %************************************************************************
145 \subsubsection{@GenStgExpr@ application}
147 %************************************************************************
149 An application is of a function to a list of atoms [not expressions].
150 Operationally, we want to push the arguments on the stack and call the
151 function. (If the arguments were expressions, we would have to build
152 their closures first.)
154 There is no constructor for a lone variable; it would appear as
157 type GenStgLiveVars occ = UniqSet occ
159 data GenStgExpr bndr occ
162 [GenStgArg occ] -- arguments; may be empty
165 %************************************************************************
167 \subsubsection{@StgConApp@ and @StgPrimApp@---saturated applications}
169 %************************************************************************
171 There are a specialised forms of application, for
172 constructors, primitives, and literals.
176 -- StgConApp is vital for returning unboxed tuples
177 -- which can't be let-bound first
179 [GenStgArg occ] -- Saturated
181 | StgOpApp StgOp -- Primitive op or foreign call
182 [GenStgArg occ] -- Saturated
184 -- We need to know this so that we can
185 -- assign result registers
188 %************************************************************************
190 \subsubsection{@StgLam@}
192 %************************************************************************
194 StgLam is used *only* during CoreToStg's work. Before CoreToStg has finished
195 it encodes (\x -> e) as (let f = \x -> e in f)
199 Type -- Type of whole lambda (useful when making a binder for it)
201 StgExpr -- Body of lambda
205 %************************************************************************
207 \subsubsection{@GenStgExpr@: case-expressions}
209 %************************************************************************
211 This has the same boxed/unboxed business as Core case expressions.
214 (GenStgExpr bndr occ)
215 -- the thing to examine
217 (GenStgLiveVars occ) -- Live vars of whole case expression,
218 -- plus everything that happens after the case
219 -- i.e., those which mustn't be overwritten
221 (GenStgLiveVars occ) -- Live vars of RHSs (plus what happens afterwards)
222 -- i.e., those which must be saved before eval.
224 -- note that an alt's constructor's
225 -- binder-variables are NOT counted in the
226 -- free vars for the alt's RHS
228 bndr -- binds the result of evaluating the scrutinee
230 SRT -- The SRT for the continuation
234 [GenStgAlt bndr occ] -- The DEFAULT case is always *first*
235 -- if it is there at all
238 %************************************************************************
240 \subsubsection{@GenStgExpr@: @let(rec)@-expressions}
242 %************************************************************************
244 The various forms of let(rec)-expression encode most of the
245 interesting things we want to do.
249 let-closure x = [free-vars] expr [args]
254 let x = (\free-vars -> \args -> expr) free-vars
256 \tr{args} may be empty (and is for most closures). It isn't under
257 circumstances like this:
263 let-closure x = [z] [y] (y+z)
265 The idea is that we compile code for @(y+z)@ in an environment in which
266 @z@ is bound to an offset from \tr{Node}, and @y@ is bound to an
267 offset from the stack pointer.
269 (A let-closure is an @StgLet@ with a @StgRhsClosure@ RHS.)
273 let-constructor x = Constructor [args]
277 (A let-constructor is an @StgLet@ with a @StgRhsCon@ RHS.)
280 Letrec-expressions are essentially the same deal as
281 let-closure/let-constructor, so we use a common structure and
282 distinguish between them with an @is_recursive@ boolean flag.
286 let-unboxed u = an arbitrary arithmetic expression in unboxed values
289 All the stuff on the RHS must be fully evaluated. No function calls either!
291 (We've backed away from this toward case-expressions with
292 suitably-magical alts ...)
295 ~[Advanced stuff here! Not to start with, but makes pattern matching
296 generate more efficient code.]
299 let-escapes-not fail = expr
302 Here the idea is that @e'@ guarantees not to put @fail@ in a data structure,
303 or pass it to another function. All @e'@ will ever do is tail-call @fail@.
304 Rather than build a closure for @fail@, all we need do is to record the stack
305 level at the moment of the @let-escapes-not@; then entering @fail@ is just
306 a matter of adjusting the stack pointer back down to that point and entering
311 f x y = let z = huge-expression in
317 (A let-escapes-not is an @StgLetNoEscape@.)
320 We may eventually want:
322 let-literal x = Literal
326 (ToDo: is this obsolete?)
329 And so the code for let(rec)-things:
332 (GenStgBinding bndr occ) -- right hand sides (see below)
333 (GenStgExpr bndr occ) -- body
335 | StgLetNoEscape -- remember: ``advanced stuff''
336 (GenStgLiveVars occ) -- Live in the whole let-expression
337 -- Mustn't overwrite these stack slots
338 -- *Doesn't* include binders of the let(rec).
340 (GenStgLiveVars occ) -- Live in the right hand sides (only)
341 -- These are the ones which must be saved on
342 -- the stack if they aren't there already
343 -- *Does* include binders of the let(rec) if recursive.
345 (GenStgBinding bndr occ) -- right hand sides (see below)
346 (GenStgExpr bndr occ) -- body
349 %************************************************************************
351 \subsubsection{@GenStgExpr@: @scc@ expressions}
353 %************************************************************************
355 Finally for @scc@ expressions we introduce a new STG construct.
359 CostCentre -- label of SCC expression
360 (GenStgExpr bndr occ) -- scc expression
363 %************************************************************************
365 \subsubsection{@GenStgExpr@: @hpc@ expressions}
367 %************************************************************************
369 Finally for @scc@ expressions we introduce a new STG construct.
373 Module -- the module of the source of this tick
375 (GenStgExpr bndr occ) -- sub expression
379 %************************************************************************
381 \subsection{STG right-hand sides}
383 %************************************************************************
385 Here's the rest of the interesting stuff for @StgLet@s; the first
386 flavour is for closures:
388 data GenStgRhs bndr occ
390 CostCentreStack -- CCS to be attached (default is CurrentCCS)
391 StgBinderInfo -- Info about how this binder is used (see below)
392 [occ] -- non-global free vars; a list, rather than
393 -- a set, because order is important
394 !UpdateFlag -- ReEntrant | Updatable | SingleEntry
395 SRT -- The SRT reference
396 [bndr] -- arguments; if empty, then not a function;
397 -- as above, order is important.
398 (GenStgExpr bndr occ) -- body
400 An example may be in order. Consider:
402 let t = \x -> \y -> ... x ... y ... p ... q in e
404 Pulling out the free vars and stylising somewhat, we get the equivalent:
406 let t = (\[p,q] -> \[x,y] -> ... x ... y ... p ...q) p q
408 Stg-operationally, the @[x,y]@ are on the stack, the @[p,q]@ are
409 offsets from @Node@ into the closure, and the code ptr for the closure
410 will be exactly that in parentheses above.
412 The second flavour of right-hand-side is for constructors (simple but important):
415 CostCentreStack -- CCS to be attached (default is CurrentCCS).
416 -- Top-level (static) ones will end up with
417 -- DontCareCCS, because we don't count static
418 -- data in heap profiles, and we don't set CCCS
419 -- from static closure.
420 DataCon -- constructor
421 [GenStgArg occ] -- args
425 stgRhsArity :: StgRhs -> Int
426 stgRhsArity (StgRhsClosure _ _ _ _ _ bndrs _)
427 = ASSERT( all isId bndrs ) length bndrs
428 -- The arity never includes type parameters, but they should have gone by now
429 stgRhsArity (StgRhsCon _ _ _) = 0
433 stgBindHasCafRefs :: GenStgBinding bndr Id -> Bool
434 stgBindHasCafRefs (StgNonRec _ rhs) = rhsHasCafRefs rhs
435 stgBindHasCafRefs (StgRec binds) = any rhsHasCafRefs (map snd binds)
437 rhsHasCafRefs :: GenStgRhs bndr Id -> Bool
438 rhsHasCafRefs (StgRhsClosure _ _ _ upd srt _ _)
439 = isUpdatable upd || nonEmptySRT srt
440 rhsHasCafRefs (StgRhsCon _ _ args)
441 = any stgArgHasCafRefs args
443 stgArgHasCafRefs :: GenStgArg Id -> Bool
444 stgArgHasCafRefs (StgVarArg id) = mayHaveCafRefs (idCafInfo id)
445 stgArgHasCafRefs _ = False
448 Here's the @StgBinderInfo@ type, and its combining op:
452 | SatCallsOnly -- All occurrences are *saturated* *function* calls
453 -- This means we don't need to build an info table and
454 -- slow entry code for the thing
455 -- Thunks never get this value
457 noBinderInfo, stgUnsatOcc, stgSatOcc :: StgBinderInfo
458 noBinderInfo = NoStgBinderInfo
459 stgUnsatOcc = NoStgBinderInfo
460 stgSatOcc = SatCallsOnly
462 satCallsOnly :: StgBinderInfo -> Bool
463 satCallsOnly SatCallsOnly = True
464 satCallsOnly NoStgBinderInfo = False
466 combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
467 combineStgBinderInfo SatCallsOnly SatCallsOnly = SatCallsOnly
468 combineStgBinderInfo _ _ = NoStgBinderInfo
471 pp_binder_info :: StgBinderInfo -> SDoc
472 pp_binder_info NoStgBinderInfo = empty
473 pp_binder_info SatCallsOnly = ptext (sLit "sat-only")
476 %************************************************************************
478 \subsection[Stg-case-alternatives]{STG case alternatives}
480 %************************************************************************
482 Very like in @CoreSyntax@ (except no type-world stuff).
484 The type constructor is guaranteed not to be abstract; that is, we can
485 see its representation. This is important because the code generator
486 uses it to determine return conventions etc. But it's not trivial
487 where there's a moduule loop involved, because some versions of a type
488 constructor might not have all the constructors visible. So
489 mkStgAlgAlts (in CoreToStg) ensures that it gets the TyCon from the
490 constructors or literals (which are guaranteed to have the Real McCoy)
491 rather than from the scrutinee type.
494 type GenStgAlt bndr occ
495 = (AltCon, -- alts: data constructor,
496 [bndr], -- constructor's parameters,
497 [Bool], -- "use mask", same length as
498 -- parameters; a True in a
499 -- param's position if it is
501 GenStgExpr bndr occ) -- ...right-hand side.
504 = PolyAlt -- Polymorphic (a type variable)
505 | UbxTupAlt TyCon -- Unboxed tuple
506 | AlgAlt TyCon -- Algebraic data type; the AltCons will be DataAlts
507 | PrimAlt TyCon -- Primitive data type; the AltCons will be LitAlts
510 %************************************************************************
512 \subsection[Stg]{The Plain STG parameterisation}
514 %************************************************************************
516 This happens to be the only one we use at the moment.
519 type StgBinding = GenStgBinding Id Id
520 type StgArg = GenStgArg Id
521 type StgLiveVars = GenStgLiveVars Id
522 type StgExpr = GenStgExpr Id Id
523 type StgRhs = GenStgRhs Id Id
524 type StgAlt = GenStgAlt Id Id
527 %************************************************************************
529 \subsubsection[UpdateFlag-datatype]{@UpdateFlag@}
531 %************************************************************************
533 This is also used in @LambdaFormInfo@ in the @ClosureInfo@ module.
535 A @ReEntrant@ closure may be entered multiple times, but should not be
536 updated or blackholed. An @Updatable@ closure should be updated after
537 evaluation (and may be blackholed during evaluation). A @SingleEntry@
538 closure will only be entered once, and so need not be updated but may
539 safely be blackholed.
542 data UpdateFlag = ReEntrant | Updatable | SingleEntry
544 instance Outputable UpdateFlag where
546 = char (case u of { ReEntrant -> 'r'; Updatable -> 'u'; SingleEntry -> 's' })
548 isUpdatable :: UpdateFlag -> Bool
549 isUpdatable ReEntrant = False
550 isUpdatable SingleEntry = False
551 isUpdatable Updatable = True
554 %************************************************************************
556 \subsubsection{StgOp}
558 %************************************************************************
560 An StgOp allows us to group together PrimOps and ForeignCalls.
561 It's quite useful to move these around together, notably
562 in StgOpApp and COpStmt.
565 data StgOp = StgPrimOp PrimOp
567 | StgPrimCallOp PrimCall
569 | StgFCallOp ForeignCall Unique
570 -- The Unique is occasionally needed by the C pretty-printer
571 -- (which lacks a unique supply), notably when generating a
572 -- typedef for foreign-export-dynamic
576 %************************************************************************
578 \subsubsection[Static Reference Tables]{@SRT@}
580 %************************************************************************
582 There is one SRT per top-level function group. Each local binding and
583 case expression within this binding group has a subrange of the whole
584 SRT, expressed as an offset and length.
586 In CoreToStg we collect the list of CafRefs at each SRT site, which is later
587 converted into the length and offset form by the SRT pass.
592 -- generated by CoreToStg
593 | SRT !Int{-offset-} !Int{-length-} !Bitmap{-bitmap-}
594 -- generated by computeSRTs
596 nonEmptySRT :: SRT -> Bool
597 nonEmptySRT NoSRT = False
598 nonEmptySRT (SRTEntries vs) = not (isEmptyVarSet vs)
601 pprSRT :: SRT -> SDoc
602 pprSRT (NoSRT) = ptext (sLit "_no_srt_")
603 pprSRT (SRTEntries ids) = text "SRT:" <> ppr ids
604 pprSRT (SRT off _ _) = parens (ppr off <> comma <> text "*bitmap*")
607 %************************************************************************
609 \subsection[Stg-pretty-printing]{Pretty-printing}
611 %************************************************************************
613 Robin Popplestone asked for semi-colon separators on STG binds; here's
614 hoping he likes terminators instead... Ditto for case alternatives.
617 pprGenStgBinding :: (Outputable bndr, Outputable bdee, Ord bdee)
618 => GenStgBinding bndr bdee -> SDoc
620 pprGenStgBinding (StgNonRec bndr rhs)
621 = hang (hsep [ppr bndr, equals])
622 4 ((<>) (ppr rhs) semi)
624 pprGenStgBinding (StgRec pairs)
625 = vcat ((ifPprDebug (ptext (sLit "{- StgRec (begin) -}"))) :
626 (map (ppr_bind) pairs) ++ [(ifPprDebug (ptext (sLit "{- StgRec (end) -}")))])
628 ppr_bind (bndr, expr)
629 = hang (hsep [ppr bndr, equals])
630 4 ((<>) (ppr expr) semi)
632 pprStgBinding :: StgBinding -> SDoc
633 pprStgBinding bind = pprGenStgBinding bind
635 pprStgBindings :: [StgBinding] -> SDoc
636 pprStgBindings binds = vcat (map pprGenStgBinding binds)
638 pprGenStgBindingWithSRT
639 :: (Outputable bndr, Outputable bdee, Ord bdee)
640 => (GenStgBinding bndr bdee,[(Id,[Id])]) -> SDoc
642 pprGenStgBindingWithSRT (bind,srts)
643 = vcat (pprGenStgBinding bind : map pprSRT srts)
644 where pprSRT (id,srt) =
645 ptext (sLit "SRT") <> parens (ppr id) <> ptext (sLit ": ") <> ppr srt
647 pprStgBindingsWithSRTs :: [(StgBinding,[(Id,[Id])])] -> SDoc
648 pprStgBindingsWithSRTs binds = vcat (map pprGenStgBindingWithSRT binds)
652 instance (Outputable bdee) => Outputable (GenStgArg bdee) where
655 instance (Outputable bndr, Outputable bdee, Ord bdee)
656 => Outputable (GenStgBinding bndr bdee) where
657 ppr = pprGenStgBinding
659 instance (Outputable bndr, Outputable bdee, Ord bdee)
660 => Outputable (GenStgExpr bndr bdee) where
663 instance (Outputable bndr, Outputable bdee, Ord bdee)
664 => Outputable (GenStgRhs bndr bdee) where
665 ppr rhs = pprStgRhs rhs
669 pprStgArg :: (Outputable bdee) => GenStgArg bdee -> SDoc
671 pprStgArg (StgVarArg var) = ppr var
672 pprStgArg (StgLitArg con) = ppr con
673 pprStgArg (StgTypeArg ty) = char '@' <+> ppr ty
677 pprStgExpr :: (Outputable bndr, Outputable bdee, Ord bdee)
678 => GenStgExpr bndr bdee -> SDoc
680 pprStgExpr (StgLit lit) = ppr lit
683 pprStgExpr (StgApp func args)
685 4 (sep (map (ppr) args))
689 pprStgExpr (StgConApp con args)
690 = hsep [ ppr con, brackets (interppSP args)]
692 pprStgExpr (StgOpApp op args _)
693 = hsep [ pprStgOp op, brackets (interppSP args)]
695 pprStgExpr (StgLam _ bndrs body)
696 =sep [ char '\\' <+> ppr bndrs <+> ptext (sLit "->"),
701 -- special case: let v = <very specific thing>
707 -- Very special! Suspicious! (SLPJ)
710 pprStgExpr (StgLet srt (StgNonRec bndr (StgRhsClosure cc bi free_vars upd_flag args rhs))
713 (hang (hcat [ptext (sLit "let { "), ppr bndr, ptext (sLit " = "),
716 ptext (sLit " ["), ifPprDebug (interppSP free_vars), ptext (sLit "] \\"),
717 ppr upd_flag, ptext (sLit " ["),
718 interppSP args, char ']'])
719 8 (sep [hsep [ppr rhs, ptext (sLit "} in")]]))
723 -- special case: let ... in let ...
725 pprStgExpr (StgLet bind expr@(StgLet _ _))
727 (sep [hang (ptext (sLit "let {"))
728 2 (hsep [pprGenStgBinding bind, ptext (sLit "} in")])])
732 pprStgExpr (StgLet bind expr)
733 = sep [hang (ptext (sLit "let {")) 2 (pprGenStgBinding bind),
734 hang (ptext (sLit "} in ")) 2 (ppr expr)]
736 pprStgExpr (StgLetNoEscape lvs_whole lvs_rhss bind expr)
737 = sep [hang (ptext (sLit "let-no-escape {"))
738 2 (pprGenStgBinding bind),
739 hang ((<>) (ptext (sLit "} in "))
742 hcat [ptext (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
743 ptext (sLit "]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
747 pprStgExpr (StgSCC cc expr)
748 = sep [ hsep [ptext (sLit "_scc_"), ppr cc],
751 pprStgExpr (StgTick m n expr)
752 = sep [ hsep [ptext (sLit "_tick_"), pprModule m,text (show n)],
755 pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
756 = sep [sep [ptext (sLit "case"),
757 nest 4 (hsep [pprStgExpr expr,
758 ifPprDebug (dcolon <+> ppr alt_type)]),
759 ptext (sLit "of"), ppr bndr, char '{'],
762 hcat [ptext (sLit "-- lvs: ["), interppSP (uniqSetToList lvs_whole),
763 ptext (sLit "]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
766 nest 2 (vcat (map pprStgAlt alts)),
769 pprStgAlt :: (Outputable bndr, Outputable occ, Ord occ)
770 => GenStgAlt bndr occ -> SDoc
771 pprStgAlt (con, params, _use_mask, expr)
772 = hang (hsep [ppr con, interppSP params, ptext (sLit "->")])
775 pprStgOp :: StgOp -> SDoc
776 pprStgOp (StgPrimOp op) = ppr op
777 pprStgOp (StgPrimCallOp op)= ppr op
778 pprStgOp (StgFCallOp op _) = ppr op
780 instance Outputable AltType where
781 ppr PolyAlt = ptext (sLit "Polymorphic")
782 ppr (UbxTupAlt tc) = ptext (sLit "UbxTup") <+> ppr tc
783 ppr (AlgAlt tc) = ptext (sLit "Alg") <+> ppr tc
784 ppr (PrimAlt tc) = ptext (sLit "Prim") <+> ppr tc
789 pprStgLVs :: Outputable occ => GenStgLiveVars occ -> SDoc
791 = getPprStyle $ \ sty ->
792 if userStyle sty || isEmptyUniqSet lvs then
795 hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"]
800 pprStgRhs :: (Outputable bndr, Outputable bdee, Ord bdee)
801 => GenStgRhs bndr bdee -> SDoc
804 pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag srt [{-no args-}] (StgApp func []))
807 brackets (ifPprDebug (ppr free_var)),
808 ptext (sLit " \\"), ppr upd_flag, pprMaybeSRT srt, ptext (sLit " [] "), ppr func ]
811 pprStgRhs (StgRhsClosure cc bi free_vars upd_flag srt args body)
812 = hang (hsep [if opt_SccProfilingOn then ppr cc else empty,
814 ifPprDebug (brackets (interppSP free_vars)),
815 char '\\' <> ppr upd_flag, pprMaybeSRT srt, brackets (interppSP args)])
818 pprStgRhs (StgRhsCon cc con args)
820 space, ppr con, ptext (sLit "! "), brackets (interppSP args)]
822 pprMaybeSRT :: SRT -> SDoc
823 pprMaybeSRT (NoSRT) = empty
824 pprMaybeSRT srt = ptext (sLit "srt:") <> pprSRT srt