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