eliminate ConInfo

8 files changed, 74 insertions, 107 deletions

diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs
index bc502a30a3..44b40a3a8a 100644
--- a/compiler/cmm/SMRep.lhs
+++ b/compiler/cmm/SMRep.lhs
@@ -25,7 +25,7 @@ module SMRep (
         mkHeapRep, blackHoleRep, mkStackRep, mkRTSRep,
 
         -- ** Predicates
-        isStaticRep, isConRep, isThunkRep, isStaticNoCafCon,
+        isStaticRep, isConRep, isThunkRep, isFunRep, isStaticNoCafCon,
 
         -- ** Size-related things
         heapClosureSize,
@@ -196,6 +196,10 @@ isThunkRep (HeapRep _ _ _ ThunkSelector{}) = True
 isThunkRep (HeapRep _ _ _ BlackHole{})     = True
 isThunkRep _                               = False
 
+isFunRep :: SMRep -> Bool
+isFunRep (HeapRep _ _ _ Fun{}) = True
+isFunRep _                     = False
+
 isStaticNoCafCon :: SMRep -> Bool
 -- This should line up exactly with CONSTR_NOCAF_STATIC above
 -- See Note [Static NoCaf constructors]
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index f88541a023..0928645964 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -24,7 +24,6 @@ import StgCmmTicky
 
 import Cmm
 import CLabel
-import PprCmm
 
 import StgSyn
 import DynFlags
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index e8874fa752..84b33ef29b 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -298,7 +298,8 @@ mkRhsClosure bndr cc _ fvs upd_flag srt args body
 	; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
         ; emit (mkComment $ mkFastString "calling allocDynClosure")
         ; let toVarArg (NonVoid a, off) = (NonVoid (StgVarArg a), off)
-	; (tmp, init) <- allocDynClosure closure_info use_cc blame_cc
+        ; let info_tbl = mkCmmInfo closure_info
+        ; (tmp, init) <- allocDynClosure info_tbl lf_info use_cc blame_cc
 				         (map toVarArg fv_details)
 
 	-- RETURN
@@ -334,7 +335,9 @@ cgStdThunk bndr cc _bndr_info body lf_info payload
   ; (use_cc, blame_cc) <- chooseDynCostCentres cc [{- no args-}] body
 
 	-- BUILD THE OBJECT
-  ; (tmp, init) <- allocDynClosure closure_info use_cc blame_cc payload_w_offsets
+  ; let info_tbl = mkCmmInfo closure_info
+  ; (tmp, init) <- allocDynClosure info_tbl lf_info
+                                   use_cc blame_cc payload_w_offsets
 
 	-- RETURN
   ; regIdInfo bndr lf_info tmp init }
@@ -555,7 +558,7 @@ setupUpdate closure_info node body
 
 	; if closureUpdReqd closure_info
 	  then do	-- Blackhole the (updatable) CAF:
-		{ upd_closure <- link_caf closure_info True
+                { upd_closure <- link_caf True
 		; pushUpdateFrame [CmmReg (CmmLocal upd_closure),
                                      mkLblExpr mkUpdInfoLabel] body } -- XXX black hole
 	  else do {tickyUpdateFrameOmitted; body}
@@ -611,8 +614,7 @@ pushUpdateFrame es body
 -- be closer together, and the compiler wouldn't need to know
 -- about off_indirectee etc.
 
-link_caf :: ClosureInfo
-	 -> Bool		-- True <=> updatable, False <=> single-entry
+link_caf :: Bool                -- True <=> updatable, False <=> single-entry
          -> FCode LocalReg      -- Returns amode for closure to be updated
 -- To update a CAF we must allocate a black hole, link the CAF onto the
 -- CAF list, then update the CAF to point to the fresh black hole.
@@ -620,13 +622,14 @@ link_caf :: ClosureInfo
 -- updated with the new value when available.  The reason for all of this
 -- is that we only want to update dynamic heap objects, not static ones,
 -- so that generational GC is easier.
-link_caf cl_info _is_upd = do
+link_caf _is_upd = do
   { 	-- Alloc black hole specifying CC_HDR(Node) as the cost centre
   ; let	use_cc   = costCentreFrom (CmmReg nodeReg)
         blame_cc = use_cc
         tso      = CmmReg (CmmGlobal CurrentTSO)
-    -- XXX ezyang: FIXME
-  ; (hp_rel, init) <- allocDynClosureCmm bh_cl_info use_cc blame_cc [(tso,fixedHdrSize)]
+
+  ; (hp_rel, init) <- allocDynClosureCmm cafBlackHoleInfoTable mkLFBlackHole
+                                         use_cc blame_cc [(tso,fixedHdrSize)]
   ; emit init
 
 	-- Call the RTS function newCAF to add the CAF to the CafList
@@ -646,9 +649,6 @@ link_caf cl_info _is_upd = do
 
   ; return hp_rel }
   where
-    bh_cl_info :: ClosureInfo
-    bh_cl_info = cafBlackHoleClosureInfo cl_info
-
     ind_static_info :: CmmExpr
     ind_static_info = mkLblExpr mkIndStaticInfoLabel
 
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 58eb427f22..64e3e2b90f 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -27,12 +27,13 @@ module StgCmmClosure (
 	StandardFormInfo,	-- ...ditto...
 	mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
 	mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
-	lfDynTag,
-        maybeIsLFCon, isLFThunk, isLFReEntrant,
+        mkLFBlackHole,
+        lfDynTag,
+        maybeIsLFCon, isLFThunk, isLFReEntrant, lfUpdatable,
 
 	-----------------------------------
 	ClosureInfo,
-	mkClosureInfo, mkConInfo, 
+        mkClosureInfo,
         mkCmmInfo,
 
         closureSize,
@@ -40,7 +41,7 @@ module StgCmmClosure (
 	closureLabelFromCI, closureProf, closureSRT,
 	closureLFInfo, closureSMRep, closureUpdReqd, 
         closureIsThunk,
-	closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
+        closureSingleEntry, closureReEntrant,
 	closureFunInfo,	isStandardFormThunk, isKnownFun,
         funTag, tagForArity, 
 
@@ -53,11 +54,11 @@ module StgCmmClosure (
 
 	isToplevClosure,
 	isStaticClosure,
-	cafBlackHoleClosureInfo, 
 
-        staticClosureNeedsLink, clHasCafRefs, clProfInfo,
+        staticClosureNeedsLink, clHasCafRefs,
 
         mkDataConInfoTable,
+        cafBlackHoleInfoTable
     ) where
 
 #include "../includes/MachDeps.h"
@@ -152,6 +153,9 @@ data LambdaFormInfo
 			-- of a CAF.  We want the target of the update frame to
 			-- be in the heap, so we make a black hole to hold it.
 
+                        -- XXX we can very nearly get rid of this, but
+                        -- allocDynClosure needs a LambdaFormInfo
+
 
 -------------------------
 -- An ArgDsecr describes the argument pattern of a function
@@ -286,6 +290,10 @@ mkLFImported id
   where
     arity = idArity id
 
+------------
+mkLFBlackHole :: LambdaFormInfo
+mkLFBlackHole = LFBlackHole
+
 -----------------------------------------------------
 --		Dynamic pointer tagging
 -----------------------------------------------------
@@ -648,10 +656,8 @@ enough information
   b) to allocate a closure containing that info pointer (i.e.
 	it knows the info table label)
 
-We make a ClosureInfo for
-  - each let binding (both top level and not)
-  - each data constructor (for its shared static and
-	dynamic info tables)
+We make a ClosureInfo for each let binding (both top level and not),
+but not bindings for data constructors.
 
 Note [Closure CAF info]
 ~~~~~~~~~~~~~~~~~~~~~~~
@@ -674,22 +680,10 @@ data ClosureInfo
 	closureInfLcl :: Bool             -- Can the info pointer be a local symbol?
     }
 
-  -- Constructor closures don't have a unique info table label (they use
-  -- the constructor's info table), and they don't have an SRT.
-  | ConInfo {
-	closureCon   :: !DataCon,
-	closureSMRep :: !SMRep,
-        closureCafs  :: !CafInfo        -- See Note [Closure CAF info]
-    }
-
 clHasCafRefs :: ClosureInfo -> CafInfo
 -- Backward compatibility; remove
 clHasCafRefs = closureCafs
 
-clProfInfo :: ClosureInfo -> ProfilingInfo
-clProfInfo ClosureInfo{ closureProf = p } = p
-clProfInfo _                              = NoProfilingInfo
-
 --------------------------------------
 --	Building ClosureInfos
 --------------------------------------
@@ -719,32 +713,6 @@ mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info val_descr
     prof   = mkProfilingInfo id val_descr
     nonptr_wds = tot_wds - ptr_wds
 
-mkConInfo :: Bool	-- Is static
-	  -> CafInfo 
-	  -> DataCon	
-	  -> Int -> Int	-- Total and pointer words
-	  -> ClosureInfo
-mkConInfo is_static cafs data_con tot_wds ptr_wds
-   = ConInfo { closureSMRep = sm_rep
-             , closureCafs = cafs
-	     , closureCon = data_con }
-  where
-    sm_rep  = mkHeapRep is_static ptr_wds nonptr_wds (lfClosureType lf_info)
-    lf_info = mkConLFInfo data_con
-    nonptr_wds = tot_wds - ptr_wds
-
--- We need a black-hole closure info to pass to @allocDynClosure@ when we
--- want to allocate the black hole on entry to a CAF.  These are the only
--- ways to build an LFBlackHole, maintaining the invariant that it really
--- is a black hole and not something else.
-
-cafBlackHoleClosureInfo :: ClosureInfo -> ClosureInfo
-cafBlackHoleClosureInfo cl_info@(ClosureInfo {})
-  = cl_info { closureLFInfo = LFBlackHole
-	    , closureSMRep  = blackHoleRep
-	    , closureSRT    = NoC_SRT
-	    , closureInfLcl = False }
-cafBlackHoleClosureInfo (ConInfo {}) = panic "cafBlackHoleClosureInfo"
 
 -- Convert from 'ClosureInfo' to 'CmmInfoTable'.
 -- Not used for return points.
@@ -752,7 +720,7 @@ mkCmmInfo :: ClosureInfo -> CmmInfoTable
 mkCmmInfo cl_info
   = CmmInfoTable { cit_lbl  = infoTableLabelFromCI cl_info,
                    cit_rep  = closureSMRep cl_info,
-                   cit_prof = clProfInfo cl_info,
+                   cit_prof = closureProf cl_info,
                    cit_srt  = closureSRT cl_info }
 
 
@@ -774,7 +742,6 @@ blackHoleOnEntry :: DynFlags -> ClosureInfo -> Bool
 -- Single-entry ones have no fvs to plug, and we trust they don't form part 
 -- of a loop.
 
-blackHoleOnEntry _ ConInfo{} = False
 blackHoleOnEntry dflags (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
   | isStaticRep rep
   = False	-- Never black-hole a static closure
@@ -797,7 +764,6 @@ isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
 
 closureUpdReqd :: ClosureInfo -> Bool
 closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
-closureUpdReqd ConInfo{} = False
 
 lfUpdatable :: LambdaFormInfo -> Bool
 lfUpdatable (LFThunk _ _ upd _ _)  = upd
@@ -808,7 +774,6 @@ lfUpdatable _ = False
 
 closureIsThunk :: ClosureInfo -> Bool
 closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
-closureIsThunk ConInfo{} = False
 
 closureSingleEntry :: ClosureInfo -> Bool
 closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
@@ -818,13 +783,8 @@ closureReEntrant :: ClosureInfo -> Bool
 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
 closureReEntrant _ = False
 
-isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
-isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
-isConstrClosure_maybe _ 				  = Nothing
-
 closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
-closureFunInfo _ = Nothing
 
 lfFunInfo :: LambdaFormInfo ->  Maybe (Int, ArgDescr)
 lfFunInfo (LFReEntrant _ arity _ arg_desc)  = Just (arity, arg_desc)
@@ -832,7 +792,6 @@ lfFunInfo _                                 = Nothing
 
 funTag :: ClosureInfo -> DynTag
 funTag (ClosureInfo { closureLFInfo = lf_info }) = lfDynTag lf_info
-funTag (ConInfo {})				 = panic "funTag"
 
 isToplevClosure :: ClosureInfo -> Bool
 isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
@@ -840,7 +799,6 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
       LFReEntrant TopLevel _ _ _ -> True
       LFThunk TopLevel _ _ _ _   -> True
       _other			 -> False
-isToplevClosure _ = False
 
 --------------------------------------
 --   Label generation
@@ -871,14 +829,6 @@ infoTableLabelFromCI (ClosureInfo { closureName = name,
     std_mk_lbl | is_lcl    = mkLocalInfoTableLabel
                | otherwise = mkInfoTableLabel
 
-infoTableLabelFromCI (ConInfo { closureCon = con,
-                                closureSMRep = rep,
-                                closureCafs = cafs })
-  | isStaticRep rep = mkStaticInfoTableLabel name cafs
-  | otherwise       = mkConInfoTableLabel name cafs
-  where
-    name = dataConName con
-
 -- ClosureInfo for a closure (as opposed to a constructor) is always local
 closureLabelFromCI :: ClosureInfo -> CLabel
 closureLabelFromCI cl@(ClosureInfo { closureName = nm }) =
@@ -984,6 +934,15 @@ mkDataConInfoTable data_con is_static ptr_wds nonptr_wds
    ty_descr  = stringToWord8s $ occNameString $ getOccName $ dataConTyCon data_con
    val_descr = stringToWord8s $ occNameString $ getOccName data_con
 
+-- We need a black-hole closure info to pass to @allocDynClosure@ when we
+-- want to allocate the black hole on entry to a CAF.
+
+cafBlackHoleInfoTable :: CmmInfoTable
+cafBlackHoleInfoTable
+  = CmmInfoTable { cit_lbl  = mkCAFBlackHoleInfoTableLabel
+                 , cit_rep  = blackHoleRep
+                 , cit_prof = NoProfilingInfo
+                 , cit_srt  = NoC_SRT }
 
 staticClosureNeedsLink :: CmmInfoTable -> Bool
 -- A static closure needs a link field to aid the GC when traversing
@@ -996,3 +955,4 @@ staticClosureNeedsLink info_tbl@CmmInfoTable{ cit_rep = smrep }
   | isConRep smrep         = not (isStaticNoCafCon smrep)
   | otherwise              = needsSRT (cit_srt info_tbl)
 staticClosureNeedsLink _ = False
+
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index ee7b0be6f2..dd3c68e26e 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -34,7 +34,6 @@ import Module
 import Constants
 import DataCon
 import FastString
-import IdInfo( CafInfo(..) )
 import Id
 import Literal
 import PrelInfo
@@ -202,8 +201,10 @@ buildDynCon binder ccs con args
   = do	{ let (tot_wds, ptr_wds, args_w_offsets) 
                 = mkVirtConstrOffsets (addArgReps args)
 		-- No void args in args_w_offsets
-              cl_info = mkConInfo False NoCafRefs con tot_wds ptr_wds
-	; (tmp, init) <- allocDynClosure cl_info use_cc blame_cc args_w_offsets
+              nonptr_wds = tot_wds - ptr_wds
+              info_tbl = mkDataConInfoTable con False ptr_wds nonptr_wds
+        ; (tmp, init) <- allocDynClosure info_tbl lf_info
+                                         use_cc blame_cc args_w_offsets
 	; regIdInfo binder lf_info tmp init }
   where
     lf_info = mkConLFInfo con
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index d094337ef5..ec0dd05a8e 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -49,7 +49,8 @@ import Constants
 -----------------------------------------------------------
 
 allocDynClosure
-        :: ClosureInfo
+        :: CmmInfoTable
+        -> LambdaFormInfo
         -> CmmExpr              -- Cost Centre to stick in the object
         -> CmmExpr              -- Cost Centre to blame for this alloc
                                 -- (usually the same; sometimes "OVERHEAD")
@@ -60,7 +61,7 @@ allocDynClosure
         -> FCode (LocalReg, CmmAGraph)
 
 allocDynClosureCmm
-        :: ClosureInfo -> CmmExpr -> CmmExpr
+        :: CmmInfoTable -> LambdaFormInfo -> CmmExpr -> CmmExpr
         -> [(CmmExpr, VirtualHpOffset)]
         -> FCode (LocalReg, CmmAGraph)
 
@@ -81,18 +82,20 @@ allocDynClosureCmm
 --         but Hp+8 means something quite different...
 
 
-allocDynClosure cl_info use_cc _blame_cc args_w_offsets
+allocDynClosure info_tbl lf_info use_cc _blame_cc args_w_offsets
   = do  { let (args, offsets) = unzip args_w_offsets
         ; cmm_args <- mapM getArgAmode args     -- No void args
-        ; allocDynClosureCmm cl_info use_cc _blame_cc (zip cmm_args offsets)
+        ; allocDynClosureCmm info_tbl lf_info
+                             use_cc _blame_cc (zip cmm_args offsets)
         }
 
-allocDynClosureCmm cl_info use_cc _blame_cc amodes_w_offsets
+allocDynClosureCmm info_tbl lf_info use_cc _blame_cc amodes_w_offsets
   = do  { virt_hp <- getVirtHp
 
         -- SAY WHAT WE ARE ABOUT TO DO
-        ; tickyDynAlloc cl_info
-        ; profDynAlloc cl_info use_cc
+        ; let rep = cit_rep info_tbl
+        ; tickyDynAlloc rep lf_info
+        ; profDynAlloc rep use_cc
                 -- ToDo: This is almost certainly wrong
                 -- We're ignoring blame_cc. But until we've
                 -- fixed the boxing hack in chooseDynCostCentres etc,
@@ -106,7 +109,7 @@ allocDynClosureCmm cl_info use_cc _blame_cc amodes_w_offsets
                 -- Remember, virtHp points to last allocated word,
                 -- ie 1 *before* the info-ptr word of new object.
 
-                info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info))
+                info_ptr = CmmLit (CmmLabel (cit_lbl info_tbl))
 
         -- ALLOCATE THE OBJECT
         ; base <- getHpRelOffset info_offset
@@ -116,7 +119,7 @@ allocDynClosureCmm cl_info use_cc _blame_cc amodes_w_offsets
         ; hpStore base cmm_args offsets
 
         -- BUMP THE VIRTUAL HEAP POINTER
-        ; setVirtHp (virt_hp + closureSize cl_info)
+        ; setVirtHp (virt_hp + heapClosureSize rep)
 
         -- Assign to a temporary and return
         -- Note [Return a LocalReg]
diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs
index ca116f2218..b1aca6e37e 100644
--- a/compiler/codeGen/StgCmmProf.hs
+++ b/compiler/codeGen/StgCmmProf.hs
@@ -156,10 +156,10 @@ restoreCurrentCostCentre (Just local_cc)
 
 -- | Record the allocation of a closure.  The CmmExpr is the cost
 -- centre stack to which to attribute the allocation.
-profDynAlloc :: ClosureInfo -> CmmExpr -> FCode ()
-profDynAlloc cl_info ccs
+profDynAlloc :: SMRep -> CmmExpr -> FCode ()
+profDynAlloc rep ccs
   = ifProfiling $
-    profAlloc (CmmLit (mkIntCLit (closureSize cl_info))) ccs
+    profAlloc (CmmLit (mkIntCLit (heapClosureSize rep))) ccs
 
 -- | Record the allocation of a closure (size is given by a CmmExpr)
 -- The size must be in words, because the allocation counter in a CCS counts
diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs
index 3775130aaf..2da539b1e9 100644
--- a/compiler/codeGen/StgCmmTicky.hs
+++ b/compiler/codeGen/StgCmmTicky.hs
@@ -51,6 +51,7 @@ import CmmExpr
 import MkGraph
 import CmmUtils
 import CLabel
+import SMRep
 
 import Module
 import Name
@@ -266,25 +267,24 @@ argChar DoubleArg = 'd'
 -- -----------------------------------------------------------------------------
 -- Ticky allocation
 
-tickyDynAlloc :: ClosureInfo -> FCode ()
+tickyDynAlloc :: SMRep -> LambdaFormInfo -> FCode ()
 -- Called when doing a dynamic heap allocation
-tickyDynAlloc cl_info
+-- LambdaFormInfo only needed to distinguish between updatable/non-updatable thunks
+tickyDynAlloc rep lf
   = ifTicky $
     case () of
-      _ | Just _ <- maybeIsLFCon lf -> tick_alloc_con
-	| isLFThunk lf              -> tick_alloc_thk
-        | isLFReEntrant lf          -> tick_alloc_fun
-        | otherwise                 -> return ()
+      _ | isConRep rep   -> tick_alloc_con
+        | isThunkRep rep -> tick_alloc_thk
+        | isFunRep   rep -> tick_alloc_fun
+        | otherwise      -> return ()
   where
-    lf = closureLFInfo cl_info
-
-	-- will be needed when we fill in stubs
-    _cl_size   = closureSize cl_info
+        -- will be needed when we fill in stubs
+    _cl_size   = heapClosureSize rep
 --    _slop_size = slopSize cl_info
 
     tick_alloc_thk 
-	| closureUpdReqd cl_info = tick_alloc_up_thk
-	| otherwise	         = tick_alloc_se_thk
+        | lfUpdatable lf = tick_alloc_up_thk
+        | otherwise      = tick_alloc_se_thk
 
     -- krc: changed from panic to return () 
     -- just to get something working