8a0f4dd4490daa1dce06788f3cc99cb6ea376f7d
[ghc-hetmet.git] / ghc / compiler / codeGen / CgClosure.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 % $Id: CgClosure.lhs,v 1.71 2005/05/18 04:02:39 wolfgang Exp $
5 %
6 \section[CgClosure]{Code generation for closures}
7
8 This module provides the support code for @StgToAbstractC@ to deal
9 with {\em closures} on the RHSs of let(rec)s.  See also
10 @CgCon@, which deals with constructors.
11
12 \begin{code}
13 module CgClosure ( cgTopRhsClosure, 
14                    cgStdRhsClosure, 
15                    cgRhsClosure,
16                    emitBlackHoleCode,
17                    ) where
18
19 #include "HsVersions.h"
20
21 import {-# SOURCE #-} CgExpr ( cgExpr )
22
23 import CgMonad
24 import CgBindery
25 import CgHeapery
26 import CgStackery       ( mkVirtStkOffsets, pushUpdateFrame, getVirtSp,
27                           setRealAndVirtualSp )
28 import CgProf           ( chooseDynCostCentres, ldvEnter, enterCostCentre,
29                           costCentreFrom )
30 import CgTicky
31 import CgParallel       ( granYield, granFetchAndReschedule )
32 import CgInfoTbls       ( emitClosureCodeAndInfoTable, getSRTInfo )
33 import CgCallConv       ( assignCallRegs, mkArgDescr )
34 import CgUtils          ( emitDataLits, addIdReps, cmmRegOffW, 
35                           emitRtsCallWithVols )
36 import ClosureInfo      -- lots and lots of stuff
37 import SMRep            ( CgRep, cgRepSizeW, argMachRep, fixedHdrSize, WordOff,
38                           idCgRep )
39 import MachOp           ( MachHint(..) )
40 import Cmm
41 import CmmUtils         ( CmmStmts, mkStmts, oneStmt, plusStmts, noStmts,
42                           mkLblExpr, mkIntCLit )
43 import CLabel
44 import StgSyn
45 import StaticFlags      ( opt_DoTickyProfiling )
46 import CostCentre       
47 import Id               ( Id, idName, idType )
48 import Name             ( Name, isExternalName )
49 import Module           ( Module, pprModule )
50 import ListSetOps       ( minusList )
51 import Util             ( isIn, mapAccumL, zipWithEqual )
52 import BasicTypes       ( TopLevelFlag(..) )
53 import Constants        ( oFFSET_StgInd_indirectee, wORD_SIZE )
54 import Outputable
55 import FastString
56 \end{code}
57
58 %********************************************************
59 %*                                                      *
60 \subsection[closures-no-free-vars]{Top-level closures}
61 %*                                                      *
62 %********************************************************
63
64 For closures bound at top level, allocate in static space.
65 They should have no free variables.
66
67 \begin{code}
68 cgTopRhsClosure :: Id
69                 -> CostCentreStack      -- Optional cost centre annotation
70                 -> StgBinderInfo
71                 -> SRT
72                 -> UpdateFlag
73                 -> [Id]         -- Args
74                 -> StgExpr
75                 -> FCode (Id, CgIdInfo)
76
77 cgTopRhsClosure id ccs binder_info srt upd_flag args body = do
78   {     -- LAY OUT THE OBJECT
79     let name = idName id
80   ; lf_info  <- mkClosureLFInfo id TopLevel [] upd_flag args
81   ; srt_info <- getSRTInfo name srt
82   ; mod_name <- moduleName
83   ; let descr         = closureDescription mod_name name
84         closure_info  = mkClosureInfo True id lf_info 0 0 srt_info descr
85         closure_label = mkLocalClosureLabel name
86         cg_id_info    = stableIdInfo id (mkLblExpr closure_label) lf_info
87         closure_rep | not is_caf  = mkStaticClosureFields closure_info ccs True []
88                     | otherwise   = mkStaticClosure (mkRtsInfoLabel SLIT("stg_caf")) ccs
89                                      [CmmLabel (infoTableLabelFromCI closure_info)]
90                                      [mkIntCLit 0, mkIntCLit 0]
91                                      [] []
92                                      
93         is_caf = null args
94               && not (closureReEntrant closure_info)
95               && isStaticClosure closure_info 
96                                      
97          -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
98   ; emitDataLits closure_label closure_rep
99   ; forkClosureBody (closureCodeBody binder_info closure_info
100                                      ccs args body)
101
102   ; returnFC (id, cg_id_info) }
103 \end{code}
104
105 %********************************************************
106 %*                                                      *
107 \subsection[non-top-level-closures]{Non top-level closures}
108 %*                                                      *
109 %********************************************************
110
111 For closures with free vars, allocate in heap.
112
113 \begin{code}
114 cgStdRhsClosure
115         :: Id
116         -> CostCentreStack      -- Optional cost centre annotation
117         -> StgBinderInfo
118         -> [Id]                 -- Free vars
119         -> [Id]                 -- Args
120         -> StgExpr
121         -> LambdaFormInfo
122         -> [StgArg]             -- payload
123         -> FCode (Id, CgIdInfo)
124
125 cgStdRhsClosure bndr cc bndr_info fvs args body lf_info payload 
126   = do  -- AHA!  A STANDARD-FORM THUNK
127   {     -- LAY OUT THE OBJECT
128     amodes <- getArgAmodes payload
129   ; mod_name <- moduleName
130   ; let (tot_wds, ptr_wds, amodes_w_offsets) 
131             = mkVirtHeapOffsets (isLFThunk lf_info) amodes
132
133         descr        = closureDescription mod_name (idName bndr)
134         closure_info = mkClosureInfo False      -- Not static
135                                      bndr lf_info tot_wds ptr_wds 
136                                      NoC_SRT    -- No SRT for a std-form closure
137                                      descr
138                 
139   ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
140
141         -- BUILD THE OBJECT
142   ; heap_offset <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
143
144         -- RETURN
145   ; returnFC (bndr, heapIdInfo bndr heap_offset lf_info) }
146 \end{code}
147
148 Here's the general case.
149
150 \begin{code}
151 cgRhsClosure    :: Id
152                 -> CostCentreStack      -- Optional cost centre annotation
153                 -> StgBinderInfo
154                 -> SRT
155                 -> [Id]                 -- Free vars
156                 -> UpdateFlag
157                 -> [Id]                 -- Args
158                 -> StgExpr
159                 -> FCode (Id, CgIdInfo)
160
161 cgRhsClosure bndr cc bndr_info srt fvs upd_flag args body = do
162   {     -- LAY OUT THE OBJECT
163         -- If the binder is itself a free variable, then don't store
164         -- it in the closure.  Instead, just bind it to Node on entry.
165         -- NB we can be sure that Node will point to it, because we
166         -- havn't told mkClosureLFInfo about this; so if the binder
167         -- _was_ a free var of its RHS, mkClosureLFInfo thinks it *is*
168         -- stored in the closure itself, so it will make sure that
169         -- Node points to it...
170     let
171         name         = idName bndr
172         is_elem      = isIn "cgRhsClosure"
173         bndr_is_a_fv = bndr `is_elem` fvs
174         reduced_fvs | bndr_is_a_fv = fvs `minusList` [bndr]
175                     | otherwise    = fvs
176
177   ; lf_info <- mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
178   ; fv_infos <- mapFCs getCgIdInfo reduced_fvs
179   ; srt_info <- getSRTInfo name srt
180   ; mod_name <- moduleName
181   ; let bind_details :: [(CgIdInfo, VirtualHpOffset)]
182         (tot_wds, ptr_wds, bind_details) 
183            = mkVirtHeapOffsets (isLFThunk lf_info) (map add_rep fv_infos)
184
185         add_rep info = (cgIdInfoArgRep info, info)
186
187         descr        = closureDescription mod_name name
188         closure_info = mkClosureInfo False      -- Not static
189                                      bndr lf_info tot_wds ptr_wds
190                                      srt_info descr
191
192         -- BUILD ITS INFO TABLE AND CODE
193   ; forkClosureBody (do
194         {       -- Bind the fvs
195           let bind_fv (info, offset) 
196                 = bindNewToNode (cgIdInfoId info) offset (cgIdInfoLF info)
197         ; mapCs bind_fv bind_details
198
199                 -- Bind the binder itself, if it is a free var
200         ; whenC bndr_is_a_fv (bindNewToReg bndr nodeReg lf_info)
201         
202                 -- Compile the body
203         ; closureCodeBody bndr_info closure_info cc args body })
204
205         -- BUILD THE OBJECT
206   ; let
207         to_amode (info, offset) = do { amode <- idInfoToAmode info
208                                      ; return (amode, offset) }
209   ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
210   ; amodes_w_offsets <- mapFCs to_amode bind_details
211   ; heap_offset <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
212
213         -- RETURN
214   ; returnFC (bndr, heapIdInfo bndr heap_offset lf_info) }
215
216
217 mkClosureLFInfo :: Id           -- The binder
218                 -> TopLevelFlag -- True of top level
219                 -> [Id]         -- Free vars
220                 -> UpdateFlag   -- Update flag
221                 -> [Id]         -- Args
222                 -> FCode LambdaFormInfo
223 mkClosureLFInfo bndr top fvs upd_flag args
224   | null args = return (mkLFThunk (idType bndr) top fvs upd_flag)
225   | otherwise = do { arg_descr <- mkArgDescr (idName bndr) args
226                    ; return (mkLFReEntrant top fvs args arg_descr) }
227 \end{code}
228
229
230 %************************************************************************
231 %*                                                                      *
232 \subsection[code-for-closures]{The code for closures}
233 %*                                                                      *
234 %************************************************************************
235
236 \begin{code}
237 closureCodeBody :: StgBinderInfo
238                 -> ClosureInfo     -- Lots of information about this closure
239                 -> CostCentreStack -- Optional cost centre attached to closure
240                 -> [Id]
241                 -> StgExpr
242                 -> Code
243 \end{code}
244
245 There are two main cases for the code for closures.  If there are {\em
246 no arguments}, then the closure is a thunk, and not in normal form.
247 So it should set up an update frame (if it is shared).
248 NB: Thunks cannot have a primitive type!
249
250 \begin{code}
251 closureCodeBody binder_info cl_info cc [{- No args i.e. thunk -}] body = do
252   { body_absC <- getCgStmts $ do
253         { tickyEnterThunk cl_info
254         ; ldvEnter (CmmReg nodeReg)  -- NB: Node always points when profiling
255         ; thunkWrapper cl_info $ do
256                 -- We only enter cc after setting up update so
257                 -- that cc of enclosing scope will be recorded
258                 -- in update frame CAF/DICT functions will be
259                 -- subsumed by this enclosing cc
260             { enterCostCentre cl_info cc body
261             ; cgExpr body }
262         }
263     
264   ; emitClosureCodeAndInfoTable cl_info [] body_absC }
265 \end{code}
266
267 If there is /at least one argument/, then this closure is in
268 normal form, so there is no need to set up an update frame.
269
270 The Macros for GrAnSim are produced at the beginning of the
271 argSatisfactionCheck (by calling fetchAndReschedule).  There info if
272 Node points to closure is available. -- HWL
273
274 \begin{code}
275 closureCodeBody binder_info cl_info cc args body 
276   = ASSERT( length args > 0 )
277   do {  -- Get the current virtual Sp (it might not be zero, 
278         -- eg. if we're compiling a let-no-escape).
279     vSp <- getVirtSp
280   ; let (reg_args, other_args) = assignCallRegs (addIdReps args)
281         (sp_top, stk_args)     = mkVirtStkOffsets vSp other_args
282
283         -- Allocate the global ticky counter
284   ; let ticky_ctr_lbl = mkRednCountsLabel (closureName cl_info)
285   ; emitTickyCounter cl_info args sp_top
286
287         -- ...and establish the ticky-counter 
288         -- label for this block
289   ; setTickyCtrLabel ticky_ctr_lbl $ do
290
291         -- Emit the slow-entry code
292   { reg_save_code <- mkSlowEntryCode cl_info reg_args
293
294         -- Emit the main entry code
295   ; blks <- forkProc $
296             mkFunEntryCode cl_info cc reg_args stk_args
297                            sp_top reg_save_code body
298   ; emitClosureCodeAndInfoTable cl_info [] blks
299   }}
300
301
302
303 mkFunEntryCode :: ClosureInfo
304                -> CostCentreStack
305                -> [(Id,GlobalReg)]        -- Args in regs
306                -> [(Id,VirtualSpOffset)]  -- Args on stack
307                -> VirtualSpOffset         -- Last allocated word on stack
308                -> CmmStmts                -- Register-save code in case of GC
309                -> StgExpr
310                -> Code
311 -- The main entry code for the closure
312 mkFunEntryCode cl_info cc reg_args stk_args sp_top reg_save_code body = do
313   {     -- Bind args to regs/stack as appropriate,
314         -- and record expected position of sps
315   ; bindArgsToRegs  reg_args
316   ; bindArgsToStack stk_args
317   ; setRealAndVirtualSp sp_top
318
319         -- Enter the cost-centre, if required
320         -- ToDo: It's not clear why this is outside the funWrapper,
321         --       but the tickyEnterFun is inside. Perhaps we can put
322         --       them together?
323   ; enterCostCentre cl_info cc body
324
325         -- Do the business
326   ; funWrapper cl_info reg_args reg_save_code $ do
327         { tickyEnterFun cl_info
328         ; cgExpr body }
329   }
330 \end{code}
331
332 The "slow entry" code for a function.  This entry point takes its
333 arguments on the stack.  It loads the arguments into registers
334 according to the calling convention, and jumps to the function's
335 normal entry point.  The function's closure is assumed to be in
336 R1/node.
337
338 The slow entry point is used in two places:
339
340  (a) unknown calls: eg. stg_PAP_entry 
341  (b) returning from a heap-check failure
342
343 \begin{code}
344 mkSlowEntryCode :: ClosureInfo -> [(Id,GlobalReg)] -> FCode CmmStmts
345 -- If this function doesn't have a specialised ArgDescr, we need
346 -- to generate the function's arg bitmap, slow-entry code, and
347 -- register-save code for the heap-check failure
348 -- Here, we emit the slow-entry code, and 
349 -- return the register-save assignments
350 mkSlowEntryCode cl_info reg_args
351   | Just (_, ArgGen _) <- closureFunInfo cl_info
352   = do  { emitSimpleProc slow_lbl (emitStmts load_stmts)
353         ; return save_stmts }
354   | otherwise = return noStmts
355   where
356      name = closureName cl_info
357      slow_lbl = mkSlowEntryLabel name
358
359      load_stmts = mkStmts load_assts `plusStmts` mkStmts [stk_adj_pop, jump_to_entry]
360      save_stmts = oneStmt stk_adj_push `plusStmts`  mkStmts save_assts
361
362      reps_w_regs :: [(CgRep,GlobalReg)]
363      reps_w_regs = [(idCgRep id, reg) | (id,reg) <- reverse reg_args]
364      (final_stk_offset, stk_offsets)
365         = mapAccumL (\off (rep,_) -> (off + cgRepSizeW rep, off))
366                     0 reps_w_regs
367
368      load_assts = zipWithEqual "mk_load" mk_load reps_w_regs stk_offsets
369      mk_load (rep,reg) offset = CmmAssign (CmmGlobal reg) 
370                                           (CmmLoad (cmmRegOffW spReg offset)
371                                                    (argMachRep rep))
372
373      save_assts = zipWithEqual "mk_save" mk_save reps_w_regs stk_offsets
374      mk_save (rep,reg) offset = ASSERT( argMachRep rep == globalRegRep reg )
375                                 CmmStore (cmmRegOffW spReg offset) 
376                                          (CmmReg (CmmGlobal reg))
377
378      stk_adj_pop   = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
379      stk_adj_push  = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
380      jump_to_entry = CmmJump (mkLblExpr (enterLocalIdLabel name)) []
381 \end{code}
382
383
384 %************************************************************************
385 %*                                                                      *
386 \subsubsection[closure-code-wrappers]{Wrappers around closure code}
387 %*                                                                      *
388 %************************************************************************
389
390 \begin{code}
391 thunkWrapper:: ClosureInfo -> Code -> Code
392 thunkWrapper closure_info thunk_code = do
393   { let node_points = nodeMustPointToIt (closureLFInfo closure_info)
394
395     -- HWL: insert macros for GrAnSim; 2 versions depending on liveness of node
396     -- (we prefer fetchAndReschedule-style context switches to yield ones)
397   ; if node_points 
398     then granFetchAndReschedule [] node_points 
399     else granYield              [] node_points
400
401         -- Stack and/or heap checks
402   ; thunkEntryChecks closure_info $ do
403         {       -- Overwrite with black hole if necessary
404           whenC (blackHoleOnEntry closure_info && node_points)
405                 (blackHoleIt closure_info)
406         ; setupUpdate closure_info thunk_code }
407                 -- setupUpdate *encloses* the thunk_code
408   }
409
410 funWrapper :: ClosureInfo       -- Closure whose code body this is
411            -> [(Id,GlobalReg)]  -- List of argument registers (if any)
412            -> CmmStmts          -- reg saves for the heap check failure
413            -> Code              -- Body of function being compiled
414            -> Code
415 funWrapper closure_info arg_regs reg_save_code fun_body = do
416   { let node_points = nodeMustPointToIt (closureLFInfo closure_info)
417
418         -- Enter for Ldv profiling
419   ; whenC node_points (ldvEnter (CmmReg nodeReg))
420
421         -- GranSim yeild poin
422   ; granYield arg_regs node_points
423
424         -- Heap and/or stack checks wrap the function body
425   ; funEntryChecks closure_info reg_save_code 
426                    fun_body
427   }
428 \end{code}
429
430
431 %************************************************************************
432 %*                                                                      *
433 \subsubsubsection[update-and-BHs]{Update and black-hole wrappers}
434 %*                                                                      *
435 %************************************************************************
436
437
438 \begin{code}
439 blackHoleIt :: ClosureInfo -> Code
440 -- Only called for closures with no args
441 -- Node points to the closure
442 blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
443
444 emitBlackHoleCode :: Bool -> Code
445 emitBlackHoleCode is_single_entry 
446   | eager_blackholing = do 
447         tickyBlackHole (not is_single_entry)
448         stmtC (CmmStore (CmmReg nodeReg) (CmmLit (CmmLabel bh_lbl)))
449   | otherwise = 
450         nopC
451   where
452     bh_lbl | is_single_entry = mkRtsDataLabel SLIT("stg_SE_BLACKHOLE_info")
453            | otherwise       = mkRtsDataLabel SLIT("stg_BLACKHOLE_info")
454
455         -- If we wanted to do eager blackholing with slop filling,
456         -- we'd need to do it at the *end* of a basic block, otherwise
457         -- we overwrite the free variables in the thunk that we still
458         -- need.  We have a patch for this from Andy Cheadle, but not
459         -- incorporated yet. --SDM [6/2004]
460         --
461         -- Profiling needs slop filling (to support LDV profiling), so
462         -- currently eager blackholing doesn't work with profiling.
463         --
464         -- TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of
465         -- single-entry thunks.
466     eager_blackholing 
467         | opt_DoTickyProfiling = True
468         | otherwise            = False
469
470 \end{code}
471
472 \begin{code}
473 setupUpdate :: ClosureInfo -> Code -> Code      -- Only called for closures with no args
474         -- Nota Bene: this function does not change Node (even if it's a CAF),
475         -- so that the cost centre in the original closure can still be
476         -- extracted by a subsequent enterCostCentre
477 setupUpdate closure_info code
478   | closureReEntrant closure_info
479   = code
480
481   | not (isStaticClosure closure_info)
482   = if closureUpdReqd closure_info
483     then do { tickyPushUpdateFrame;  pushUpdateFrame (CmmReg nodeReg) code }
484     else do { tickyUpdateFrameOmitted; code }
485  
486   | otherwise   -- A static closure
487   = do  { tickyUpdateBhCaf closure_info
488
489         ; if closureUpdReqd closure_info
490           then do       -- Blackhole the (updatable) CAF:
491                 code
492                 -- { upd_closure <- link_caf closure_info True
493                 -- ; pushUpdateFrame upd_closure code }
494           else do
495                 {       -- No update reqd, you'd think we don't need to 
496                         -- black-hole it. But when ticky-ticky is on, we 
497                         -- black-hole it regardless, to catch errors in which
498                         -- an allegedly single-entry closure is entered twice
499                         --
500                         -- We discard the pointer returned by link_caf, because
501                         -- we don't push an update frame
502                   whenC opt_DoTickyProfiling -- Blackhole even a SE CAF
503                         (link_caf closure_info False >> nopC)
504                 ; tickyUpdateFrameOmitted
505                 ; code }
506     }
507
508
509 -----------------------------------------------------------------------------
510 -- Entering a CAF
511 --
512 -- When a CAF is first entered, it creates a black hole in the heap,
513 -- and updates itself with an indirection to this new black hole.
514 --
515 -- We update the CAF with an indirection to a newly-allocated black
516 -- hole in the heap.  We also set the blocking queue on the newly
517 -- allocated black hole to be empty.
518 --
519 -- Why do we make a black hole in the heap when we enter a CAF?
520 --    
521 --     - for a  generational garbage collector, which needs a fast
522 --       test for whether an updatee is in an old generation or not
523 --
524 --     - for the parallel system, which can implement updates more
525 --       easily if the updatee is always in the heap. (allegedly).
526 --
527 -- When debugging, we maintain a separate CAF list so we can tell when
528 -- a CAF has been garbage collected.
529
530 -- newCAF must be called before the itbl ptr is overwritten, since
531 -- newCAF records the old itbl ptr in order to do CAF reverting
532 -- (which Hugs needs to do in order that combined mode works right.)
533 --
534
535 -- ToDo [Feb 04]  This entire link_caf nonsense could all be moved
536 -- into the "newCAF" RTS procedure, which we call anyway, including
537 -- the allocation of the black-hole indirection closure.
538 -- That way, code size would fall, the CAF-handling code would 
539 -- be closer together, and the compiler wouldn't need to know
540 -- about off_indirectee etc.
541
542 link_caf :: ClosureInfo
543          -> Bool                -- True <=> updatable, False <=> single-entry
544          -> FCode CmmExpr       -- Returns amode for closure to be updated
545 -- To update a CAF we must allocate a black hole, link the CAF onto the
546 -- CAF list, then update the CAF to point to the fresh black hole.
547 -- This function returns the address of the black hole, so it can be
548 -- updated with the new value when available.  The reason for all of this
549 -- is that we only want to update dynamic heap objects, not static ones,
550 -- so that generational GC is easier.
551 link_caf cl_info is_upd = do
552   {     -- Alloc black hole specifying CC_HDR(Node) as the cost centre
553   ; let use_cc   = costCentreFrom (CmmReg nodeReg)
554         blame_cc = use_cc
555   ; hp_offset <- allocDynClosure bh_cl_info use_cc blame_cc []
556   ; hp_rel    <- getHpRelOffset hp_offset
557
558         -- Call the RTS function newCAF to add the CAF to the CafList
559         -- so that the garbage collector can find them
560         -- This must be done *before* the info table pointer is overwritten, 
561         -- because the old info table ptr is needed for reversion
562   ; emitRtsCallWithVols SLIT("newCAF") [(CmmReg nodeReg,PtrHint)] [node]
563         -- node is live, so save it.
564
565         -- Overwrite the closure with a (static) indirection 
566         -- to the newly-allocated black hole
567   ; stmtsC [ CmmStore (cmmRegOffW nodeReg off_indirectee) hp_rel
568            , CmmStore (CmmReg nodeReg) ind_static_info ]
569
570   ; returnFC hp_rel }
571   where
572     bh_cl_info :: ClosureInfo
573     bh_cl_info | is_upd    = cafBlackHoleClosureInfo   cl_info
574                | otherwise = seCafBlackHoleClosureInfo cl_info
575
576     ind_static_info :: CmmExpr
577     ind_static_info = mkLblExpr mkIndStaticInfoLabel
578
579     off_indirectee :: WordOff
580     off_indirectee = fixedHdrSize + oFFSET_StgInd_indirectee*wORD_SIZE
581 \end{code}
582
583
584 %************************************************************************
585 %*                                                                      *
586 \subsection[CgClosure-Description]{Profiling Closure Description.}
587 %*                                                                      *
588 %************************************************************************
589
590 For "global" data constructors the description is simply occurrence
591 name of the data constructor itself.  Otherwise it is determined by
592 @closureDescription@ from the let binding information.
593
594 \begin{code}
595 closureDescription :: Module            -- Module
596                    -> Name              -- Id of closure binding
597                    -> String
598         -- Not called for StgRhsCon which have global info tables built in
599         -- CgConTbls.lhs with a description generated from the data constructor
600 closureDescription mod_name name
601   = showSDocDump (char '<' <>
602                     (if isExternalName name
603                       then ppr name -- ppr will include the module name prefix
604                       else pprModule mod_name <> char '.' <> ppr name) <>
605                     char '>')
606    -- showSDocDump, because we want to see the unique on the Name.
607 \end{code}
608