[Git][ghc/ghc][wip/romes/isNullaryRepDataCon] Revert some things
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Wed Apr 26 15:43:59 UTC 2023
Rodrigo Mesquita pushed to branch wip/romes/isNullaryRepDataCon at Glasgow Haskell Compiler / GHC
Commits:
036a6bc5 by Rodrigo Mesquita at 2023-04-25T18:00:45+01:00
Revert some things
- - - - -
3 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/StgToCmm/DataCon.hs
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -30,7 +30,6 @@ module GHC.Cmm.CLabel (
mkApEntryLabel,
mkApInfoTableLabel,
mkClosureTableLabel,
- mkShortConAppLabel,
mkBytesLabel,
mkLocalBlockLabel,
@@ -522,8 +521,6 @@ data IdLabelInfo
| ClosureTable -- ^ Table of closures for Enum tycons
- | ShortConApp -- ^ Temporary name, temporary documentation. A special static closure for nullarydatacons
-
| Bytes -- ^ Content of a string literal. See
-- Note [Bytes label].
| BlockInfoTable -- ^ Like LocalInfoTable but for a proc-point block
@@ -557,7 +554,6 @@ instance Outputable IdLabelInfo where
ppr (ConEntry mn) = text "ConEntry" <+> ppr mn
ppr (ConInfoTable mn) = text "ConInfoTable" <+> ppr mn
ppr ClosureTable = text "ClosureTable"
- ppr ShortConApp = text "ShortConApp" -- ROMES:TODO: name
ppr Bytes = text "Bytes"
ppr BlockInfoTable = text "BlockInfoTable"
ppr (IdTickyInfo info) = text "IdTickyInfo" <+> ppr info
@@ -623,7 +619,6 @@ mkClosureLabel :: Name -> CafInfo -> CLabel
mkInfoTableLabel :: Name -> CafInfo -> CLabel
mkEntryLabel :: Name -> CafInfo -> CLabel
mkClosureTableLabel :: Name -> CafInfo -> CLabel
-mkShortConAppLabel :: Name -> CafInfo -> CLabel
mkConInfoTableLabel :: Name -> ConInfoTableLocation -> CLabel
mkBytesLabel :: Name -> CLabel
mkClosureLabel name c = IdLabel name c Closure
@@ -633,7 +628,6 @@ mkInfoTableLabel name c
| otherwise = IdLabel name c LocalInfoTable
mkEntryLabel name c = IdLabel name c Entry
mkClosureTableLabel name c = IdLabel name c ClosureTable
-mkShortConAppLabel name c = IdLabel name c ShortConApp
-- Special case for the normal 'DefinitionSite' case so that the 'ConInfoTable' application can be floated to a CAF.
mkConInfoTableLabel name DefinitionSite = IdLabel name NoCafRefs (ConInfoTable DefinitionSite)
mkConInfoTableLabel name k = IdLabel name NoCafRefs (ConInfoTable k)
@@ -786,7 +780,6 @@ isForeignLabel _lbl = False
isStaticClosureLabel :: CLabel -> Bool
-- Closure defined in haskell (.hs)
isStaticClosureLabel (IdLabel _ _ Closure) = True
-isStaticClosureLabel (IdLabel _ _ ShortConApp) = True
-- Closure defined in cmm
isStaticClosureLabel (CmmLabel _ _ _ CmmClosure) = True
isStaticClosureLabel _lbl = False
@@ -1258,7 +1251,6 @@ idInfoLabelType info =
ConInfoTable {} -> DataLabel
ClosureTable -> DataLabel
IdTickyInfo{} -> DataLabel
- ShortConApp -> DataLabel
Bytes -> DataLabel
_ -> CodeLabel
@@ -1663,7 +1655,6 @@ ppIdFlavor x = pp_cSEP <> case x of
UsageSite m n ->
pprModule m <> pp_cSEP <> int n <> pp_cSEP <> text "con_info"
ClosureTable -> text "closure_tbl"
- ShortConApp -> text "special_con_app" -- ROMES:TODO: Name
Bytes -> text "bytes"
BlockInfoTable -> text "info"
=====================================
compiler/GHC/StgToCmm.hs
=====================================
@@ -233,7 +233,6 @@ mkModuleInit cost_centre_info this_mod hpc_info
cgEnumerationTyCon :: TyCon -> FCode ()
cgEnumerationTyCon tycon
= do platform <- getPlatform
- -- ROMES:TODO: Kind of code I need to emit conapp declarations for nullary gadt
emitRODataLits (mkClosureTableLabel (tyConName tycon) NoCafRefs)
[ CmmLabelOff (mkClosureLabel (dataConName con) NoCafRefs)
(tagForCon platform con)
@@ -265,12 +264,6 @@ cgDataCon mn data_con
, rep_ty <- typePrimRep (scaledThing ty)
, not (isVoidRep rep_ty) ]
- -- In the case of a data con that isn't nullary in its core
- -- representation, but that has no zero-width args, we generate a
- -- special static closure alongside its normal _closure
- -- ROMES:TODO: Write a long note about it
- ; when (not (isNullaryRepDataCon data_con) && hasNoNonZeroWidthArgs data_con) (cgNullaryDataConApp data_con)
-
; emitClosureAndInfoTable platform dyn_info_tbl NativeDirectCall [] $
-- NB: the closure pointer is assumed *untagged* on
-- entry to a constructor. If the pointer is tagged,
=====================================
compiler/GHC/StgToCmm/DataCon.hs
=====================================
@@ -12,8 +12,7 @@
-----------------------------------------------------------------------------
module GHC.StgToCmm.DataCon (
- cgTopRhsCon, buildDynCon, bindConArgs,
- cgNullaryDataConApp
+ cgTopRhsCon, buildDynCon, bindConArgs
) where
import GHC.Prelude
@@ -382,14 +381,6 @@ precomputedStaticConInfo_maybe cfg binder con [arg]
precomputedStaticConInfo_maybe _ _ _ _ = Nothing
--- Closely related to precomputed static things,,, write long note: ROMES:TODO
-cgNullaryDataConApp :: DataCon -> FCode ()
-cgNullaryDataConApp con
- = emitRODataLits (mkShortConAppLabel (dataConName con) NoCafRefs)
- [ CmmLabel (mkConInfoTableLabel (dataConName con) DefinitionSite)
- ]
-
-
---------------------------------------------------------------
-- Binding constructor arguments
---------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/036a6bc577e2655b3efac5ec14f3b6bf527d70fa
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/036a6bc577e2655b3efac5ec14f3b6bf527d70fa
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230426/a7b4c129/attachment-0001.html>
More information about the ghc-commits
mailing list