Validate

4 files changed, 33 insertions, 81 deletions

diff --git a/libraries/ghc-heap/GHC/Exts/Heap.hs b/libraries/ghc-heap/GHC/Exts/Heap.hs
index 0c6384c3e7..10fe6bda44 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap.hs
+++ b/libraries/ghc-heap/GHC/Exts/Heap.hs
@@ -57,6 +57,8 @@ module GHC.Exts.Heap (
     , allClosures
     , closureSize
 #if MIN_TOOL_VERSION_ghc(9,7,0)
+     -- * Stack inspection
+    , decodeStack
     , stackFrameSize
 #endif
     -- * Boxes
@@ -80,11 +82,8 @@ import GHC.Exts
 import GHC.Int
 import GHC.Word
 #if MIN_TOOL_VERSION_ghc(9,7,0)
-import GHC.Stack.CloneStack
 import GHC.Exts.Stack.Decode
 import GHC.Exts.Stack.Constants
-import Data.Functor
-import Debug.Trace
 #endif
 
 
diff --git a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
index 1265d50d68..5ccd6b3892 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
+++ b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
@@ -11,7 +11,6 @@ module GHC.Exts.Heap.Closures (
     -- * Closures
       Closure
     , GenClosure(..)
-    , StackFrame(..)
     , PrimType(..)
     , WhatNext(..)
     , WhyBlocked(..)
@@ -19,14 +18,14 @@ module GHC.Exts.Heap.Closures (
     , RetFunType(..)
     , allClosures
 
+    -- * Stack
+    , StgStackClosure(..)
+    , StackFrame(..)
+
     -- * Boxes
     , Box(..)
     , areBoxesEqual
     , asBox
-    , StgStackClosure(..)
-#if MIN_TOOL_VERSION_ghc(9,7,0)
-    , StackFrameIter(..)
-#endif
     ) where
 
 import Prelude -- See note [Why do we import Prelude here?]
@@ -52,10 +51,6 @@ import Data.Word
 import GHC.Exts
 import GHC.Generics
 import Numeric
-#if MIN_TOOL_VERSION_ghc(9,7,0)
-import GHC.Stack.CloneStack (StackSnapshot(..), stackSnapshotToString)
-import GHC.Exts.Stack.Constants
-#endif
 
 ------------------------------------------------------------------------
 -- Boxes
@@ -65,50 +60,6 @@ foreign import prim "aToWordzh" aToWord# :: Any -> Word#
 foreign import prim "reallyUnsafePtrEqualityUpToTag"
     reallyUnsafePtrEqualityUpToTag# :: Any -> Any -> Int#
 
-#if MIN_TOOL_VERSION_ghc(9,7,0)
--- | Iterator state for stack decoding
-data StackFrameIter =
-  -- | Represents a closure on the stack
-  SfiClosure
-    { stackSnapshot# :: !StackSnapshot#,
-      index :: !WordOffset
-    }
-  -- | Represents a primitive word on the stack
-  | SfiPrimitive
-    { stackSnapshot# :: !StackSnapshot#,
-      index :: !WordOffset
-    }
-
-instance Eq StackFrameIter where
-  (SfiClosure s1# i1) == (SfiClosure s2# i2) =
-    (StackSnapshot s1#) == (StackSnapshot s2#)
-    && i1 == i2
-  (SfiPrimitive s1# i1) == (SfiPrimitive s2# i2) =
-    (StackSnapshot s1#) == (StackSnapshot s2#)
-    && i1 == i2
-  _ == _ = False
-
-instance Show StackFrameIter where
-   showsPrec _ (SfiClosure s# i ) rs =
-    "SfiClosure { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ show i ++ ", " ++ "}" ++ rs
-   showsPrec _ (SfiPrimitive s# i ) rs =
-    "SfiPrimitive { stackSnapshot# = " ++ stackSnapshotToString (StackSnapshot s#) ++ show i ++ ", " ++ "}" ++ rs
-
--- | A value or reference to a value on the stack.
-newtype StackFrameBox =  StackFrameBox StackFrameIter
-  deriving (Eq)
-
-instance Show StackFrameBox where
-   showsPrec _ (StackFrameBox sfi) rs =
-    "(StackFrameBox " ++ show sfi ++ ")" ++ rs
-
-areStackFrameBoxesEqual :: StackFrameBox -> StackFrameBox -> Bool
-areStackFrameBoxesEqual (StackFrameBox sfi1) (StackFrameBox sfi2) =
-  sfi1 == sfi2
-areStackFrameBoxesEqual _ _ = False
-
-#endif
-
 -- | An arbitrary Haskell value in a safe Box. The point is that even
 -- unevaluated thunks can safely be moved around inside the Box, and when
 -- required, e.g. in 'getBoxedClosureData', the function knows how far it has
diff --git a/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs b/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
index 9a51b43375..d775c369ce 100644
--- a/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
+++ b/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
@@ -212,6 +212,14 @@ getClosure stackSnapshot# index relativeOffset =
       (# s1, ptr #) ->
         (# s1, Box ptr #)
 
+-- TODO: Inline later
+-- | Iterator state for stack decoding
+data StackFrameIter =
+  -- | Represents a closure on the stack
+  SfiClosure !StackSnapshot# !WordOffset
+  -- | Represents a primitive word on the stack
+  | SfiPrimitive !StackSnapshot# !WordOffset
+
 decodeLargeBitmap :: LargeBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [Closure]
 decodeLargeBitmap getterFun# stackSnapshot# index relativePayloadOffset = do
   (bitmapArray, size) <- IO $ \s ->
@@ -237,11 +245,10 @@ decodeBitmaps stackSnapshot# index relativePayloadOffset bitmapWords size =
    in mapM toBitmapPayload bes
   where
     toBitmapPayload :: StackFrameIter -> IO Closure
-    toBitmapPayload sfi@SfiPrimitive {..} = do
-      w <- getWord stackSnapshot# index 0
+    toBitmapPayload (SfiPrimitive stack# i)  = do
+      w <- getWord stack# i 0
       pure $ UnknownTypeWordSizedPrimitive w
-    toBitmapPayload sfi@SfiClosure {..} = getBoxedClosureData =<< getClosure stackSnapshot# index 0
-    toBitmapPayload sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi
+    toBitmapPayload (SfiClosure stack# i) = getBoxedClosureData =<< getClosure stack# i 0
 
     wordsToBitmapEntries :: WordOffset -> [Word] -> Word -> [StackFrameIter]
     wordsToBitmapEntries _ [] 0 = []
@@ -279,7 +286,6 @@ decodeBitmaps stackSnapshot# index relativePayloadOffset bitmapWords size =
         getIndex :: StackFrameIter -> WordOffset
         getIndex (SfiClosure _ i) = i
         getIndex (SfiPrimitive _ i) = i
-        getIndex sfi' = error $ "Has no index : " ++ show sfi'
 
 decodeSmallBitmap :: SmallBitmapGetter -> StackSnapshot# -> WordOffset -> WordOffset -> IO [Closure]
 decodeSmallBitmap getterFun# stackSnapshot# index relativePayloadOffset =
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index c261c80f00..cde889158d 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP,
-    UnboxedTuples, LambdaCase #-}
+{-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP, UnboxedTuples #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 -- |
@@ -94,10 +93,7 @@ run m = case m of
   StartTH -> startTH
   GetClosure ref -> do
     clos <- Heap.getClosureData =<< localRef ref
-    mapM (\case
-             Heap.Box x -> mkRemoteRef (HValue x)
-             r -> error $ "Unsupported Box: " ++ show r
-         ) clos
+    mapM (\(Heap.Box x) -> mkRemoteRef (HValue x)) clos
   Seq ref -> doSeq ref
   ResumeSeq ref -> resumeSeq ref
   _other -> error "GHCi.Run.run"
@@ -376,21 +372,21 @@ mkString0 bs = B.unsafeUseAsCStringLen bs $ \(cstr,len) -> do
   return (castRemotePtr (toRemotePtr ptr))
 
 mkCostCentres :: String -> [(String,String)] -> IO [RemotePtr CostCentre]
-#if defined(PROFILING)
-mkCostCentres mod ccs = do
-  c_module <- newCString mod
-  mapM (mk_one c_module) ccs
- where
-  mk_one c_module (decl_path,srcspan) = do
-    c_name <- newCString decl_path
-    c_srcspan <- newCString srcspan
-    toRemotePtr <$> c_mkCostCentre c_name c_module c_srcspan
-
-foreign import ccall unsafe "mkCostCentre"
-  c_mkCostCentre :: Ptr CChar -> Ptr CChar -> Ptr CChar -> IO (Ptr CostCentre)
-#else
+
+
+
+
+
+
+
+
+
+
+
+
+
 mkCostCentres _ _ = return []
-#endif
+
 
 getIdValFromApStack :: HValue -> Int -> IO (Maybe HValue)
 getIdValFromApStack apStack (I# stackDepth) = do