[Git][ghc/ghc][wip/ticky-datacon-name] Ticky-ticky: Record DataCon name in ticker name

[Ben Gamari]

Ben Gamari pushed to branch wip/ticky-datacon-name at Glasgow Haskell Compiler / GHC


Commits:
c2cbb6dd by Ben Gamari at 2020-05-24T00:23:29-04:00
Ticky-ticky: Record DataCon name in ticker name

- - - - -


2 changed files:

- compiler/GHC/StgToCmm/Bind.hs
- compiler/GHC/StgToCmm/Ticky.hs


Changes:

=====================================
compiler/GHC/StgToCmm/Bind.hs
=====================================
@@ -201,7 +201,7 @@ cgRhs :: Id
                )
 
 cgRhs id (StgRhsCon cc con args)
-  = withNewTickyCounterCon (idName id) $
+  = withNewTickyCounterCon (idName id) con $
     buildDynCon id True cc con (assertNonVoidStgArgs args)
       -- con args are always non-void,
       -- see Note [Post-unarisation invariants] in GHC.Stg.Unarise


=====================================
compiler/GHC/StgToCmm/Ticky.hs
=====================================
@@ -128,6 +128,7 @@ import GHC.Driver.Session
 -- Turgid imports for showTypeCategory
 import GHC.Builtin.Names
 import GHC.Tc.Utils.TcType
+import GHC.Core.DataCon
 import GHC.Core.TyCon
 import GHC.Core.Predicate
 
@@ -145,6 +146,7 @@ data TickyClosureType
     = TickyFun
         Bool -- True <-> single entry
     | TickyCon
+        DataCon -- the allocated constructor
     | TickyThunk
         Bool -- True <-> updateable
         Bool -- True <-> standard thunk (AP or selector), has no entry counter
@@ -188,13 +190,14 @@ withNewTickyCounterStdThunk isUpdatable name code = do
 
 withNewTickyCounterCon
   :: Name
+  -> DataCon
   -> FCode a
   -> FCode a
-withNewTickyCounterCon name code = do
+withNewTickyCounterCon name datacon code = do
     has_ctr <- thunkHasCounter False
     if not has_ctr
       then code
-      else withNewTickyCounter TickyCon name [] code
+      else withNewTickyCounter (TickyCon datacon) name [] code
 
 -- args does not include the void arguments
 withNewTickyCounter :: TickyClosureType -> Name -> [NonVoid Id] -> FCode a -> FCode a
@@ -222,7 +225,7 @@ emitTickyCounter cloType name args
                     ext = case cloType of
                               TickyFun single_entry -> parens $ hcat $ punctuate comma $
                                   [text "fun"] ++ [text "se"|single_entry]
-                              TickyCon -> parens (text "con")
+                              TickyCon datacon -> parens (text "con:" <+> ppr (dataConName datacon))
                               TickyThunk upd std -> parens $ hcat $ punctuate comma $
                                   [text "thk"] ++ [text "se"|not upd] ++ [text "std"|std]
                               TickyLNE | isInternalName name -> parens (text "LNE")



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2cbb6ddc5f6082ad6779883aa9c21fbcb0e9a6c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c2cbb6ddc5f6082ad6779883aa9c21fbcb0e9a6c
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/20200524/2d7043bc/attachment-0001.html>