[Git][ghc/ghc][wip/decode_cloned_stack] 2 commits: Reduce diff

[Sven Tennie (@supersven)]

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


Commits:
c7d7be36 by Sven Tennie at 2023-04-09T16:27:02+00:00
Reduce diff

- - - - -
1409fc67 by Sven Tennie at 2023-04-09T16:27:17+00:00
Use function level pattern match

- - - - -


3 changed files:

- libraries/ghc-heap/GHC/Exts/Stack.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/Run.hs


Changes:

=====================================
libraries/ghc-heap/GHC/Exts/Stack.hs
=====================================
@@ -1,35 +1,34 @@
 {-# LANGUAGE CPP #-}
 #if MIN_TOOL_VERSION_ghc(9,7,0)
 {-# LANGUAGE RecordWildCards #-}
-module GHC.Exts.Stack (
-     -- * Stack inspection
-      decodeStack
-    , stackFrameSize
-                     )
+
+module GHC.Exts.Stack
+  ( -- * Stack inspection
+    decodeStack,
+    stackFrameSize,
+  )
 where
+
 import GHC.Exts.Heap.Closures
-import GHC.Exts.Stack.Decode
 import GHC.Exts.Stack.Constants
+import GHC.Exts.Stack.Decode
 import Prelude
 
--- TODO: Pattern match may move to function arguments
 stackFrameSize :: StackFrame -> Int
-stackFrameSize =
-  \c ->
-    case c of
-      UpdateFrame {} -> sizeStgUpdateFrame
-      CatchFrame {} -> sizeStgCatchFrame
-      CatchStmFrame {} -> sizeStgCatchSTMFrame
-      CatchRetryFrame {} -> sizeStgCatchRetryFrame
-      AtomicallyFrame {} -> sizeStgAtomicallyFrame
-      RetSmall {..} -> sizeStgClosure + length stack_payload
-      RetBig {..} -> sizeStgClosure + length stack_payload
-      RetFun {..} -> sizeStgRetFunFrame + length retFunPayload
-      -- The one additional word is a pointer to the StgBCO in the closure's payload
-      RetBCO {..} -> sizeStgClosure + 1 + length bcoArgs
-      -- The one additional word is a pointer to the next stack chunk
-      UnderflowFrame {} -> sizeStgClosure + 1
-      _ -> error "Unexpected closure type"
+stackFrameSize (UpdateFrame {}) = sizeStgUpdateFrame
+stackFrameSize (CatchFrame {}) = sizeStgCatchFrame
+stackFrameSize (CatchStmFrame {}) = sizeStgCatchSTMFrame
+stackFrameSize (CatchRetryFrame {}) = sizeStgCatchRetryFrame
+stackFrameSize (AtomicallyFrame {}) = sizeStgAtomicallyFrame
+stackFrameSize (RetSmall {..}) = sizeStgClosure + length stack_payload
+stackFrameSize (RetBig {..}) = sizeStgClosure + length stack_payload
+stackFrameSize (RetFun {..}) = sizeStgRetFunFrame + length retFunPayload
+-- The one additional word is a pointer to the StgBCO in the closure's payload
+stackFrameSize (RetBCO {..}) = sizeStgClosure + 1 + length bcoArgs
+-- The one additional word is a pointer to the next stack chunk
+stackFrameSize (UnderflowFrame {}) = sizeStgClosure + 1
+stackFrameSize _ = error "Unexpected stack frame type"
+
 #else
 module GHC.Exts.Stack where
 #endif


=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -474,7 +474,7 @@ instance Binary Heap.TsoFlags
 instance Binary Heap.StgInfoTable
 instance Binary Heap.ClosureType
 instance Binary Heap.PrimType
-instance (Binary a) => Binary (Heap.GenClosure a)
+instance Binary a => Binary (Heap.GenClosure a)
 
 data Msg = forall a . (Binary a, Show a) => Msg (Message a)
 


=====================================
libraries/ghci/GHCi/Run.hs
=====================================
@@ -1,4 +1,5 @@
-{-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP, UnboxedTuples #-}
+{-# LANGUAGE GADTs, RecordWildCards, MagicHash, ScopedTypeVariables, CPP,
+    UnboxedTuples #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 -- |
@@ -372,21 +373,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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9887028dd014359f2013dfe67ca857ad4c0e1373...1409fc6789205cfaad0e909b4313d6ebd01a3231

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9887028dd014359f2013dfe67ca857ad4c0e1373...1409fc6789205cfaad0e909b4313d6ebd01a3231
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/20230409/4b7f8445/attachment-0001.html>