2 % (c) The Univserity of Glasgow 1992-2004
5 Data structures which describe closures, and
6 operations over those data structures
8 Nothing monadic in here
10 Much of the rationale for these things is in the ``details'' part of
15 ClosureInfo, LambdaFormInfo, SMRep, -- all abstract
18 ArgDescr(..), Liveness(..),
21 mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
22 mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
24 mkClosureInfo, mkConInfo,
26 closureSize, closureNonHdrSize,
27 closureGoodStuffSize, closurePtrsSize,
30 closureName, infoTableLabelFromCI,
31 closureLabelFromCI, closureSRT,
32 closureLFInfo, closureSMRep, closureUpdReqd,
33 closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
34 closureFunInfo, isStandardFormThunk, isKnownFun,
36 enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
39 CallMethod(..), getCallMethod,
43 staticClosureRequired,
47 closureValDescr, closureTypeDescr, -- profiling
50 cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
52 staticClosureNeedsLink,
55 #include "../includes/MachDeps.h"
56 #include "HsVersions.h"
59 import SMRep -- all of it
63 import Constants ( mIN_UPD_SIZE, mIN_SIZE_NonUpdHeapObject )
64 import Packages ( isDllName )
65 import CmdLineOpts ( DynFlags, opt_SccProfilingOn, opt_OmitBlackHoling,
66 opt_Parallel, opt_DoTickyProfiling,
68 import Id ( Id, idType, idArity, idName )
69 import DataCon ( DataCon, dataConTyCon, isNullaryRepDataCon, dataConName )
70 import Name ( Name, nameUnique, getOccName, getOccString )
71 import OccName ( occNameUserString )
72 import Type ( isUnLiftedType, Type, repType, splitTyConApp_maybe )
73 import TcType ( tcSplitSigmaTy )
74 import TyCon ( isFunTyCon, isAbstractTyCon )
75 import BasicTypes ( TopLevelFlag(..), isNotTopLevel, isTopLevel, ipNameName )
80 import TypeRep -- TEMP
84 %************************************************************************
86 \subsection[ClosureInfo-datatypes]{Data types for closure information}
88 %************************************************************************
90 Information about a closure, from the code generator's point of view.
92 A ClosureInfo decribes the info pointer of a closure. It has
94 a) to construct the info table itself
95 b) to allocate a closure containing that info pointer (i.e.
96 it knows the info table label)
98 We make a ClosureInfo for
99 - each let binding (both top level and not)
100 - each data constructor (for its shared static and
106 closureName :: !Name, -- The thing bound to this closure
107 closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
108 closureSMRep :: !SMRep, -- representation used by storage mgr
109 closureSRT :: !C_SRT, -- What SRT applies to this closure
110 closureType :: !Type, -- Type of closure (ToDo: remove)
111 closureDescr :: !String -- closure description (for profiling)
114 -- Constructor closures don't have a unique info table label (they use
115 -- the constructor's info table), and they don't have an SRT.
117 closureCon :: !DataCon,
118 closureSMRep :: !SMRep,
119 closureDllCon :: !Bool -- is in a separate DLL
122 -- C_SRT is what StgSyn.SRT gets translated to...
123 -- we add a label for the table, and expect only the 'offset/length' form
126 | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
128 needsSRT :: C_SRT -> Bool
129 needsSRT NoC_SRT = False
130 needsSRT (C_SRT _ _ _) = True
133 %************************************************************************
135 \subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
137 %************************************************************************
139 Information about an identifier, from the code generator's point of
140 view. Every identifier is bound to a LambdaFormInfo in the
141 environment, which gives the code generator enough info to be able to
142 tail call or return that identifier.
144 Note that a closure is usually bound to an identifier, so a
145 ClosureInfo contains a LambdaFormInfo.
149 = LFReEntrant -- Reentrant closure (a function)
150 TopLevelFlag -- True if top level
151 !Int -- Arity. Invariant: always > 0
152 !Bool -- True <=> no fvs
153 ArgDescr -- Argument descriptor (should reall be in ClosureInfo)
155 | LFCon -- A saturated constructor application
156 DataCon -- The constructor
158 | LFThunk -- Thunk (zero arity)
160 !Bool -- True <=> no free vars
161 !Bool -- True <=> updatable (i.e., *not* single-entry)
163 !Bool -- True <=> *might* be a function type
165 | LFUnknown -- Used for function arguments and imported things.
166 -- We know nothing about this closure. Treat like
167 -- updatable "LFThunk"...
168 -- Imported things which we do know something about use
169 -- one of the other LF constructors (eg LFReEntrant for
171 !Bool -- True <=> *might* be a function type
173 | LFLetNoEscape -- See LetNoEscape module for precise description of
177 | LFBlackHole -- Used for the closures allocated to hold the result
178 -- of a CAF. We want the target of the update frame to
179 -- be in the heap, so we make a black hole to hold it.
180 CLabel -- Flavour (info label, eg CAF_BLACKHOLE_info).
183 -------------------------
184 -- An ArgDsecr describes the argument pattern of a function
187 = ArgSpec -- Fits one of the standard patterns
188 !Int -- RTS type identifier ARG_P, ARG_N, ...
190 | ArgGen -- General case
191 Liveness -- Details about the arguments
194 -------------------------
195 -- We represent liveness bitmaps as a Bitmap (whose internal
196 -- representation really is a bitmap). These are pinned onto case return
197 -- vectors to indicate the state of the stack for the garbage collector.
199 -- In the compiled program, liveness bitmaps that fit inside a single
200 -- word (StgWord) are stored as a single word, while larger bitmaps are
201 -- stored as a pointer to an array of words.
204 = SmallLiveness -- Liveness info that fits in one word
205 StgWord -- Here's the bitmap
207 | BigLiveness -- Liveness info witha a multi-word bitmap
208 CLabel -- Label for the bitmap
211 -------------------------
212 -- StandardFormInfo tells whether this thunk has one of
213 -- a small number of standard forms
215 data StandardFormInfo
217 -- Not of of the standard forms
220 -- A SelectorThunk is of form
222 -- con a1,..,an -> ak
223 -- and the constructor is from a single-constr type.
224 WordOff -- 0-origin offset of ak within the "goods" of
225 -- constructor (Recall that the a1,...,an may be laid
226 -- out in the heap in a non-obvious order.)
229 -- An ApThunk is of form
231 -- The code for the thunk just pushes x2..xn on the stack and enters x1.
232 -- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
233 -- in the RTS to save space.
237 %************************************************************************
239 \subsection[ClosureInfo-construction]{Functions which build LFInfos}
241 %************************************************************************
244 mkLFReEntrant :: TopLevelFlag -- True of top level
247 -> ArgDescr -- Argument descriptor
250 mkLFReEntrant top fvs args arg_descr
251 = LFReEntrant top (length args) (null fvs) arg_descr
253 mkLFThunk thunk_ty top fvs upd_flag
254 = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) )
255 LFThunk top (null fvs)
256 (isUpdatable upd_flag)
258 (might_be_a_function thunk_ty)
260 might_be_a_function :: Type -> Bool
261 might_be_a_function ty
262 | Just (tc,_) <- splitTyConApp_maybe (repType ty),
263 not (isFunTyCon tc) && not (isAbstractTyCon tc) = False
264 -- don't forget to check for abstract types, which might
269 @mkConLFInfo@ is similar, for constructors.
272 mkConLFInfo :: DataCon -> LambdaFormInfo
273 mkConLFInfo con = LFCon con
275 mkSelectorLFInfo id offset updatable
276 = LFThunk NotTopLevel False updatable (SelectorThunk offset)
277 (might_be_a_function (idType id))
279 mkApLFInfo id upd_flag arity
280 = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
281 (might_be_a_function (idType id))
284 Miscellaneous LF-infos.
287 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
289 mkLFLetNoEscape = LFLetNoEscape
291 mkLFImported :: Id -> LambdaFormInfo
294 n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr") -- n > 0
295 other -> mkLFArgument id -- Not sure of exact arity
298 %************************************************************************
300 Building ClosureInfos
302 %************************************************************************
305 mkClosureInfo :: Bool -- Is static
308 -> Int -> Int -- Total and pointer words
310 -> String -- String descriptor
312 mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
313 = ClosureInfo { closureName = name,
314 closureLFInfo = lf_info,
315 closureSMRep = sm_rep,
316 closureSRT = srt_info,
317 closureType = idType id,
318 closureDescr = descr }
321 sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
323 mkConInfo :: DynFlags
326 -> Int -> Int -- Total and pointer words
328 mkConInfo dflags is_static data_con tot_wds ptr_wds
329 = ConInfo { closureSMRep = sm_rep,
330 closureCon = data_con,
331 closureDllCon = isDllName dflags (dataConName data_con) }
333 sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
336 %************************************************************************
338 \subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
340 %************************************************************************
343 closureSize :: ClosureInfo -> WordOff
344 closureSize cl_info = fixedHdrSize + closureNonHdrSize cl_info
346 closureNonHdrSize :: ClosureInfo -> WordOff
347 closureNonHdrSize cl_info
348 = tot_wds + computeSlopSize tot_wds
349 (closureSMRep cl_info)
350 (closureNeedsUpdSpace cl_info)
352 tot_wds = closureGoodStuffSize cl_info
354 -- we leave space for an update if either (a) the closure is updatable
355 -- or (b) it is a static thunk. This is because a static thunk needs
356 -- a static link field in a predictable place (after the slop), regardless
357 -- of whether it is updatable or not.
358 closureNeedsUpdSpace (ClosureInfo { closureLFInfo =
359 LFThunk TopLevel _ _ _ _ }) = True
360 closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
362 slopSize :: ClosureInfo -> WordOff
364 = computeSlopSize (closureGoodStuffSize cl_info)
365 (closureSMRep cl_info)
366 (closureNeedsUpdSpace cl_info)
368 closureGoodStuffSize :: ClosureInfo -> WordOff
369 closureGoodStuffSize cl_info
370 = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
373 closurePtrsSize :: ClosureInfo -> WordOff
374 closurePtrsSize cl_info
375 = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
379 sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
380 sizes_from_SMRep (GenericRep _ ptrs nonptrs _) = (ptrs, nonptrs)
381 sizes_from_SMRep BlackHoleRep = (0, 0)
384 Computing slop size. WARNING: this looks dodgy --- it has deep
385 knowledge of what the storage manager does with the various
391 Updateable closures must be @mIN_UPD_SIZE@.
394 Indirections require 1 word
396 Appels collector indirections 2 words
398 THEREFORE: @mIN_UPD_SIZE = 2@.
401 Collectable closures which are allocated in the heap
402 must be @mIN_SIZE_NonUpdHeapObject@.
404 Copying collector forward pointer requires 1 word
406 THEREFORE: @mIN_SIZE_NonUpdHeapObject = 1@
409 Static closures have an extra ``static link field'' at the end, but we
410 don't bother taking that into account here.
413 computeSlopSize :: WordOff -> SMRep -> Bool -> WordOff
415 computeSlopSize tot_wds (GenericRep _ _ _ _) True -- Updatable
416 = max 0 (mIN_UPD_SIZE - tot_wds)
418 computeSlopSize tot_wds (GenericRep True _ _ _) False -- Non updatable
421 computeSlopSize tot_wds (GenericRep False _ _ _) False -- Non updatable
422 = max 0 (mIN_SIZE_NonUpdHeapObject - tot_wds) -- Dynamic
424 computeSlopSize tot_wds BlackHoleRep _ -- Updatable
425 = max 0 (mIN_UPD_SIZE - tot_wds)
428 %************************************************************************
430 \subsection[SMreps]{Choosing SM reps}
432 %************************************************************************
436 :: Bool -- True <=> static closure
438 -> WordOff -> WordOff -- Tot wds, ptr wds
441 chooseSMRep is_static lf_info tot_wds ptr_wds
443 nonptr_wds = tot_wds - ptr_wds
444 closure_type = getClosureType is_static ptr_wds lf_info
446 GenericRep is_static ptr_wds nonptr_wds closure_type
448 -- We *do* get non-updatable top-level thunks sometimes. eg. f = g
449 -- gets compiled to a jump to g (if g has non-zero arity), instead of
450 -- messing around with update frames and PAPs. We set the closure type
451 -- to FUN_STATIC in this case.
453 getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
454 getClosureType is_static ptr_wds lf_info
456 LFCon con | is_static && ptr_wds == 0 -> ConstrNoCaf
457 | otherwise -> Constr
458 LFReEntrant _ _ _ _ -> Fun
459 LFThunk _ _ _ (SelectorThunk _) _ -> ThunkSelector
460 LFThunk _ _ _ _ _ -> Thunk
461 _ -> panic "getClosureType"
464 %************************************************************************
466 \subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
468 %************************************************************************
470 Be sure to see the stg-details notes about these...
473 nodeMustPointToIt :: LambdaFormInfo -> Bool
474 nodeMustPointToIt (LFReEntrant top _ no_fvs _)
475 = not no_fvs || -- Certainly if it has fvs we need to point to it
477 -- If it is not top level we will point to it
478 -- We can have a \r closure with no_fvs which
479 -- is not top level as special case cgRhsClosure
480 -- has been dissabled in favour of let floating
482 -- For lex_profiling we also access the cost centre for a
483 -- non-inherited function i.e. not top level
484 -- the not top case above ensures this is ok.
486 nodeMustPointToIt (LFCon _) = True
488 -- Strictly speaking, the above two don't need Node to point
489 -- to it if the arity = 0. But this is a *really* unlikely
490 -- situation. If we know it's nil (say) and we are entering
491 -- it. Eg: let x = [] in x then we will certainly have inlined
492 -- x, since nil is a simple atom. So we gain little by not
493 -- having Node point to known zero-arity things. On the other
494 -- hand, we do lose something; Patrick's code for figuring out
495 -- when something has been updated but not entered relies on
496 -- having Node point to the result of an update. SLPJ
499 nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _)
500 = updatable || not no_fvs || opt_SccProfilingOn
501 -- For the non-updatable (single-entry case):
503 -- True if has fvs (in which case we need access to them, and we
504 -- should black-hole it)
505 -- or profiling (in which case we need to recover the cost centre
508 nodeMustPointToIt (LFThunk _ no_fvs updatable some_standard_form_thunk _)
509 = True -- Node must point to any standard-form thunk
511 nodeMustPointToIt (LFUnknown _) = True
512 nodeMustPointToIt (LFBlackHole _) = True -- BH entry may require Node to point
513 nodeMustPointToIt (LFLetNoEscape _) = False
516 The entry conventions depend on the type of closure being entered,
517 whether or not it has free variables, and whether we're running
518 sequentially or in parallel.
520 \begin{tabular}{lllll}
521 Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
522 Unknown & no & yes & stack & node \\
523 Known fun ($\ge$ 1 arg), no fvs & no & no & registers & fast entry (enough args) \\
524 \ & \ & \ & \ & slow entry (otherwise) \\
525 Known fun ($\ge$ 1 arg), fvs & no & yes & registers & fast entry (enough args) \\
526 0 arg, no fvs @\r,\s@ & no & no & n/a & direct entry \\
527 0 arg, no fvs @\u@ & no & yes & n/a & node \\
528 0 arg, fvs @\r,\s@ & no & yes & n/a & direct entry \\
529 0 arg, fvs @\u@ & no & yes & n/a & node \\
531 Unknown & yes & yes & stack & node \\
532 Known fun ($\ge$ 1 arg), no fvs & yes & no & registers & fast entry (enough args) \\
533 \ & \ & \ & \ & slow entry (otherwise) \\
534 Known fun ($\ge$ 1 arg), fvs & yes & yes & registers & node \\
535 0 arg, no fvs @\r,\s@ & yes & no & n/a & direct entry \\
536 0 arg, no fvs @\u@ & yes & yes & n/a & node \\
537 0 arg, fvs @\r,\s@ & yes & yes & n/a & node \\
538 0 arg, fvs @\u@ & yes & yes & n/a & node\\
541 When black-holing, single-entry closures could also be entered via node
542 (rather than directly) to catch double-entry.
546 = EnterIt -- no args, not a function
548 | JumpToIt CLabel -- no args, not a function, but we
549 -- know what its entry code is
551 | ReturnIt -- it's a function, but we have
552 -- zero args to apply to it, so just
555 | ReturnCon DataCon -- It's a data constructor, just return it
557 | SlowCall -- Unknown fun, or known fun with
560 | DirectEntry -- Jump directly, with args in regs
561 CLabel -- The code label
564 getCallMethod :: DynFlags
565 -> Name -- Function being applied
566 -> LambdaFormInfo -- Its info
567 -> Int -- Number of available arguments
570 getCallMethod dflags name lf_info n_args
571 | nodeMustPointToIt lf_info && opt_Parallel
572 = -- If we're parallel, then we must always enter via node.
573 -- The reason is that the closure may have been
574 -- fetched since we allocated it.
577 getCallMethod dflags name (LFReEntrant _ arity _ _) n_args
578 | n_args == 0 = ASSERT( arity /= 0 )
579 ReturnIt -- No args at all
580 | n_args < arity = SlowCall -- Not enough args
581 | otherwise = DirectEntry (enterIdLabel dflags name) arity
583 getCallMethod dflags name (LFCon con) n_args
584 = ASSERT( n_args == 0 )
587 getCallMethod dflags name (LFThunk _ _ updatable std_form_info is_fun) n_args
588 | is_fun -- Must always "call" a function-typed
589 = SlowCall -- thing, cannot just enter it [in eval/apply, the entry code
590 -- is the fast-entry code]
592 | updatable || opt_DoTickyProfiling -- to catch double entry
593 || opt_SMP -- Always enter via node on SMP, since the
594 -- thunk might have been blackholed in the
596 = ASSERT( n_args == 0 ) EnterIt
598 | otherwise -- Jump direct to code for single-entry thunks
599 = ASSERT( n_args == 0 )
600 JumpToIt (thunkEntryLabel dflags name std_form_info updatable)
602 getCallMethod dflags name (LFUnknown True) n_args
603 = SlowCall -- might be a function
605 getCallMethod dflags name (LFUnknown False) n_args
606 = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args )
607 EnterIt -- Not a function
609 getCallMethod dflags name (LFBlackHole _) n_args
610 = SlowCall -- Presumably the black hole has by now
611 -- been updated, but we don't know with
612 -- what, so we slow call it
614 getCallMethod dflags name (LFLetNoEscape 0) n_args
615 = JumpToIt (enterReturnPtLabel (nameUnique name))
617 getCallMethod dflags name (LFLetNoEscape arity) n_args
618 | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
619 | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
621 blackHoleOnEntry :: ClosureInfo -> Bool
622 -- Static closures are never themselves black-holed.
623 -- Updatable ones will be overwritten with a CAFList cell, which points to a
625 -- Single-entry ones have no fvs to plug, and we trust they don't form part
628 blackHoleOnEntry ConInfo{} = False
629 blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
631 = False -- Never black-hole a static closure
635 LFReEntrant _ _ _ _ -> False
636 LFLetNoEscape _ -> False
637 LFThunk _ no_fvs updatable _ _
639 then not opt_OmitBlackHoling
640 else opt_DoTickyProfiling || not no_fvs
641 -- the former to catch double entry,
642 -- and the latter to plug space-leaks. KSW/SDM 1999-04.
644 other -> panic "blackHoleOnEntry" -- Should never happen
646 isStandardFormThunk :: LambdaFormInfo -> Bool
647 isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
648 isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _) = True
649 isStandardFormThunk other_lf_info = False
651 isKnownFun :: LambdaFormInfo -> Bool
652 isKnownFun (LFReEntrant _ _ _ _) = True
653 isKnownFun (LFLetNoEscape _) = True
657 -----------------------------------------------------------------------------
661 staticClosureNeedsLink :: ClosureInfo -> Bool
662 -- A static closure needs a link field to aid the GC when traversing
663 -- the static closure graph. But it only needs such a field if either
665 -- b) it's a constructor with one or more pointer fields
666 -- In case (b), the constructor's fields themselves play the role
668 staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
670 staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
671 = not (isNullaryRepDataCon con) && not_nocaf_constr
675 GenericRep _ _ _ ConstrNoCaf -> False
679 Avoiding generating entries and info tables
680 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
681 At present, for every function we generate all of the following,
682 just in case. But they aren't always all needed, as noted below:
684 [NB1: all of this applies only to *functions*. Thunks always
685 have closure, info table, and entry code.]
687 [NB2: All are needed if the function is *exported*, just to play safe.]
690 * Fast-entry code ALWAYS NEEDED
693 Needed iff (a) we have any un-saturated calls to the function
694 OR (b) the function is passed as an arg
695 OR (c) we're in the parallel world and the function has free vars
696 [Reason: in parallel world, we always enter functions
697 with free vars via the closure.]
699 * The function closure
700 Needed iff (a) we have any un-saturated calls to the function
701 OR (b) the function is passed as an arg
702 OR (c) if the function has free vars (ie not top level)
704 Why case (a) here? Because if the arg-satis check fails,
705 UpdatePAP stuffs a pointer to the function closure in the PAP.
706 [Could be changed; UpdatePAP could stuff in a code ptr instead,
707 but doesn't seem worth it.]
709 [NB: these conditions imply that we might need the closure
710 without the slow-entry code. Here's how.
712 f x y = let g w = ...x..y..w...
716 Here we need a closure for g which contains x and y,
717 but since the calls are all saturated we just jump to the
718 fast entry point for g, with R1 pointing to the closure for g.]
721 * Standard info table
722 Needed iff (a) we have any un-saturated calls to the function
723 OR (b) the function is passed as an arg
724 OR (c) the function has free vars (ie not top level)
726 NB. In the sequential world, (c) is only required so that the function closure has
727 an info table to point to, to keep the storage manager happy.
728 If (c) alone is true we could fake up an info table by choosing
729 one of a standard family of info tables, whose entry code just
732 [NB In the parallel world (c) is needed regardless because
733 we enter functions with free vars via the closure.]
735 If (c) is retained, then we'll sometimes generate an info table
736 (for storage mgr purposes) without slow-entry code. Then we need
737 to use an error label in the info table to substitute for the absent
741 staticClosureRequired
746 staticClosureRequired binder bndr_info
747 (LFReEntrant top_level _ _ _) -- It's a function
748 = ASSERT( isTopLevel top_level )
749 -- Assumption: it's a top-level, no-free-var binding
750 not (satCallsOnly bndr_info)
752 staticClosureRequired binder other_binder_info other_lf_info = True
755 %************************************************************************
757 \subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
759 %************************************************************************
763 isStaticClosure :: ClosureInfo -> Bool
764 isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
766 closureUpdReqd :: ClosureInfo -> Bool
767 closureUpdReqd (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _ }) = upd
768 closureUpdReqd (ClosureInfo { closureLFInfo = LFBlackHole _ }) = True
769 -- Black-hole closures are allocated to receive the results of an
770 -- alg case with a named default... so they need to be updated.
771 closureUpdReqd other_closure = False
773 closureSingleEntry :: ClosureInfo -> Bool
774 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
775 closureSingleEntry other_closure = False
777 closureReEntrant :: ClosureInfo -> Bool
778 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
779 closureReEntrant other_closure = False
781 isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
782 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
783 isConstrClosure_maybe _ = Nothing
785 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
786 closureFunInfo (ClosureInfo { closureLFInfo = LFReEntrant _ arity _ arg_desc})
787 = Just (arity, arg_desc)
793 isToplevClosure :: ClosureInfo -> Bool
794 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
796 LFReEntrant TopLevel _ _ _ -> True
797 LFThunk TopLevel _ _ _ _ -> True
799 isToplevClosure _ = False
805 infoTableLabelFromCI :: ClosureInfo -> CLabel
806 infoTableLabelFromCI (ClosureInfo { closureName = name,
807 closureLFInfo = lf_info,
808 closureSMRep = rep })
810 LFBlackHole info -> info
812 LFThunk _ _ upd_flag (SelectorThunk offset) _ ->
813 mkSelectorInfoLabel upd_flag offset
815 LFThunk _ _ upd_flag (ApThunk arity) _ ->
816 mkApInfoTableLabel upd_flag arity
818 LFThunk{} -> mkLocalInfoTableLabel name
820 LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name
822 other -> panic "infoTableLabelFromCI"
824 infoTableLabelFromCI (ConInfo { closureCon = con,
826 closureDllCon = dll })
827 | isStaticRep rep = mkStaticInfoTableLabel name dll
828 | otherwise = mkConInfoTableLabel name dll
830 name = dataConName con
832 -- ClosureInfo for a closure (as opposed to a constructor) is always local
833 closureLabelFromCI (ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm
834 closureLabelFromCI _ = panic "closureLabelFromCI"
836 -- thunkEntryLabel is a local help function, not exported. It's used from both
837 -- entryLabelFromCI and getCallMethod.
839 thunkEntryLabel dflags thunk_id (ApThunk arity) is_updatable
840 = enterApLabel is_updatable arity
841 thunkEntryLabel dflags thunk_id (SelectorThunk offset) upd_flag
842 = enterSelectorLabel upd_flag offset
843 thunkEntryLabel dflags thunk_id _ is_updatable
844 = enterIdLabel dflags thunk_id
846 enterApLabel is_updatable arity
847 | tablesNextToCode = mkApInfoTableLabel is_updatable arity
848 | otherwise = mkApEntryLabel is_updatable arity
850 enterSelectorLabel upd_flag offset
851 | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
852 | otherwise = mkSelectorEntryLabel upd_flag offset
854 enterIdLabel dflags id
855 | tablesNextToCode = mkInfoTableLabel dflags id
856 | otherwise = mkEntryLabel dflags id
859 | tablesNextToCode = mkLocalInfoTableLabel id
860 | otherwise = mkLocalEntryLabel id
862 enterReturnPtLabel name
863 | tablesNextToCode = mkReturnInfoLabel name
864 | otherwise = mkReturnPtLabel name
868 We need a black-hole closure info to pass to @allocDynClosure@ when we
869 want to allocate the black hole on entry to a CAF. These are the only
870 ways to build an LFBlackHole, maintaining the invariant that it really
871 is a black hole and not something else.
874 cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
876 = ClosureInfo { closureName = nm,
877 closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
878 closureSMRep = BlackHoleRep,
879 closureSRT = NoC_SRT,
882 cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
884 seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
886 = ClosureInfo { closureName = nm,
887 closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
888 closureSMRep = BlackHoleRep,
889 closureSRT = NoC_SRT,
892 seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
895 %************************************************************************
897 \subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
899 %************************************************************************
901 Profiling requires two pieces of information to be determined for
902 each closure's info table --- description and type.
904 The description is stored directly in the @CClosureInfoTable@ when the
907 The type is determined from the type information stored with the @Id@
908 in the closure info using @closureTypeDescr@.
911 closureValDescr, closureTypeDescr :: ClosureInfo -> String
912 closureValDescr (ClosureInfo {closureDescr = descr})
914 closureValDescr (ConInfo {closureCon = con})
915 = occNameUserString (getOccName con)
917 closureTypeDescr (ClosureInfo { closureType = ty })
918 = getTyDescription ty
919 closureTypeDescr (ConInfo { closureCon = data_con })
920 = occNameUserString (getOccName (dataConTyCon data_con))
922 getTyDescription :: Type -> String
924 = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
927 AppTy fun _ -> getTyDescription fun
928 FunTy _ res -> '-' : '>' : fun_result res
929 TyConApp tycon _ -> getOccString tycon
930 NoteTy (FTVNote _) ty -> getTyDescription ty
931 NoteTy (SynNote ty1) _ -> getTyDescription ty1
932 PredTy sty -> getPredTyDescription sty
933 ForAllTy _ ty -> getTyDescription ty
936 fun_result (FunTy _ res) = '>' : fun_result res
937 fun_result other = getTyDescription other
939 getPredTyDescription (ClassP cl tys) = getOccString cl
940 getPredTyDescription (IParam ip ty) = getOccString (ipNameName ip)