rcu 0.2.3 → 0.2.4
raw patch · 11 files changed
+50/−78 lines, 11 filesdep −hlintdep ~basedep ~doctest
Dependencies removed: hlint
Dependency ranges changed: base, doctest
Files
- CHANGELOG.markdown +4/−0
- examples/IncCounterExperiment.hs +6/−6
- examples/ListInt.hs +4/−4
- examples/MoveString.hs +5/−5
- examples/TimeSynchronize.hs +11/−11
- rcu.cabal +8/−26
- src/Control/Concurrent/RCU/Class.hs +0/−1
- src/Control/Concurrent/RCU/GC/Internal.hs +4/−0
- src/Control/Concurrent/RCU/QSBR/Internal.hs +4/−0
- tests/hlint.hs +0/−23
- unstable/Control/Concurrent/RCU/STM/Internal.hs +4/−2
CHANGELOG.markdown view
@@ -1,3 +1,7 @@+## 0.2.4 [2019.05.02]+---------------------+* Support building with `base-4.13` (GHC 8.8).+ ## 0.2.3 [2018.08.01] --------------------- * Add `MonadFail` instances for `ReadingRCU` and `WritingRCU`.
examples/IncCounterExperiment.hs view
@@ -4,7 +4,7 @@ -- | -- Copyright : (C) 2015 Edward Kmett and Ted Cooper -- License : BSD-style (see the file LICENSE)--- Maintainer : Edward Kmett <ekmett@gmail.com>, +-- Maintainer : Edward Kmett <ekmett@gmail.com>, -- Ted Cooper <anthezium@gmail.com> -- Stability : experimental -- Portability : non-portable@@ -51,13 +51,13 @@ {-# INLINE writeCounter #-} incCounterAtomic :: Counter -> IO Word64-incCounterAtomic (Counter (MutableByteArray c)) = primitive $ \ s -> +incCounterAtomic (Counter (MutableByteArray c)) = primitive $ \ s -> case fetchAddIntArray# c 0# 2# s of (# s', r #) -> (# s', W64# (int2Word# r) #) {-# INLINE incCounterAtomic #-} incCounterNonAtomicFancy :: Counter -> IO Word64-incCounterNonAtomicFancy (Counter (MutableByteArray c)) = primitive $ \ s -> +incCounterNonAtomicFancy (Counter (MutableByteArray c)) = primitive $ \ s -> case readWord64Array# c 0# s of (# s', r #) -> case plusWord# r (int2Word# 2#) of r' -> case writeWord64Array# c 0# r' s' of@@ -73,10 +73,10 @@ main :: IO () main = defaultMain [ bgroup "incCounterAtomic" $ bunches incCounterAtomic- , bgroup "incCounterNonAtomicFancy" $ bunches incCounterNonAtomicFancy + , bgroup "incCounterNonAtomicFancy" $ bunches incCounterNonAtomicFancy , bgroup "incCounterNonAtomic" $ bunches incCounterNonAtomic ]- where bunches m = [ bench (show n) + where bunches m = [ bench (show n) $ nfIO $ do c <- newCounter forM_ [1..n] $ \ _ -> m c- | n <- map ((10 :: Word64) ^) [(6 :: Word64)..7] ] + | n <- map ((10 :: Word64) ^) [(6 :: Word64)..7] ]
examples/ListInt.hs view
@@ -20,7 +20,7 @@ deleteMiddle rl = do Cons a rn <- readSRef rl Cons _ rm <- readSRef rn- writeSRef rl $ Cons a rm + writeSRef rl $ Cons a rm testList :: RCU s (SRef s (List s Int)) testList = do@@ -30,7 +30,7 @@ newSRef $ Cons 1 c2 main :: IO ()-main = do +main = do outs <- runRCU $ do -- initialize list head <- testList@@ -38,9 +38,9 @@ rts <- replicateM 8 $ forking $ reading $ reader 100000 0 head -- spawn a writer to delete the middle node wt <- forking $ writing $ deleteMiddle head- + -- wait for the readers to finish and print snapshots- outs <- forM rts $ \rt -> do + outs <- forM rts $ \rt -> do v <- joining rt return $ show (rcuThreadId rt) ++ ": " ++ show v -- wait for the writer to finish
examples/MoveString.hs view
@@ -24,7 +24,7 @@ deleteMiddle rl = do Cons a rn <- readSRef rl Cons _ rm <- readSRef rn- writeSRef rl $ Cons a rm + writeSRef rl $ Cons a rm -} moveDback :: SRef s (List s Char) -> WritingRCU s ()@@ -37,7 +37,7 @@ ne <- readSRef rd -- link in a new C after A writeSRef rb $ Cons c rb'- -- any reader who starts during this grace period + -- any reader who starts during this grace period -- sees either "ABCDE" or "ACBCDE" synchronize -- unlink the old C@@ -56,7 +56,7 @@ compactShow xs = intercalate ", " $ map (\xs' -> show (length xs') ++ " x " ++ show (head xs')) $ group xs main :: IO ()-main = do +main = do outs <- runRCU $ do -- initialize list hd <- testList@@ -64,9 +64,9 @@ rts <- replicateM 8 $ forking $ reader 100000 [] hd -- spawn a writer to move a node from a later position to an earlier position wt <- forking $ writing $ moveDback hd- + -- wait for the readers to finish and print snapshots- outs <- forM rts $ \rt -> do + outs <- forM rts $ \rt -> do v <- joining rt return $ show (rcuThreadId rt) ++ ": " ++ compactShow v -- wait for the writer to finish
examples/TimeSynchronize.hs view
@@ -59,7 +59,7 @@ reader :: SRef s Bool -> Integer -> SRef s (List s Word64) -> RCU s Integer reader rf !acc hd = do- (acc', flag) <- reading $ do dup <- checkForDup (0, False) =<< readSRef hd + (acc', flag) <- reading $ do dup <- checkForDup (0, False) =<< readSRef hd --when dup $ do -- xs <- snapshot [] =<< readSRef hd -- trace (show xs) $ return ()@@ -80,8 +80,8 @@ replicateM_ n m return timeZero #endif- + moveDback :: SRef s (List s a) -> WritingRCU s TimeT moveDback rl = WritingRCU $ \ s -> do (rc, ne) <- flip runWritingRCU s $ do@@ -97,7 +97,7 @@ #if MEASURE_SYNCHRONIZE beg <- timer #endif- -- any reader who starts during this grace period + -- any reader who starts during this grace period -- sees either "ABCDE" or "ACBCDE" runWritingRCU synchronize s #if MEASURE_SYNCHRONIZE@@ -115,11 +115,11 @@ where helper (- 1) tl = return tl helper i tl = helper (pred i) =<< newSRef (Cons (shiftL 1 i) tl) -data Opts = Opts { nReserved :: Integer +data Opts = Opts { nReserved :: Integer , nUpdates :: Integer } main :: IO ()-main = do +main = do Opts { nReserved, nUpdates } <- execParser opts nCaps <- getNumCapabilities putStrLn $ "nCaps: " ++ show nCaps@@ -132,7 +132,7 @@ -- initialize flag writer uses to stop readers rf <- unRCU (newSRef False) s -- spawn nReaders readers, each takes snapshots of the list until the writer has finished- rts <- forM [2..fromIntegral nReaders + 1] $ \ i -> flip unRCU (s { rcuStatePinned = Just i }) $ forking $ reading $ ReadingRCU + rts <- forM [2..fromIntegral nReaders + 1] $ \ i -> flip unRCU (s { rcuStatePinned = Just i }) $ forking $ reading $ ReadingRCU $ \ s' -> do beg <- timer x <- evaluate . force =<< unRCU (reader rf 0 hd) s' -- how long do the snapshots take? mid <- timer@@ -142,7 +142,7 @@ , mid `timerDiff` beg , end `timerDiff` mid ) -- spawn a writer to move a node from a later position to an earlier position nUpdates times- wt <- flip unRCU (s { rcuStatePinned = Just 1 }) $ forking $ writing $ WritingRCU + wt <- flip unRCU (s { rcuStatePinned = Just 1 }) $ forking $ writing $ WritingRCU $ \ s' -> do beg <- timer x <- evaluate . force =<< runWritingRCU (writer (fromIntegral nUpdates) (moveDback hd)) s' runWritingRCU (writeSRef rf True) s'@@ -168,12 +168,12 @@ a (x,_,_) = x b (_,y,_) = y c (_,_,z) = z- putStrLn $ "dups by thread:" ++ (intercalate ", " $ zipWith (\ i dups -> show i ++ ": " ++ show dups) [(1 :: Integer)..] outs)+ putStrLn $ "dups by thread:" ++ intercalate ", " (zipWith (\ i dups -> show i ++ ": " ++ show dups) [(1 :: Integer)..] outs) putStrLn $ "average dups per update: " ++ show (fromIntegral (sum outs) / nTotal) #if UNBOUND- putStrLn $ "times in SECONDS"+ putStrLn "times in SECONDS" #else- putStrLn $ "times in TICKS"+ putStrLn "times in TICKS" #endif putStrLn $ "reader times: " ++ show rds putStrLn $ "reader evaluate . force times: " ++ show rfds@@ -203,4 +203,4 @@ <> short 'u' <> metavar "M" <> help "Writer thread performs M updates" )- +
rcu.cabal view
@@ -1,8 +1,8 @@ name: rcu category: Data-version: 0.2.3+version: 0.2.4 license: BSD3-cabal-version: >= 1.22+cabal-version: 1.22 license-file: LICENSE author: Ted Cooper and Edward A. Kmett maintainer: Edward A. Kmett <ekmett@gmail.com>, Ted Cooper <anthezium@gmail.com>@@ -14,8 +14,9 @@ tested-with: GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2- , GHC == 8.4.3- , GHC == 8.6.1+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.1 synopsis: Read-Copy-Update for Haskell description: Read-Copy-Update for Haskell. @@ -35,11 +36,6 @@ default: True manual: True --- You can disable the doctests test suite with -f-test-doctests-flag test-hlint- default: True- manual: True- -- Include unstable and/or potentially incorrect implementations. flag unstable default: False@@ -93,13 +89,13 @@ executable MoveStringSTM main-is: MoveString.hs cpp-options: -DMODE=STM+ hs-source-dirs: examples+ ghc-options: -threaded -Wall -feager-blackholing -fwarn-tabs "-with-rtsopts=-N -qa -qb -qm -s"+ default-language: Haskell2010 if !flag(unstable) buildable: False else build-depends: base, rcu, transformers- hs-source-dirs: examples- ghc-options: -threaded -Wall -feager-blackholing -fwarn-tabs "-with-rtsopts=-N -qa -qb -qm -s"- default-language: Haskell2010 executable MoveStringQSBR main-is: MoveString.hs@@ -471,17 +467,3 @@ doctest >= 0.11.1 && < 0.17, parallel, rcu--test-suite hlint- type: exitcode-stdio-1.0- main-is: hlint.hs- ghc-options: -w -threaded -rtsopts -with-rtsopts=-N- hs-source-dirs: tests- default-language: Haskell2010-- if !flag(test-hlint)- buildable: False- else- build-depends:- base,- hlint >= 1.7
src/Control/Concurrent/RCU/Class.hs view
@@ -6,7 +6,6 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# OPTIONS_HADDOCK not-home #-} -----------------------------------------------------------------------------
src/Control/Concurrent/RCU/GC/Internal.hs view
@@ -140,7 +140,9 @@ ReadingRCU m >>= f = ReadingRCU $ \ s -> do a <- m s runReadingRCU (f a) s+#if !(MIN_VERSION_base(4,13,0)) fail = Fail.fail+#endif instance Fail.MonadFail (ReadingRCU s) where fail s = ReadingRCU $ \ _ -> Fail.fail s@@ -177,7 +179,9 @@ WritingRCU m >>= f = WritingRCU $ \ s -> do a <- m s runWritingRCU (f a) s+#if !(MIN_VERSION_base(4,13,0)) fail = Fail.fail+#endif instance Fail.MonadFail (WritingRCU s) where fail s = WritingRCU $ \ _ -> Fail.fail s
src/Control/Concurrent/RCU/QSBR/Internal.hs view
@@ -150,7 +150,9 @@ ReadingRCU m >>= f = ReadingRCU $ \ s -> do a <- m s runReadingRCU (f a) s+#if !(MIN_VERSION_base(4,13,0)) fail = Fail.fail+#endif instance Fail.MonadFail (ReadingRCU s) where fail s = ReadingRCU $ \ _ -> Fail.fail s@@ -187,7 +189,9 @@ WritingRCU m >>= f = WritingRCU $ \ s -> do a <- m s runWritingRCU (f a) s+#if !(MIN_VERSION_base(4,13,0)) fail = Fail.fail+#endif instance Fail.MonadFail (WritingRCU s) where fail s = WritingRCU $ \ _ -> Fail.fail s
− tests/hlint.hs
@@ -1,23 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Main (hlint)--- Copyright : (C) 2013-2015 Edward Kmett--- License : BSD-style (see the file LICENSE)--- Maintainer : Edward Kmett <ekmett@gmail.com>--- Stability : provisional--- Portability : portable------ This module runs HLint on the lens source tree.-------------------------------------------------------------------------------module Main where--import Control.Monad-import Language.Haskell.HLint-import System.Environment-import System.Exit--main :: IO ()-main = do- args <- getArgs- hints <- hlint $ ["src", "--cpp-define=HLINT", "--cpp-ansi"] ++ args- unless (null hints) exitFailure
unstable/Control/Concurrent/RCU/STM/Internal.hs view
@@ -1,9 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -84,10 +84,12 @@ WritingRCU m >>= f = WritingRCU $ \ c -> do a <- m c runWritingRCU (f a) c+#if !(MIN_VERSION_base(4,13,0)) fail = Fail.fail+#endif instance Fail.MonadFail (WritingRCU s) where- fail s = WritingRCU $ \ _ -> fail s+ fail s = WritingRCU $ \ _ -> error s instance Alternative (WritingRCU s) where empty = WritingRCU $ \ _ -> empty