From e8034d15f04539ec16e827bd10c6d9b111566592 Mon Sep 17 00:00:00 2001
From: Teo Camarasu <teofilcamarasu@gmail.com>
Date: Sun, 8 Jan 2023 12:58:32 +0000
Subject: [PATCH] Move ClosureType type to ghc-internal
- Use ClosureType for InfoProv.ipDesc.
- Use ClosureType for CloneStack.closureType.
- Now ghc-heap re-exports this type from ghc-internal.
See the accompanying CLC proposal: https://github.com/haskell/core-libraries-committee/issues/210
Resolves #22600
---
libraries/base/changelog.md | 2 +
.../ghc-heap/GHC/Exts/Heap/ClosureTypes.hs | 4 +
libraries/ghc-heap/ghc-heap.cabal.in | 3 +
libraries/ghc-internal/ghc-internal.cabal | 1 +
.../src/GHC/Internal/ClosureTypes.hs | 87 +++++++++++++++++++
.../src/GHC/Internal/InfoProv.hsc | 11 ++-
.../src/GHC/Internal/Stack/CloneStack.hs | 8 +-
rts/include/rts/storage/ClosureTypes.h | 1 +
.../interface-stability/base-exports.stdout | 4 +-
...se-exports.stdout-javascript-unknown-ghcjs | 4 +-
.../base-exports.stdout-mingw32 | 4 +-
.../base-exports.stdout-ws-32 | 4 +-
.../should_run/staticcallstack001.stdout | 6 +-
.../should_run/staticcallstack002.stdout | 8 +-
testsuite/tests/rts/decodeMyStack.stdout | 24 ++---
.../rts/decodeMyStack_underflowFrames.hs | 17 ++--
testsuite/tests/rts/ipe/T24005/t24005.stdout | 4 +-
17 files changed, 148 insertions(+), 44 deletions(-)
create mode 100644 libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index 1040de7b1c1..4ba1469c867 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -21,6 +21,8 @@
* Add `System.Mem.performMajorGC` ([CLC proposal #230](https://github.com/haskell/core-libraries-committee/issues/230))
* Fix exponent overflow/underflow bugs in the `Read` instances for `Float` and `Double` ([CLC proposal #192](https://github.com/haskell/core-libraries-committee/issues/192))
* Implement `many` and `some` methods of `instance Alternative (Compose f g)` explicitly. ([CLC proposal #181](https://github.com/haskell/core-libraries-committee/issues/181))
+ * Change the types of the `GHC.Stack.StackEntry.closureType` and `GHC.InfoProv.InfoProv.ipDesc` record fields to use `GHC.Exts.Heap.ClosureType` rather than an `Int`.
+ To recover the old value use `fromEnum`. ([CLC proposal #210](https://github.com/haskell/core-libraries-committee/issues/210))
* The functions `GHC.Exts.dataToTag#` and `GHC.Base.getTag` have had
their types changed to the following:
diff --git a/libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs b/libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
index 70da80d66ba..fe564c4f48d 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
+++ b/libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
@@ -7,6 +7,9 @@ module GHC.Exts.Heap.ClosureTypes
) where
import Prelude -- See note [Why do we import Prelude here?]
+#if __GLASGOW_HASKELL__ >= 909
+import GHC.Internal.ClosureTypes
+#else
import GHC.Generics
{- ---------------------------------------------
@@ -83,6 +86,7 @@ data ClosureType
| CONTINUATION
| N_CLOSURE_TYPES
deriving (Enum, Eq, Ord, Show, Generic)
+#endif
-- | Return the size of the closures header in words
closureTypeHeaderSize :: ClosureType -> Int
diff --git a/libraries/ghc-heap/ghc-heap.cabal.in b/libraries/ghc-heap/ghc-heap.cabal.in
index e886bd5aa50..ed08ad05567 100644
--- a/libraries/ghc-heap/ghc-heap.cabal.in
+++ b/libraries/ghc-heap/ghc-heap.cabal.in
@@ -27,6 +27,9 @@ library
, rts == 1.0.*
, containers >= 0.6.2.1 && < 0.8
+ if impl(ghc >= 9.9)
+ build-depends: ghc-internal >= 0.1 && < 0.2
+
ghc-options: -Wall
if !os(ghcjs)
cmm-sources: cbits/HeapPrim.cmm
diff --git a/libraries/ghc-internal/ghc-internal.cabal b/libraries/ghc-internal/ghc-internal.cabal
index b342261c362..796ed9c72d0 100644
--- a/libraries/ghc-internal/ghc-internal.cabal
+++ b/libraries/ghc-internal/ghc-internal.cabal
@@ -91,6 +91,7 @@ Library
ghc-bignum >= 1.0 && < 2.0
exposed-modules:
+ GHC.Internal.ClosureTypes
GHC.Internal.Control.Arrow
GHC.Internal.Control.Category
GHC.Internal.Control.Concurrent.MVar
diff --git a/libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs b/libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
new file mode 100644
index 00000000000..3415d787fe7
--- /dev/null
+++ b/libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# OPTIONS_HADDOCK not-home #-}
+
+module GHC.Internal.ClosureTypes
+ ( ClosureType(..)
+ ) where
+
+import GHC.Internal.Data.Eq
+import GHC.Internal.Data.Ord
+import GHC.Internal.Enum
+import GHC.Internal.Generics
+import GHC.Internal.Show
+
+-- | Enum representing closure types
+-- This is a mirror of:
+-- @rts/include/rts/storage/ClosureTypes.h@
+--
+-- @since 0.1.0.0
+data ClosureType
+ = INVALID_OBJECT
+ | CONSTR
+ | CONSTR_1_0
+ | CONSTR_0_1
+ | CONSTR_2_0
+ | CONSTR_1_1
+ | CONSTR_0_2
+ | CONSTR_NOCAF
+ | FUN
+ | FUN_1_0
+ | FUN_0_1
+ | FUN_2_0
+ | FUN_1_1
+ | FUN_0_2
+ | FUN_STATIC
+ | THUNK
+ | THUNK_1_0
+ | THUNK_0_1
+ | THUNK_2_0
+ | THUNK_1_1
+ | THUNK_0_2
+ | THUNK_STATIC
+ | THUNK_SELECTOR
+ | BCO
+ | AP
+ | PAP
+ | AP_STACK
+ | IND
+ | IND_STATIC
+ | RET_BCO
+ | RET_SMALL
+ | RET_BIG
+ | RET_FUN
+ | UPDATE_FRAME
+ | CATCH_FRAME
+ | UNDERFLOW_FRAME
+ | STOP_FRAME
+ | BLOCKING_QUEUE
+ | BLACKHOLE
+ | MVAR_CLEAN
+ | MVAR_DIRTY
+ | TVAR
+ | ARR_WORDS
+ | MUT_ARR_PTRS_CLEAN
+ | MUT_ARR_PTRS_DIRTY
+ | MUT_ARR_PTRS_FROZEN_DIRTY
+ | MUT_ARR_PTRS_FROZEN_CLEAN
+ | MUT_VAR_CLEAN
+ | MUT_VAR_DIRTY
+ | WEAK
+ | PRIM
+ | MUT_PRIM
+ | TSO
+ | STACK
+ | TREC_CHUNK
+ | ATOMICALLY_FRAME
+ | CATCH_RETRY_FRAME
+ | CATCH_STM_FRAME
+ | WHITEHOLE
+ | SMALL_MUT_ARR_PTRS_CLEAN
+ | SMALL_MUT_ARR_PTRS_DIRTY
+ | SMALL_MUT_ARR_PTRS_FROZEN_DIRTY
+ | SMALL_MUT_ARR_PTRS_FROZEN_CLEAN
+ | COMPACT_NFDATA
+ | CONTINUATION
+ | N_CLOSURE_TYPES
+ deriving (Enum, Eq, Ord, Show, Generic)
diff --git a/libraries/ghc-internal/src/GHC/Internal/InfoProv.hsc b/libraries/ghc-internal/src/GHC/Internal/InfoProv.hsc
index da5f39eca11..74bf4c7ad8a 100644
--- a/libraries/ghc-internal/src/GHC/Internal/InfoProv.hsc
+++ b/libraries/ghc-internal/src/GHC/Internal/InfoProv.hsc
@@ -2,6 +2,7 @@
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeApplications #-}
-----------------------------------------------------------------------------
-- |
@@ -36,15 +37,19 @@ module GHC.Internal.InfoProv
#include "Rts.h"
import GHC.Internal.Base
+import GHC.Internal.Enum
import GHC.Internal.Show
import GHC.Internal.Ptr (Ptr(..), plusPtr, nullPtr)
import GHC.Internal.IO.Encoding (utf8)
import GHC.Internal.Foreign.Storable (peekByteOff)
import GHC.Internal.Foreign.C.String.Encoding
+import GHC.Internal.Text.Read (readMaybe)
+import GHC.Internal.Data.Maybe (maybe)
+import GHC.Internal.ClosureTypes ( ClosureType(..) )
data InfoProv = InfoProv {
ipName :: String,
- ipDesc :: String,
+ ipDesc :: ClosureType,
ipTyDesc :: String,
ipLabel :: String,
ipMod :: String,
@@ -85,7 +90,9 @@ peekInfoProv infop = do
span <- peekCString utf8 =<< peekIpSrcSpan infop
return InfoProv {
ipName = name,
- ipDesc = desc,
+ -- The INVALID_OBJECT case should be impossible as we
+ -- control the C code generating these values.
+ ipDesc = maybe INVALID_OBJECT toEnum . readMaybe @Int $ desc,
ipTyDesc = tyDesc,
ipLabel = label,
ipMod = mod,
diff --git a/libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs b/libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
index 72bbe53c889..adf02bb1b8a 100644
--- a/libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
+++ b/libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}
@@ -30,9 +29,9 @@ import GHC.Internal.Exts () -- (Int (I#), RealWorld, StackSnapshot#, ThreadId#,
import GHC.Internal.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv)
import GHC.Internal.Num
import GHC.Internal.Stable
-import GHC.Internal.Text.Read
import GHC.Internal.Text.Show
import GHC.Internal.Ptr
+import GHC.Internal.ClosureTypes ( ClosureType(..) )
-- | A frozen snapshot of the state of an execution stack.
--
@@ -210,7 +209,7 @@ data StackEntry = StackEntry
{ functionName :: String,
moduleName :: String,
srcLoc :: String,
- closureType :: Word
+ closureType :: ClosureType
}
deriving (Show, Eq)
@@ -249,8 +248,7 @@ decode stackSnapshot = do
{ functionName = ipLabel infoProv,
moduleName = ipMod infoProv,
srcLoc = ipLoc infoProv,
- -- read looks dangerous, be we can trust that the closure type is always there.
- closureType = read . ipDesc $ infoProv
+ closureType = ipDesc $ infoProv
}
getDecodedStackArray :: StackSnapshot -> IO [Ptr InfoProvEnt]
diff --git a/rts/include/rts/storage/ClosureTypes.h b/rts/include/rts/storage/ClosureTypes.h
index a24a3235df5..3d860dbe0d6 100644
--- a/rts/include/rts/storage/ClosureTypes.h
+++ b/rts/include/rts/storage/ClosureTypes.h
@@ -16,6 +16,7 @@
* - the closure flags table in rts/ClosureFlags.c
* - isRetainer in rts/RetainerProfile.c
* - the closure_type_names list in rts/Printer.c
+ * - the ClosureType sum type in libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
*/
/* CONSTR/THUNK/FUN_$A_$B mean they have $A pointers followed by $B
diff --git a/testsuite/tests/interface-stability/base-exports.stdout b/testsuite/tests/interface-stability/base-exports.stdout
index a84fb9605ca..25441217e23 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout
+++ b/testsuite/tests/interface-stability/base-exports.stdout
@@ -8065,7 +8065,7 @@ module GHC.IORef where
module GHC.InfoProv where
-- Safety: Safe
type InfoProv :: *
- data InfoProv = InfoProv {ipName :: GHC.Internal.Base.String, ipDesc :: GHC.Internal.Base.String, ipTyDesc :: GHC.Internal.Base.String, ipLabel :: GHC.Internal.Base.String, ipMod :: GHC.Internal.Base.String, ipSrcFile :: GHC.Internal.Base.String, ipSrcSpan :: GHC.Internal.Base.String}
+ data InfoProv = InfoProv {ipName :: GHC.Internal.Base.String, ipDesc :: GHC.Internal.ClosureTypes.ClosureType, ipTyDesc :: GHC.Internal.Base.String, ipLabel :: GHC.Internal.Base.String, ipMod :: GHC.Internal.Base.String, ipSrcFile :: GHC.Internal.Base.String, ipSrcSpan :: GHC.Internal.Base.String}
type InfoProvEnt :: *
data InfoProvEnt
ipLoc :: InfoProv -> GHC.Internal.Base.String
@@ -9354,7 +9354,7 @@ module GHC.Stack.CCS where
module GHC.Stack.CloneStack where
-- Safety: None
type StackEntry :: *
- data StackEntry = StackEntry {functionName :: GHC.Internal.Base.String, moduleName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Base.String, closureType :: GHC.Types.Word}
+ data StackEntry = StackEntry {functionName :: GHC.Internal.Base.String, moduleName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Base.String, closureType :: GHC.Internal.ClosureTypes.ClosureType}
type StackSnapshot :: *
data StackSnapshot = StackSnapshot GHC.Prim.StackSnapshot#
cloneMyStack :: GHC.Types.IO StackSnapshot
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
index 7932f72a056..9fd710743f7 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
+++ b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
@@ -8034,7 +8034,7 @@ module GHC.IORef where
module GHC.InfoProv where
-- Safety: Safe
type InfoProv :: *
- data InfoProv = InfoProv {ipName :: GHC.Internal.Base.String, ipDesc :: GHC.Internal.Base.String, ipTyDesc :: GHC.Internal.Base.String, ipLabel :: GHC.Internal.Base.String, ipMod :: GHC.Internal.Base.String, ipSrcFile :: GHC.Internal.Base.String, ipSrcSpan :: GHC.Internal.Base.String}
+ data InfoProv = InfoProv {ipName :: GHC.Internal.Base.String, ipDesc :: GHC.Internal.ClosureTypes.ClosureType, ipTyDesc :: GHC.Internal.Base.String, ipLabel :: GHC.Internal.Base.String, ipMod :: GHC.Internal.Base.String, ipSrcFile :: GHC.Internal.Base.String, ipSrcSpan :: GHC.Internal.Base.String}
type InfoProvEnt :: *
data InfoProvEnt
ipLoc :: InfoProv -> GHC.Internal.Base.String
@@ -12396,7 +12396,7 @@ module GHC.Stack.CCS where
module GHC.Stack.CloneStack where
-- Safety: None
type StackEntry :: *
- data StackEntry = StackEntry {functionName :: GHC.Internal.Base.String, moduleName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Base.String, closureType :: GHC.Types.Word}
+ data StackEntry = StackEntry {functionName :: GHC.Internal.Base.String, moduleName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Base.String, closureType :: GHC.Internal.ClosureTypes.ClosureType}
type StackSnapshot :: *
data StackSnapshot = StackSnapshot GHC.Prim.StackSnapshot#
cloneMyStack :: GHC.Types.IO StackSnapshot
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-mingw32 b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
index 0009428dca6..7a78fcaac4e 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-mingw32
+++ b/testsuite/tests/interface-stability/base-exports.stdout-mingw32
@@ -8289,7 +8289,7 @@ module GHC.IORef where
module GHC.InfoProv where
-- Safety: Safe
type InfoProv :: *
- data InfoProv = InfoProv {ipName :: GHC.Internal.Base.String, ipDesc :: GHC.Internal.Base.String, ipTyDesc :: GHC.Internal.Base.String, ipLabel :: GHC.Internal.Base.String, ipMod :: GHC.Internal.Base.String, ipSrcFile :: GHC.Internal.Base.String, ipSrcSpan :: GHC.Internal.Base.String}
+ data InfoProv = InfoProv {ipName :: GHC.Internal.Base.String, ipDesc :: GHC.Internal.ClosureTypes.ClosureType, ipTyDesc :: GHC.Internal.Base.String, ipLabel :: GHC.Internal.Base.String, ipMod :: GHC.Internal.Base.String, ipSrcFile :: GHC.Internal.Base.String, ipSrcSpan :: GHC.Internal.Base.String}
type InfoProvEnt :: *
data InfoProvEnt
ipLoc :: InfoProv -> GHC.Internal.Base.String
@@ -9578,7 +9578,7 @@ module GHC.Stack.CCS where
module GHC.Stack.CloneStack where
-- Safety: None
type StackEntry :: *
- data StackEntry = StackEntry {functionName :: GHC.Internal.Base.String, moduleName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Base.String, closureType :: GHC.Types.Word}
+ data StackEntry = StackEntry {functionName :: GHC.Internal.Base.String, moduleName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Base.String, closureType :: GHC.Internal.ClosureTypes.ClosureType}
type StackSnapshot :: *
data StackSnapshot = StackSnapshot GHC.Prim.StackSnapshot#
cloneMyStack :: GHC.Types.IO StackSnapshot
diff --git a/testsuite/tests/interface-stability/base-exports.stdout-ws-32 b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
index a84fb9605ca..25441217e23 100644
--- a/testsuite/tests/interface-stability/base-exports.stdout-ws-32
+++ b/testsuite/tests/interface-stability/base-exports.stdout-ws-32
@@ -8065,7 +8065,7 @@ module GHC.IORef where
module GHC.InfoProv where
-- Safety: Safe
type InfoProv :: *
- data InfoProv = InfoProv {ipName :: GHC.Internal.Base.String, ipDesc :: GHC.Internal.Base.String, ipTyDesc :: GHC.Internal.Base.String, ipLabel :: GHC.Internal.Base.String, ipMod :: GHC.Internal.Base.String, ipSrcFile :: GHC.Internal.Base.String, ipSrcSpan :: GHC.Internal.Base.String}
+ data InfoProv = InfoProv {ipName :: GHC.Internal.Base.String, ipDesc :: GHC.Internal.ClosureTypes.ClosureType, ipTyDesc :: GHC.Internal.Base.String, ipLabel :: GHC.Internal.Base.String, ipMod :: GHC.Internal.Base.String, ipSrcFile :: GHC.Internal.Base.String, ipSrcSpan :: GHC.Internal.Base.String}
type InfoProvEnt :: *
data InfoProvEnt
ipLoc :: InfoProv -> GHC.Internal.Base.String
@@ -9354,7 +9354,7 @@ module GHC.Stack.CCS where
module GHC.Stack.CloneStack where
-- Safety: None
type StackEntry :: *
- data StackEntry = StackEntry {functionName :: GHC.Internal.Base.String, moduleName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Base.String, closureType :: GHC.Types.Word}
+ data StackEntry = StackEntry {functionName :: GHC.Internal.Base.String, moduleName :: GHC.Internal.Base.String, srcLoc :: GHC.Internal.Base.String, closureType :: GHC.Internal.ClosureTypes.ClosureType}
type StackSnapshot :: *
data StackSnapshot = StackSnapshot GHC.Prim.StackSnapshot#
cloneMyStack :: GHC.Types.IO StackSnapshot
diff --git a/testsuite/tests/profiling/should_run/staticcallstack001.stdout b/testsuite/tests/profiling/should_run/staticcallstack001.stdout
index f12e57e2f8c..abc747dec11 100644
--- a/testsuite/tests/profiling/should_run/staticcallstack001.stdout
+++ b/testsuite/tests/profiling/should_run/staticcallstack001.stdout
@@ -1,3 +1,3 @@
-Just (InfoProv {ipName = "D_Main_4_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "16:13-27"})
-Just (InfoProv {ipName = "D_Main_2_con_info", ipDesc = "2", ipTyDesc = "D", ipLabel = "caf", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "13:1-9"})
-Just (InfoProv {ipName = "sat_s11M_info", ipDesc = "15", ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "18:23-32"})
+Just (InfoProv {ipName = "D_Main_4_con_info", ipDesc = CONSTR_1_0, ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "16:13-27"})
+Just (InfoProv {ipName = "D_Main_2_con_info", ipDesc = CONSTR_1_0, ipTyDesc = "D", ipLabel = "caf", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "13:1-9"})
+Just (InfoProv {ipName = "sat_s11M_info", ipDesc = THUNK, ipTyDesc = "D", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack001.hs", ipSrcSpan = "18:23-32"})
diff --git a/testsuite/tests/profiling/should_run/staticcallstack002.stdout b/testsuite/tests/profiling/should_run/staticcallstack002.stdout
index 574d01fe17d..acf38927139 100644
--- a/testsuite/tests/profiling/should_run/staticcallstack002.stdout
+++ b/testsuite/tests/profiling/should_run/staticcallstack002.stdout
@@ -1,4 +1,4 @@
-Just (InfoProv {ipName = "sat_s11p_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"})
-Just (InfoProv {ipName = "sat_s11F_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"})
-Just (InfoProv {ipName = "sat_s11V_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"})
-Just (InfoProv {ipName = "sat_s12b_info", ipDesc = "15", ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"})
+Just (InfoProv {ipName = "sat_s11p_info", ipDesc = THUNK, ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "10:23-39"})
+Just (InfoProv {ipName = "sat_s11F_info", ipDesc = THUNK, ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "11:23-42"})
+Just (InfoProv {ipName = "sat_s11V_info", ipDesc = THUNK, ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "12:23-46"})
+Just (InfoProv {ipName = "sat_s12b_info", ipDesc = THUNK, ipTyDesc = "Any", ipLabel = "main", ipMod = "Main", ipSrcFile = "staticcallstack002.hs", ipSrcSpan = "13:23-44"})
diff --git a/testsuite/tests/rts/decodeMyStack.stdout b/testsuite/tests/rts/decodeMyStack.stdout
index 62d635d0fc3..7620e24610e 100644
--- a/testsuite/tests/rts/decodeMyStack.stdout
+++ b/testsuite/tests/rts/decodeMyStack.stdout
@@ -1,12 +1,12 @@
-StackEntry {functionName = "main.(...)", moduleName = "Main", srcLoc = "decodeMyStack.hs:22:27-41", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = 53}
-StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:13:7-21", closureType = 53}
+StackEntry {functionName = "main.(...)", moduleName = "Main", srcLoc = "decodeMyStack.hs:22:27-41", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:18:26-28", closureType = STACK}
+StackEntry {functionName = "getDeepStack.getDeepStackCase", moduleName = "Main", srcLoc = "decodeMyStack.hs:13:7-21", closureType = STACK}
diff --git a/testsuite/tests/rts/decodeMyStack_underflowFrames.hs b/testsuite/tests/rts/decodeMyStack_underflowFrames.hs
index aca05150d47..58ad3834a5e 100644
--- a/testsuite/tests/rts/decodeMyStack_underflowFrames.hs
+++ b/testsuite/tests/rts/decodeMyStack_underflowFrames.hs
@@ -1,6 +1,7 @@
module Main where
import GHC.Stack.CloneStack
+import GHC.Internal.ClosureTypes
import System.IO.Unsafe
import Control.Monad
@@ -34,16 +35,16 @@ main = do
StackEntry
{ functionName = "assertEqual",
moduleName = "Main",
- srcLoc = "decodeMyStack_underflowFrames.hs:23:11",
- closureType = 53
+ srcLoc = "decodeMyStack_underflowFrames.hs:24:11",
+ closureType = STACK
}
assertEqual
(stack !! 1)
StackEntry
{ functionName = "main.(...)",
moduleName = "Main",
- srcLoc = "decodeMyStack_underflowFrames.hs:29:20-36",
- closureType = 53
+ srcLoc = "decodeMyStack_underflowFrames.hs:30:20-36",
+ closureType = STACK
}
forM_
[2 .. 1001]
@@ -53,8 +54,8 @@ main = do
StackEntry
{ functionName = "getDeepStack.getDeepStackCase",
moduleName = "Main",
- srcLoc = "decodeMyStack_underflowFrames.hs:19:26-28",
- closureType = 53
+ srcLoc = "decodeMyStack_underflowFrames.hs:20:26-28",
+ closureType = STACK
}
)
assertEqual
@@ -62,6 +63,6 @@ main = do
StackEntry
{ functionName = "getDeepStack.getDeepStackCase",
moduleName = "Main",
- srcLoc = "decodeMyStack_underflowFrames.hs:14:7-21",
- closureType = 53
+ srcLoc = "decodeMyStack_underflowFrames.hs:15:7-21",
+ closureType = STACK
}
diff --git a/testsuite/tests/rts/ipe/T24005/t24005.stdout b/testsuite/tests/rts/ipe/T24005/t24005.stdout
index 194eb26f458..c3fb55f0982 100644
--- a/testsuite/tests/rts/ipe/T24005/t24005.stdout
+++ b/testsuite/tests/rts/ipe/T24005/t24005.stdout
@@ -1,2 +1,2 @@
-Just (InfoProv {ipName = "C:Show_Main_1_con_info", ipDesc = "1", ipTyDesc = "Show", ipLabel = "$fShowA", ipMod = "Main", ipSrcFile = "t24005.hs", ipSrcSpan = "25:10-15"})
-Just (InfoProv {ipName = "C:Show_Main_0_con_info", ipDesc = "1", ipTyDesc = "Show", ipLabel = "$fShowB", ipMod = "Main", ipSrcFile = "t24005.hs", ipSrcSpan = "29:10-29"})
+Just (InfoProv {ipName = "C:Show_Main_1_con_info", ipDesc = CONSTR, ipTyDesc = "Show", ipLabel = "$fShowA", ipMod = "Main", ipSrcFile = "t24005.hs", ipSrcSpan = "25:10-15"})
+Just (InfoProv {ipName = "C:Show_Main_0_con_info", ipDesc = CONSTR, ipTyDesc = "Show", ipLabel = "$fShowB", ipMod = "Main", ipSrcFile = "t24005.hs", ipSrcSpan = "29:10-29"})
--
GitLab