[Git][ghc/ghc][wip/keepAlive-the-return-of-the-primop] 2 commits: GHC.Event.IntTable: Use unsafeWithForeignPtr

[Ben Gamari]

Ben Gamari pushed to branch wip/keepAlive-the-return-of-the-primop at Glasgow Haskell Compiler / GHC


Commits:
97aa7d1f by Ben Gamari at 2020-12-01T12:15:29-05:00
GHC.Event.IntTable: Use unsafeWithForeignPtr

- - - - -
29a1a41c by Ben Gamari at 2020-12-02T13:20:38-05:00
testsuite fixes

- - - - -


3 changed files:

- libraries/base/GHC/Event/IntTable.hs
- testsuite/tests/ghci/should_run/T16012.script
- testsuite/tests/ghci/should_run/T16012.stdout


Changes:

=====================================
libraries/base/GHC/Event/IntTable.hs
=====================================
@@ -17,7 +17,8 @@ module GHC.Event.IntTable
 import Data.Bits ((.&.), shiftL, shiftR)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 import Data.Maybe (Maybe(..), isJust)
-import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr, withForeignPtr)
+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtr)
+import GHC.ForeignPtr (unsafeWithForeignPtr)
 import Foreign.Storable (peek, poke)
 import GHC.Base (Monad(..), (=<<), ($), ($!), const, liftM, otherwise, when)
 import GHC.Classes (Eq(..), Ord(..))
@@ -62,7 +63,7 @@ new_ :: Int -> IO (IT a)
 new_ capacity = do
   arr <- Arr.new Empty capacity
   size <- mallocForeignPtr
-  withForeignPtr size $ \ptr -> poke ptr 0
+  unsafeWithForeignPtr size $ \ptr -> poke ptr 0
   return IT { tabArr = arr
             , tabSize = size
             }
@@ -81,7 +82,7 @@ grow oldit ref size = do
                 copyBucket (m+1) bucketNext
           copyBucket n =<< Arr.read (tabArr oldit) i
   copySlot 0 0
-  withForeignPtr (tabSize newit) $ \ptr -> poke ptr size
+  unsafeWithForeignPtr (tabSize newit) $ \ptr -> poke ptr size
   writeIORef ref newit
 
 -- | @insertWith f k v table@ inserts @k@ into @table@ with value @v at .
@@ -100,7 +101,7 @@ insertWith f k v inttable@(IntTable ref) = do
           Arr.write tabArr idx (Bucket k v' next)
           return (Just bucketValue)
         | otherwise = go bkt { bucketNext = seen } bucketNext
-      go seen _ = withForeignPtr tabSize $ \ptr -> do
+      go seen _ = unsafeWithForeignPtr tabSize $ \ptr -> do
         size <- peek ptr
         if size + 1 >= Arr.size tabArr - (Arr.size tabArr `shiftR` 2)
           then grow it ref size >> insertWith f k v inttable
@@ -139,7 +140,7 @@ updateWith f k (IntTable ref) = do
   when (isJust oldVal) $ do
     Arr.write tabArr idx newBucket
     when del $
-      withForeignPtr tabSize $ \ptr -> do
+      unsafeWithForeignPtr tabSize $ \ptr -> do
         size <- peek ptr
         poke ptr (size - 1)
   return oldVal


=====================================
testsuite/tests/ghci/should_run/T16012.script
=====================================
@@ -3,4 +3,4 @@
 -- should always return a reasonably low result.
 
 n <- System.Mem.getAllocationCounter
-if (n < 0 && n >= -160000) then putStrLn "Alloction counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n)
+if (n < 0 && n >= -200000) then putStrLn "Allocation counter in expected range" else (putStrLn $ "Unexpected allocation counter result:" ++ show n)


=====================================
testsuite/tests/ghci/should_run/T16012.stdout
=====================================
@@ -1 +1 @@
-Alloction counter in expected range
+Allocation counter in expected range



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e11f088bf1f36cd8889ece8dd59c5d8964b8a2eb...29a1a41cac433c9b7eadfc03aceadd5ac69a4999

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e11f088bf1f36cd8889ece8dd59c5d8964b8a2eb...29a1a41cac433c9b7eadfc03aceadd5ac69a4999
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/20201202/c3e0d730/attachment-0001.html>