[project @ 2002-11-18 10:45:45 by simonmar]

[ghc-hetmet.git] / ghc / compiler / codeGen / CgCon.lhs

diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
index 1e0fa93..ce9e675 100644 (file)
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ b/ghc/compiler/codeGen/CgCon.lhs
@@ -40,12 +40,12 @@ import CgTailCall   ( performReturn, mkStaticAlgReturnCode, doTailCall,
 import CLabel          ( mkClosureLabel )
 import ClosureInfo     ( mkConLFInfo, mkLFArgument, closureLFInfo,
                          layOutDynConstr, layOutDynClosure,
-                         layOutStaticConstr, closureSize
+                         layOutStaticConstr, closureSize, mkStaticClosure
                        )
 import CostCentre      ( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
                          currentCCS )
 import DataCon         ( DataCon, dataConName, dataConTag, 
-                         isUnboxedTupleCon, isNullaryDataCon, dataConId, 
+                         isUnboxedTupleCon, isNullaryDataCon, dataConWorkId, 
                          dataConWrapId, dataConRepArity
                        )
 import Id              ( Id, idName, idPrimRep )
@@ -67,8 +67,9 @@ import Outputable
 cgTopRhsCon :: Id              -- Name of thing bound to this RHS
            -> DataCon          -- Id
            -> [StgArg]         -- Args
+           -> SRT
            -> FCode (Id, CgIdInfo)
-cgTopRhsCon id con args
+cgTopRhsCon id con args srt
   = ASSERT( not (isDllConApp con args) )       -- checks for litlit args too
     ASSERT( args `lengthIs` dataConRepArity con )
 
@@ -77,19 +78,23 @@ cgTopRhsCon id con args
 
     let
        name          = idName id
-       closure_label = mkClosureLabel name
        lf_info       = closureLFInfo closure_info
-       (closure_info, amodes_w_offsets) = layOutStaticConstr name con getAmodeRep amodes
+       closure_label = mkClosureLabel name
+       (closure_info, amodes_w_offsets) 
+               = layOutStaticConstr name con getAmodeRep amodes
     in
 
        -- BUILD THE OBJECT
-    absC (CStaticClosure
-           closure_label               -- Labelled with the name on lhs of defn
-           closure_info                -- Closure is static
-           (mkCCostCentreStack dontCareCCS) -- because it's static data
-           (map fst amodes_w_offsets)) -- Sorted into ptrs first, then nonptrs
-
-                                                       `thenC`
+    absC (mkStaticClosure
+           closure_info
+           dontCareCCS                 -- because it's static data
+           (map fst amodes_w_offsets)  -- Sorted into ptrs first, then nonptrs
+           (nonEmptySRT srt)           -- has CAF refs
+         )                                     `thenC`
+               -- NOTE: can't use idCafInfo instead of nonEmptySRT above,
+               -- because top-level constructors that were floated by
+               -- CorePrep don't have CafInfo attached.  The SRT is more
+               -- reliable.
 
        -- RETURN
     returnFC (id, stableAmodeIdInfo id (CLbl closure_label PtrRep) lf_info)
@@ -252,7 +257,7 @@ bindUnboxedTupleComponents args
 
     bindArgsToRegs reg_args arg_regs           `thenC`
     mapCs bindNewToStack stk_offsets           `thenC`
-    returnFC (arg_regs,tags, not (null stk_offsets))
+    returnFC (arg_regs,tags, notNull stk_offsets)
 \end{code}
 
 %************************************************************************
@@ -311,7 +316,7 @@ cgReturnDataCon con amodes
                temp = CTemp uniq PtrRep 
           in
 
-          profCtrC SLIT("TICK_UPD_CON_IN_PLACE") 
+          profCtrC FSLIT("TICK_UPD_CON_IN_PLACE") 
                        [mkIntCLit (length amodes)] `thenC`
 
           getSpRelOffset args_sp                       `thenFC` \ sp_rel ->
@@ -347,7 +352,7 @@ cgReturnDataCon con amodes
                  let (ret_regs, leftovers) = 
                         assignRegs [] (map getAmodeRep amodes)
                  in
-                 profCtrC SLIT("TICK_RET_UNBOXED_TUP") 
+                 profCtrC FSLIT("TICK_RET_UNBOXED_TUP") 
                                [mkIntCLit (length amodes)] `thenC`
 
                  doTailCall amodes ret_regs 
@@ -374,12 +379,12 @@ cgReturnDataCon con amodes
                -- temporary variable, if the closure is a CHARLIKE.
                -- funnily enough, this makes the unique always come
                -- out as '54' :-)
-         buildDynCon (dataConId con) currentCCS con amodes     `thenFC` \ idinfo ->
+         buildDynCon (dataConWorkId con) currentCCS con amodes `thenFC` \ idinfo ->
          idInfoToAmode PtrRep idinfo                           `thenFC` \ amode ->
 
 
                -- RETURN
-         profCtrC SLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
+         profCtrC FSLIT("TICK_RET_NEW") [mkIntCLit (length amodes)] `thenC`
          -- could use doTailCall here.
          performReturn (move_to_reg amode node) return
 \end{code}