[Git][ghc/ghc][wip/decode_cloned_stack] Simplify show instances

[Sven Tennie (@supersven)]

Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC


Commits:
4584b6c5 by Sven Tennie at 2023-02-10T18:19:42+00:00
Simplify show instances

- - - - -


3 changed files:

- libraries/base/GHC/Stack/CloneStack.hs
- libraries/base/cbits/StackCloningDecoding.cmm
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs


Changes:

=====================================
libraries/base/GHC/Stack/CloneStack.hs
=====================================
@@ -20,14 +20,14 @@ module GHC.Stack.CloneStack (
   cloneMyStack,
   cloneThreadStack,
   decode,
-  stackSnapshotToWord
+  stackSnapshotToString
   ) where
 
 import Control.Concurrent.MVar
 import Data.Maybe (catMaybes)
 import Foreign
 import GHC.Conc.Sync
-import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#, Word#)
+import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#, Word#, unsafeCoerce#)
 import GHC.IO (IO (..))
 import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv)
 import GHC.Stable
@@ -41,14 +41,14 @@ data StackSnapshot = StackSnapshot !StackSnapshot#
 
 instance Show StackSnapshot where
    showsPrec _ stack rs =
-    "StackSnapshot(" ++ pad_out (showHex addr "") ++ ")" ++ rs
+    "StackSnapshot(" ++  stackSnapshotToString stack ++ ")" ++ rs
+
+stackSnapshotToString :: StackSnapshot -> String
+stackSnapshotToString (StackSnapshot s#) = pad_out (showHex addr "")
      where
-        addr = stackSnapshotToWord stack
+        addr = W# (unsafeCoerce# s#)
         pad_out ls = '0':'x':ls
 
-stackSnapshotToWord :: StackSnapshot -> Word
-stackSnapshotToWord (StackSnapshot s#) = W# (stackSnapshotToWord# s#)
-
 instance Eq StackSnapshot where
   (StackSnapshot s1#) == (StackSnapshot s2#) = (W# (eqStacks# s1# s2#)) > 0
 
@@ -58,8 +58,6 @@ foreign import prim "stg_cloneMyStackzh" cloneMyStack# :: State# RealWorld -> (#
 
 foreign import prim "stg_sendCloneStackMessagezh" sendCloneStackMessage# :: ThreadId# -> StablePtr# PrimMVar -> State# RealWorld -> (# State# RealWorld, (# #) #)
 
-foreign import prim "stackSnapshotToWordzh" stackSnapshotToWord# :: StackSnapshot# -> Word#
-
 foreign import prim "eqStackszh" eqStacks# :: StackSnapshot# -> StackSnapshot# -> Word#
 
 {-


=====================================
libraries/base/cbits/StackCloningDecoding.cmm
=====================================
@@ -25,11 +25,6 @@ stg_decodeStackzh (gcptr stgStack) {
     return (stackEntries);
 }
 
-// Just a cast
-stackSnapshotToWordzh(P_ stack) {
-  return (stack);
-}
-
 eqStackszh(P_ stack1, P_ stack2) {
   return (stack1 == stack2);
 }


=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -54,7 +54,7 @@ import GHC.Generics
 import Numeric
 
 #if MIN_TOOL_VERSION_ghc(9,5,0)
-import GHC.Stack.CloneStack (StackSnapshot(..), stackSnapshotToWord)
+import GHC.Stack.CloneStack (StackSnapshot(..), stackSnapshotToString)
 import GHC.Exts.StackConstants
 #endif
 
@@ -84,7 +84,8 @@ data StackFrameIter =
     }
 
 instance Eq StackFrameIter where
-  (SfiStackClosure s1#) == (SfiStackClosure s2#) = (StackSnapshot s1#) == (StackSnapshot s2#)
+  (SfiStackClosure s1#) == (SfiStackClosure s2#) =
+    (StackSnapshot s1#) == (StackSnapshot s2#)
   (SfiClosure s1# i1) == (SfiClosure s2# i2) =
     (StackSnapshot s1#) == (StackSnapshot s2#)
     && i1 == i2
@@ -93,23 +94,13 @@ instance Eq StackFrameIter where
     && i1 == i2
   _ == _ = False
 
--- TODO: Reduce duplication in where clause
 instance Show StackFrameIter where
    showsPrec _ (SfiStackClosure s#) rs =
-    "SfiStackClosure { stackSnapshot# = " ++ pad_out (showHex addr "") ++ "}" ++ rs
-     where
-        addr = stackSnapshotToWord (StackSnapshot s#)
-        pad_out ls = '0':'x':ls
+    "SfiStackClosure { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ "}" ++ rs
    showsPrec _ (SfiClosure s# i ) rs =
-    "SfiClosure { stackSnapshot# = " ++ pad_out (showHex addr "") ++ ", index = " ++ show i ++ ", " ++ "}" ++ rs
-     where
-        addr = stackSnapshotToWord (StackSnapshot s#)
-        pad_out ls = '0':'x':ls
+    "SfiClosure { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ show i ++ ", " ++ "}" ++ rs
    showsPrec _ (SfiPrimitive s# i ) rs =
-    "SfiPrimitive { stackSnapshot# = " ++ pad_out (showHex addr "") ++ ", index = " ++ show i ++ ", " ++ "}" ++ rs
-     where
-        addr = stackSnapshotToWord (StackSnapshot s#)
-        pad_out ls = '0':'x':ls
+    "SfiPrimitive { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ show i ++ ", " ++ "}" ++ rs
 
 -- | An arbitrary Haskell value in a safe Box.
 --



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4584b6c505ded3cbd6e0544f5f91f0114fc1e1ec
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/20230210/61c68cfe/attachment-0001.html>