Remove CONSTR_STATIC

Summary:
We currently have two info tables for a constructor

* XXX_con_info: the info table for a heap-resident instance of the
  constructor, It has type CONSTR, or one of the specialised types like
  CONSTR_1_0

* XXX_static_info: the info table for a static instance of this
  constructor, which has type CONSTR_STATIC or CONSTR_STATIC_NOCAF.

I'm getting rid of the latter, and using the `con_info` info table for
both static and dynamic constructors.  For rationale and more details
see Note [static constructors] in SMRep.hs.

I also removed these macros: `isSTATIC()`, `ip_STATIC()`,
`closure_STATIC()`, since they relied on the CONSTR/CONSTR_STATIC
distinction, and anyway HEAP_ALLOCED() does the same job.

Test Plan: validate

Reviewers: bgamari, simonpj, austin, gcampax, hvr, niteria, erikd

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2690

GHC Trac Issues: #12455

5 files changed, 65 insertions, 76 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index b262371b65..0b64e3e1ff 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -20,10 +20,8 @@ module CLabel (
         mkEntryLabel,
         mkSlowEntryLabel,
         mkConEntryLabel,
-        mkStaticConEntryLabel,
         mkRednCountsLabel,
         mkConInfoTableLabel,
-        mkStaticInfoTableLabel,
         mkLargeSRTLabel,
         mkApEntryLabel,
         mkApInfoTableLabel,
@@ -33,9 +31,7 @@ module CLabel (
         mkLocalInfoTableLabel,
         mkLocalEntryLabel,
         mkLocalConEntryLabel,
-        mkLocalStaticConEntryLabel,
         mkLocalConInfoTableLabel,
-        mkLocalStaticInfoTableLabel,
         mkLocalClosureTableLabel,
 
         mkReturnPtLabel,
@@ -390,8 +386,6 @@ data IdLabelInfo
 
   | ConEntry            -- ^ Constructor entry point
   | ConInfoTable        -- ^ Corresponding info table
-  | StaticConEntry      -- ^ Static constructor entry point
-  | StaticInfoTable     -- ^ Corresponding info table
 
   | ClosureTable        -- ^ Table of closures for Enum tycons
 
@@ -479,25 +473,17 @@ mkEntryLabel                :: Name -> CafInfo -> CLabel
 mkClosureTableLabel         :: Name -> CafInfo -> CLabel
 mkLocalConInfoTableLabel    :: CafInfo -> Name -> CLabel
 mkLocalConEntryLabel        :: CafInfo -> Name -> CLabel
-mkLocalStaticInfoTableLabel :: CafInfo -> Name -> CLabel
-mkLocalStaticConEntryLabel  :: CafInfo -> Name -> CLabel
 mkConInfoTableLabel         :: Name -> CafInfo -> CLabel
-mkStaticInfoTableLabel      :: Name -> CafInfo -> CLabel
 mkClosureLabel name         c     = IdLabel name c Closure
 mkInfoTableLabel name       c     = IdLabel name c InfoTable
 mkEntryLabel name           c     = IdLabel name c Entry
 mkClosureTableLabel name    c     = IdLabel name c ClosureTable
 mkLocalConInfoTableLabel    c con = IdLabel con c ConInfoTable
 mkLocalConEntryLabel        c con = IdLabel con c ConEntry
-mkLocalStaticInfoTableLabel c con = IdLabel con c StaticInfoTable
-mkLocalStaticConEntryLabel  c con = IdLabel con c StaticConEntry
 mkConInfoTableLabel name    c     = IdLabel name c ConInfoTable
-mkStaticInfoTableLabel name c     = IdLabel name c StaticInfoTable
 
 mkConEntryLabel       :: Name -> CafInfo -> CLabel
-mkStaticConEntryLabel :: Name -> CafInfo -> CLabel
 mkConEntryLabel name        c     = IdLabel name c ConEntry
-mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
 
 -- Constructing Cmm Labels
 mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
@@ -677,7 +663,6 @@ toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
 toEntryLbl :: CLabel -> CLabel
 toEntryLbl (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
 toEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
-toEntryLbl (IdLabel n c StaticInfoTable) = IdLabel n c StaticConEntry
 toEntryLbl (IdLabel n c _)               = IdLabel n c Entry
 toEntryLbl (CaseLabel n CaseReturnInfo)  = CaseLabel n CaseReturnPt
 toEntryLbl (CmmLabel m str CmmInfo)      = CmmLabel m str CmmEntry
@@ -688,7 +673,6 @@ toInfoLbl :: CLabel -> CLabel
 toInfoLbl (IdLabel n c Entry)          = IdLabel n c InfoTable
 toInfoLbl (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
 toInfoLbl (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
-toInfoLbl (IdLabel n c StaticConEntry) = IdLabel n c StaticInfoTable
 toInfoLbl (IdLabel n c _)              = IdLabel n c InfoTable
 toInfoLbl (CaseLabel n CaseReturnPt)   = CaseLabel n CaseReturnInfo
 toInfoLbl (CmmLabel m str CmmEntry)    = CmmLabel m str CmmInfo
@@ -944,7 +928,6 @@ idInfoLabelType info =
     LocalInfoTable -> DataLabel
     Closure       -> GcPtrLabel
     ConInfoTable  -> DataLabel
-    StaticInfoTable -> DataLabel
     ClosureTable  -> DataLabel
     RednCounts    -> DataLabel
     _             -> CodeLabel
@@ -1239,8 +1222,6 @@ ppIdFlavor x = pp_cSEP <>
                        RednCounts       -> text "ct"
                        ConEntry         -> text "con_entry"
                        ConInfoTable     -> text "con_info"
-                       StaticConEntry   -> text "static_entry"
-                       StaticInfoTable  -> text "static_info"
                        ClosureTable     -> text "closure_tbl"
                       )
 
diff --git a/compiler/cmm/SMRep.hs b/compiler/cmm/SMRep.hs
index ecd8905cbb..83ddf18586 100644
--- a/compiler/cmm/SMRep.hs
+++ b/compiler/cmm/SMRep.hs
@@ -177,6 +177,7 @@ data SMRep
 
 -- | True <=> This is a static closure.  Affects how we garbage-collect it.
 -- Static closure have an extra static link field at the end.
+-- Constructors do not have a static variant; see Note [static constructors]
 type IsStatic = Bool
 
 -- From an SMRep you can get to the closure type defined in
@@ -287,10 +288,10 @@ isFunRep (HeapRep _ _ _ Fun{}) = True
 isFunRep _                     = False
 
 isStaticNoCafCon :: SMRep -> Bool
--- This should line up exactly with CONSTR_NOCAF_STATIC above
+-- This should line up exactly with CONSTR_NOCAF below
 -- See Note [Static NoCaf constructors]
-isStaticNoCafCon (HeapRep True 0 _ Constr{}) = True
-isStaticNoCafCon _                           = False
+isStaticNoCafCon (HeapRep _ 0 _ Constr{}) = True
+isStaticNoCafCon _                        = False
 
 
 -----------------------------------------------------------------------------
@@ -428,12 +429,15 @@ rtsClosureType rep
     = case rep of
       RTSRep ty _ -> ty
 
-      HeapRep False 1 0 Constr{} -> CONSTR_1_0
-      HeapRep False 0 1 Constr{} -> CONSTR_0_1
-      HeapRep False 2 0 Constr{} -> CONSTR_2_0
-      HeapRep False 1 1 Constr{} -> CONSTR_1_1
-      HeapRep False 0 2 Constr{} -> CONSTR_0_2
-      HeapRep False _ _ Constr{} -> CONSTR
+      -- See Note [static constructors]
+      HeapRep _     1 0 Constr{} -> CONSTR_1_0
+      HeapRep _     0 1 Constr{} -> CONSTR_0_1
+      HeapRep _     2 0 Constr{} -> CONSTR_2_0
+      HeapRep _     1 1 Constr{} -> CONSTR_1_1
+      HeapRep _     0 2 Constr{} -> CONSTR_0_2
+      HeapRep _     0 _ Constr{} -> CONSTR_NOCAF
+           -- See Note [Static NoCaf constructors]
+      HeapRep _     _ _ Constr{} -> CONSTR
 
       HeapRep False 1 0 Fun{} -> FUN_1_0
       HeapRep False 0 1 Fun{} -> FUN_0_1
@@ -451,10 +455,6 @@ rtsClosureType rep
 
       HeapRep False _ _ ThunkSelector{} ->  THUNK_SELECTOR
 
-      -- Approximation: we use the CONSTR_NOCAF_STATIC type for static
-      -- constructors -- that have no pointer words only.
-      HeapRep True 0 _ Constr{} -> CONSTR_NOCAF_STATIC  -- See isStaticNoCafCon below
-      HeapRep True _ _ Constr{} -> CONSTR_STATIC
       HeapRep True _ _ Fun{}    -> FUN_STATIC
       HeapRep True _ _ Thunk{}  -> THUNK_STATIC
 
@@ -472,6 +472,34 @@ aRG_GEN     = ARG_GEN
 aRG_GEN_BIG = ARG_GEN_BIG
 
 {-
+Note [static constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+We used to have a CONSTR_STATIC closure type, and each constructor had
+two info tables: one with CONSTR (or CONSTR_1_0 etc.), and one with
+CONSTR_STATIC.
+
+This distinction was removed, because when copying a data structure
+into a compact region, we must copy static constructors into the
+compact region too.  If we didn't do this, we would need to track the
+references from the compact region out to the static constructors,
+because they might (indirectly) refer to CAFs.
+
+Since static constructors will be copied to the heap, if we wanted to
+use different info tables for static and dynamic constructors, we
+would have to switch the info pointer when copying the constructor
+into the compact region, which means we would need an extra field of
+the static info table to point to the dynamic one.
+
+However, since the distinction between static and dynamic closure
+types is never actually needed (other than for assertions), we can
+just drop the distinction and use the same info table for both.
+
+The GC *does* need to distinguish between static and dynamic closures,
+but it does this using the HEAP_ALLOCED() macro which checks whether
+the address of the closure resides within the dynamic heap.
+HEAP_ALLOCED() doesn't read the closure's info table.
+
 Note [Static NoCaf constructors]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If we know that a top-level binding 'x' is not Caffy (ie no CAFs are
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index 28ca97d9a2..aac556d43f 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -226,41 +226,31 @@ cgDataCon data_con
 
             nonptr_wds   = tot_wds - ptr_wds
 
-            sta_info_tbl = mkDataConInfoTable dflags data_con True  ptr_wds nonptr_wds
-            dyn_info_tbl = mkDataConInfoTable dflags data_con False ptr_wds nonptr_wds
-
-            emit_info info_tbl ticky_code
-                = emitClosureAndInfoTable info_tbl NativeDirectCall []
-                             $ mk_code ticky_code
-
-            mk_code ticky_code
-              = -- NB: the closure pointer is assumed *untagged* on
-                -- entry to a constructor.  If the pointer is tagged,
-                -- then we should not be entering it.  This assumption
-                -- is used in ldvEnter and when tagging the pointer to
-                -- return it.
-                -- NB 2: We don't set CC when entering data (WDP 94/06)
-                do { _ <- ticky_code
-                   ; ldvEnter (CmmReg nodeReg)
-                   ; tickyReturnOldCon (length arg_reps)
-                   ; void $ emitReturn [cmmOffsetB dflags (CmmReg nodeReg) (tagForCon dflags data_con)]
-                   }
-                        -- The case continuation code expects a tagged pointer
+            dyn_info_tbl =
+              mkDataConInfoTable dflags data_con False ptr_wds nonptr_wds
 
             -- We're generating info tables, so we don't know and care about
             -- what the actual arguments are. Using () here as the place holder.
             arg_reps :: [NonVoid PrimRep]
-            arg_reps = [NonVoid (typePrimRep rep_ty) | ty <- dataConRepArgTys data_con
-                                                     , rep_ty <- repTypeArgs ty
-                                                     , not (isVoidTy rep_ty)]
-
-            -- Dynamic closure code for non-nullary constructors only
-        ; when (not (isNullaryRepDataCon data_con))
-                (emit_info dyn_info_tbl tickyEnterDynCon)
-
-                -- Dynamic-Closure first, to reduce forward references
-        ; emit_info sta_info_tbl tickyEnterStaticCon }
-
+            arg_reps = [ NonVoid (typePrimRep rep_ty)
+                       | ty <- dataConRepArgTys data_con
+                       , rep_ty <- repTypeArgs ty
+                       , not (isVoidTy rep_ty)]
+
+        ; emitClosureAndInfoTable dyn_info_tbl NativeDirectCall [] $
+            -- NB: the closure pointer is assumed *untagged* on
+            -- entry to a constructor.  If the pointer is tagged,
+            -- then we should not be entering it.  This assumption
+            -- is used in ldvEnter and when tagging the pointer to
+            -- return it.
+            -- NB 2: We don't set CC when entering data (WDP 94/06)
+            do { tickyEnterDynCon
+               ; ldvEnter (CmmReg nodeReg)
+               ; tickyReturnOldCon (length arg_reps)
+               ; void $ emitReturn [cmmOffsetB dflags (CmmReg nodeReg) (tagForCon dflags data_con)]
+               }
+                    -- The case continuation code expects a tagged pointer
+        }
 
 ---------------------------------------------------------------
 --      Stuff to support splitting
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 23b803cc56..0ce119b0bb 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -1040,12 +1040,8 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
                 , cit_srt  = NoC_SRT }
  where
    name = dataConName data_con
-
-   info_lbl | is_static = mkStaticInfoTableLabel name NoCafRefs
-            | otherwise = mkConInfoTableLabel    name NoCafRefs
-
+   info_lbl = mkConInfoTableLabel name NoCafRefs
    sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type
-
    cl_type = Constr (dataConTagZ data_con) (dataConIdentity data_con)
 
    prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
@@ -1074,16 +1070,10 @@ indStaticInfoTable
 staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool
 -- A static closure needs a link field to aid the GC when traversing
 -- the static closure graph.  But it only needs such a field if either
---         a) it has an SRT
+--        a) it has an SRT
 --        b) it's a constructor with one or more pointer fields
 -- In case (b), the constructor's fields themselves play the role
 -- of the SRT.
---
--- At this point, the cit_srt field has not been calculated (that
--- happens right at the end of the Cmm pipeline), but we do have the
--- VarSet of CAFs that CoreToStg attached, and if that is empty there
--- will definitely not be an SRT.
---
 staticClosureNeedsLink has_srt CmmInfoTable{ cit_rep = smrep }
   | isConRep smrep         = not (isStaticNoCafCon smrep)
   | otherwise              = has_srt -- needsSRT (cit_srt info_tbl)
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index eff266090e..815e5e6e0f 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -191,7 +191,7 @@ getClosureData dflags a =
 
 readCType :: Integral a => a -> ClosureType
 readCType i
- | i >= CONSTR && i <= CONSTR_NOCAF_STATIC = Constr
+ | i >= CONSTR && i <= CONSTR_NOCAF        = Constr
  | i >= FUN    && i <= FUN_STATIC          = Fun
  | i >= THUNK  && i < THUNK_SELECTOR       = Thunk i'
  | i == THUNK_SELECTOR                     = ThunkSelector