diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -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`. diff --git a/examples/IncCounterExperiment.hs b/examples/IncCounterExperiment.hs --- a/examples/IncCounterExperiment.hs +++ b/examples/IncCounterExperiment.hs @@ -4,7 +4,7 @@ -- | -- Copyright : (C) 2015 Edward Kmett and Ted Cooper -- License : BSD-style (see the file LICENSE) --- Maintainer : Edward Kmett , +-- Maintainer : Edward Kmett , -- Ted Cooper -- 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] ] diff --git a/examples/ListInt.hs b/examples/ListInt.hs --- a/examples/ListInt.hs +++ b/examples/ListInt.hs @@ -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 diff --git a/examples/MoveString.hs b/examples/MoveString.hs --- a/examples/MoveString.hs +++ b/examples/MoveString.hs @@ -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 diff --git a/examples/TimeSynchronize.hs b/examples/TimeSynchronize.hs --- a/examples/TimeSynchronize.hs +++ b/examples/TimeSynchronize.hs @@ -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" ) - + diff --git a/rcu.cabal b/rcu.cabal --- a/rcu.cabal +++ b/rcu.cabal @@ -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 , Ted Cooper @@ -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 diff --git a/src/Control/Concurrent/RCU/Class.hs b/src/Control/Concurrent/RCU/Class.hs --- a/src/Control/Concurrent/RCU/Class.hs +++ b/src/Control/Concurrent/RCU/Class.hs @@ -6,7 +6,6 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# OPTIONS_HADDOCK not-home #-} ----------------------------------------------------------------------------- diff --git a/src/Control/Concurrent/RCU/GC/Internal.hs b/src/Control/Concurrent/RCU/GC/Internal.hs --- a/src/Control/Concurrent/RCU/GC/Internal.hs +++ b/src/Control/Concurrent/RCU/GC/Internal.hs @@ -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 diff --git a/src/Control/Concurrent/RCU/QSBR/Internal.hs b/src/Control/Concurrent/RCU/QSBR/Internal.hs --- a/src/Control/Concurrent/RCU/QSBR/Internal.hs +++ b/src/Control/Concurrent/RCU/QSBR/Internal.hs @@ -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 diff --git a/tests/hlint.hs b/tests/hlint.hs deleted file mode 100644 --- a/tests/hlint.hs +++ /dev/null @@ -1,23 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Main (hlint) --- Copyright : (C) 2013-2015 Edward Kmett --- License : BSD-style (see the file LICENSE) --- Maintainer : Edward Kmett --- 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 diff --git a/unstable/Control/Concurrent/RCU/STM/Internal.hs b/unstable/Control/Concurrent/RCU/STM/Internal.hs --- a/unstable/Control/Concurrent/RCU/STM/Internal.hs +++ b/unstable/Control/Concurrent/RCU/STM/Internal.hs @@ -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