summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Data/FastMutInt.hs24
-rw-r--r--compiler/GHC/Data/FastString.hs10
-rw-r--r--compiler/GHC/Iface/Binary.hs6
-rw-r--r--compiler/GHC/Iface/Ext/Binary.hs6
-rw-r--r--compiler/GHC/Utils/Binary.hs20
-rw-r--r--compiler/GHC/Utils/BufHandle.hs3
6 files changed, 31 insertions, 38 deletions
diff --git a/compiler/GHC/Data/FastMutInt.hs b/compiler/GHC/Data/FastMutInt.hs
index 0cc26d793c..bc4c413bdc 100644
--- a/compiler/GHC/Data/FastMutInt.hs
+++ b/compiler/GHC/Data/FastMutInt.hs
@@ -17,21 +17,25 @@ import GHC.Prelude
import Data.Bits
import GHC.Base
-newFastMutInt :: IO FastMutInt
-readFastMutInt :: FastMutInt -> IO Int
-writeFastMutInt :: FastMutInt -> Int -> IO ()
-
-data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
-
-newFastMutInt = IO $ \s ->
- case newByteArray# size s of { (# s, arr #) ->
- (# s, FastMutInt arr #) }
- where !(I# size) = finiteBitSize (0 :: Int) `unsafeShiftR` 3
+data FastMutInt = FastMutInt !(MutableByteArray# RealWorld)
+
+newFastMutInt :: Int -> IO FastMutInt
+newFastMutInt n = do
+ x <- create
+ writeFastMutInt x n
+ return x
+ where
+ !(I# size) = finiteBitSize (0 :: Int) `unsafeShiftR` 3
+ create = IO $ \s ->
+ case newByteArray# size s of { (# s, arr #) ->
+ (# s, FastMutInt arr #) }
+readFastMutInt :: FastMutInt -> IO Int
readFastMutInt (FastMutInt arr) = IO $ \s ->
case readIntArray# arr 0# s of { (# s, i #) ->
(# s, I# i #) }
+writeFastMutInt :: FastMutInt -> Int -> IO ()
writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
case writeIntArray# arr 0# i s of { s ->
(# s, () #) }
diff --git a/compiler/GHC/Data/FastString.hs b/compiler/GHC/Data/FastString.hs
index 1388563ca7..188c2166b3 100644
--- a/compiler/GHC/Data/FastString.hs
+++ b/compiler/GHC/Data/FastString.hs
@@ -300,13 +300,13 @@ and updates to multiple buckets with low synchronization overhead.
See Note [Updating the FastString table] on how it's updated.
-}
data FastStringTable = FastStringTable
- {-# UNPACK #-} !(IORef Int) -- the unique ID counter shared with all buckets
- {-# UNPACK #-} !(IORef Int) -- number of computed z-encodings for all buckets
+ {-# UNPACK #-} !FastMutInt -- the unique ID counter shared with all buckets
+ {-# UNPACK #-} !FastMutInt -- number of computed z-encodings for all buckets
(Array# (IORef FastStringTableSegment)) -- concurrent segments
data FastStringTableSegment = FastStringTableSegment
- {-# UNPACK #-} !(MVar ()) -- the lock for write in each segment
- {-# UNPACK #-} !(IORef Int) -- the number of elements
+ {-# UNPACK #-} !(MVar ()) -- the lock for write in each segment
+ {-# UNPACK #-} !FastMutInt -- the number of elements
(MutableArray# RealWorld [FastString]) -- buckets in this segment
{-
@@ -367,7 +367,7 @@ stringTable = unsafePerformIO $ do
loop a# i# s1#
| isTrue# (i# ==# numSegments#) = s1#
| otherwise = case newMVar () `unIO` s1# of
- (# s2#, lock #) -> case newIORef 0 `unIO` s2# of
+ (# s2#, lock #) -> case newFastMutInt 0 `unIO` s2# of
(# s3#, counter #) -> case newArray# initialNumBuckets# [] s3# of
(# s4#, buckets# #) -> case newIORef
(FastStringTableSegment lock counter buckets#) `unIO` s4# of
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index e2a6f0a79b..c2276e2b01 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -217,14 +217,12 @@ putWithUserData traceBinIface bh payload = do
symtab_p_p <- tellBin bh
put_ bh symtab_p_p
-- Make some initial state
- symtab_next <- newFastMutInt
- writeFastMutInt symtab_next 0
+ symtab_next <- newFastMutInt 0
symtab_map <- newIORef emptyUFM
let bin_symtab = BinSymbolTable {
bin_symtab_next = symtab_next,
bin_symtab_map = symtab_map }
- dict_next_ref <- newFastMutInt
- writeFastMutInt dict_next_ref 0
+ dict_next_ref <- newFastMutInt 0
dict_map_ref <- newIORef emptyUFM
let bin_dict = BinDictionary {
bin_dict_next = dict_next_ref,
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 69aee26586..b118cd8da7 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -98,14 +98,12 @@ writeHieFile hie_file_path hiefile = do
put_ bh0 symtab_p_p
-- Make some initial state
- symtab_next <- newFastMutInt
- writeFastMutInt symtab_next 0
+ symtab_next <- newFastMutInt 0
symtab_map <- newIORef emptyUFM :: IO (IORef (UniqFM Name (Int, HieName)))
let hie_symtab = HieSymbolTable {
hie_symtab_next = symtab_next,
hie_symtab_map = symtab_map }
- dict_next_ref <- newFastMutInt
- writeFastMutInt dict_next_ref 0
+ dict_next_ref <- newFastMutInt 0
dict_map_ref <- newIORef emptyUFM
let hie_dict = HieDictionary {
hie_dict_next = dict_next_ref,
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs
index 5ee0806cc1..a925b0a999 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -134,10 +134,8 @@ instance Binary BinData where
dataHandle :: BinData -> IO BinHandle
dataHandle (BinData size bin) = do
- ixr <- newFastMutInt
- szr <- newFastMutInt
- writeFastMutInt ixr 0
- writeFastMutInt szr size
+ ixr <- newFastMutInt 0
+ szr <- newFastMutInt size
binr <- newIORef bin
return (BinMem noUserData ixr szr binr)
@@ -215,10 +213,8 @@ openBinMem size
| otherwise = do
arr <- mallocForeignPtrBytes size
arr_r <- newIORef arr
- ix_r <- newFastMutInt
- writeFastMutInt ix_r 0
- sz_r <- newFastMutInt
- writeFastMutInt sz_r size
+ ix_r <- newFastMutInt 0
+ sz_r <- newFastMutInt size
return (BinMem noUserData ix_r sz_r arr_r)
tellBin :: BinHandle -> IO (Bin a)
@@ -251,10 +247,8 @@ readBinMem filename = do
error ("Binary.readBinMem: only read " ++ show count ++ " bytes")
hClose h
arr_r <- newIORef arr
- ix_r <- newFastMutInt
- writeFastMutInt ix_r 0
- sz_r <- newFastMutInt
- writeFastMutInt sz_r filesize
+ ix_r <- newFastMutInt 0
+ sz_r <- newFastMutInt filesize
return (BinMem noUserData ix_r sz_r arr_r)
-- expand the size of the array to include a specified offset
@@ -896,7 +890,7 @@ lazyGet bh = do
a <- unsafeInterleaveIO $ do
-- NB: Use a fresh off_r variable in the child thread, for thread
-- safety.
- off_r <- newFastMutInt
+ off_r <- newFastMutInt 0
getAt bh { _off_r = off_r } p_a
seekBin bh p -- skip over the object for now
return a
diff --git a/compiler/GHC/Utils/BufHandle.hs b/compiler/GHC/Utils/BufHandle.hs
index b0b829f96f..aed15610cb 100644
--- a/compiler/GHC/Utils/BufHandle.hs
+++ b/compiler/GHC/Utils/BufHandle.hs
@@ -46,8 +46,7 @@ data BufHandle = BufHandle {-#UNPACK#-}!(Ptr Word8)
newBufHandle :: Handle -> IO BufHandle
newBufHandle hdl = do
ptr <- mallocBytes buf_size
- r <- newFastMutInt
- writeFastMutInt r 0
+ r <- newFastMutInt 0
return (BufHandle ptr r hdl)
buf_size :: Int
View Lorry Controller Status