cfuture 1.0 → 2.0

raw patch · 5 files changed

+92/−85 lines, 5 filesdep ~cfuturePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: cfuture

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• cfuture.cabal +15/−10
• src/Control/Concurrent/CFuture.hs +64/−71
• test/HsTestCase.hs +4/−3
• test/OurTasks.hs +3/−1

@@ -3,3 +3,9 @@ ## 1.0 -- 2025-04-21  * First version, with a foreign library and a test suite already.++## 2.0 -- 2026-03-19++* Switched to Maybe results instead of exceptions wrapped into a Left.+* Changed type signature of forkFutureC to be similar to the others.+* Simplified the code and added more explanations to the documentation.

@@ -1,16 +1,21 @@ cabal-version:      3.0 name:               cfuture-version:            1.0-synopsis: A Future type that is easy to represent and handle in C/C++.+version:            2.0+synopsis: A Future type that is interruptible anytime and exportable to C/C++. description:    A module similar to the "future" package of Chris Kuklewicz,-   but having a Future that is easy to represent and handle-   in C/C++,-   using two MVars.-   Moreover, it uses two new threads:-   one (the "watcher thread") aborts the calculation-   if triggered by filling the first MVar.+   but having a Future that is interruptible anytime,+   and easy to represent and handle+   in C/C++. +   It uses two threads,+   the first of which kills the calculation+   if triggered by filling an MVar,+   and the second of which calculating the result+   and writing it into another MVar.+   However, the library can be used+   without manipulating the MVars directly.+ license:            BSD-3-Clause license-file:       LICENSE author:             Viktor Csimma@@ -22,7 +27,7 @@     ghc-options: -Wall source-repository head   type:     git-  location: git://github.com/viktorcsimma/cfuture.git+  location: https://github.com/viktorcsimma/cfuture.git  library     import:           warnings@@ -42,7 +47,7 @@     other-modules:    Control.Concurrent.CFuture     build-depends:    base >=4.17.2 && < 5,                       base-prelude >= 1.4 && < 1.7,-                      cfuture >= 1.0 && < 1.1+                      cfuture >= 2.0 && < 3      hs-source-dirs:   src     c-sources:        csrc/CFuture.c

@@ -1,69 +1,66 @@--- | A Future type that is easy to represent and handle--- in C\/C++,--- using two 'MVar's.--- Moreover, it uses two new threads:--- one (the "watcher thread") aborts the calculation--- if triggered by filling the first 'MVar'.+-- | Defines a type similar to C++ futures,+-- that can be passed to C and used+-- to interrupt asynchronous calls+-- or to get their results.+--+-- From within Haskell, you can use+-- 'forkFuture' to start a calculation,+-- 'get' to wait on it+-- and 'abort' to abort it.+--+-- From C, interruption happens+-- via calling a C-native FFI function,+-- without the cost of a full FFI call.+-- See the C source for more information.+{-# LANGUAGE ScopedTypeVariables #-} module Control.Concurrent.CFuture-  (Future, FutureResult, CFuturePtr,+  (Future, CFuturePtr,    forkFuture, writeFutureC, forkFutureC,-   safeGet, get, getC, waitC, abort)+   get, getC, waitC, abort)   where  import Foreign.Ptr import Foreign.StablePtr import Foreign.Storable import Control.Concurrent-import Control.Exception(throw, toException, SomeException) import BasePrelude (PrimMVar, newStablePtrPrimMVar,                     Int8, Int16, Int32, Int64,                     Word8, Word16, Word32, Word64) --- | An exception is thrown--- if the Future has been aborted.-type FutureResult a = Either SomeException a+                    -- | A C pointer to a C array of two 'StablePtr's.+                    -- freeing the pointers is possible+                    -- via hs_free_stable_ptr --- | A C pointer to a C array of two 'StablePtr's.+-- | Gets translated to HsStablePtr* (i.e. void**) in C. type CFuturePtr = Ptr (StablePtr PrimMVar) --- | A type similar to C++ futures,--- that can be passed to C and used--- to interrupt asynchronous calls--- or to get their results.------ From within Haskell, you can use--- 'forkFuture' to start a calculation,--- 'safeGet' or 'get' to wait on it--- and 'abort' to abort it.------ From C, interruption happens--- via calling hs_try_putmvar--- on the first 'StablePtr';--- freeing the pointers is possible--- via hs_free_stable_ptr ----- all these without the cost of an FFI call.--data Future a = MkFuture -  (MVar ())                -- interruption: fill it to interrupt the calculation-  (MVar (FutureResult a))  -- result:       where the result or the exception will be put+-- | An object representing an asynchronous calculation.+-- Filling the first MVar activates a thread that aborts the calculation+-- and writes Nothing to the other MVar+-- (which would otherwise contain the result).+-- It is recommended not to manipulate the MVars directly,+-- but to use the functions in the library instead.+data Future a = MkFuture+  (MVar ())           -- ^ For interruption: fill it to interrupt the calculation.+  (MVar (Maybe a))    -- ^ For the result: Nothing if it has been aborted, Just otherwise.  -- | Starts an asynchronous calculation -- and returns a 'Future' to it. forkFuture :: IO a -> IO (Future a) forkFuture action = do   intMVar <- (newEmptyMVar :: IO (MVar ()))-  resMVar <- (newEmptyMVar :: IO (MVar (FutureResult a)))+  resMVar <- (newEmptyMVar :: IO (MVar (Maybe a)))    -- The thread doing the actual calculation.   -- It also wakes up the watcher thread.-  calculationThreadId <- forkIO $ (putMVar resMVar =<< (Right <$> action)) >> putMVar intMVar ()+  calculationThreadId <- forkIO $ (putMVar resMVar . Just =<< action) >> putMVar intMVar () -  -- The thread killing the calculation thread if woken up.+  -- The "watcher thread", killing the calculation thread if woken up.   _ <- forkIO $ do     -- this is activated if intMVar gets filled     readMVar intMVar     killThread calculationThreadId-    putMVar resMVar (Left (toException (userError "Calculation aborted")))+    putMVar resMVar Nothing    return $ MkFuture intMVar resMVar @@ -103,56 +100,52 @@ -- -- Note: it is the responsibility of the C side -- to free the 'StablePtr's.-forkFutureC :: IO a -> CFuturePtr -> IO ()-forkFutureC action ptr = writeFutureC ptr =<< forkFuture action+forkFutureC :: CFuturePtr -> IO a -> IO ()+forkFutureC ptr action = writeFutureC ptr =<< forkFuture action --- | Reads the result from the 'Future'--- but does not check whether there has been an exception--- wrapped into a 'Left'.+-- | Reads the result from the 'Future'. -- This is a blocking call,--- waiting for the result until it is ready.-safeGet :: Future a -> IO (FutureResult a)-safeGet (MkFuture _ resMVar) = readMVar resMVar+-- waiting for the result (or the 'Nothing' signalling interruption)+-- until it is ready.+get :: Future a -> IO (Maybe a)+get (MkFuture _ resMVar) = readMVar resMVar --- | Similar to 'safeGet', but checks whether we have an exception--- and rethrows it if yes;--- returning the plain result otherwise.--- This is a blocking call,--- waiting for the result until it is ready.-get :: Future a -> IO a-get future = safeGet future >>= either throw return+-- | A helper function to 'getC' and 'waitC',+-- expecting a function which we are going to do with the result.+-- Not meant to be used directly.+getCHelper :: CFuturePtr -> (a -> IO ()) -> IO Bool+getCHelper futurePtr doOnCompletion = do+  -- we assume both StablePtrs are of the same size,+  -- which should be in a sane world+  resMVarSPtr <- peekElemOff (castPtr futurePtr :: Ptr (StablePtr (MVar (Maybe a)))) 1+  result <- readMVar =<< deRefStablePtr resMVarSPtr+  case result of+        Just a  -> doOnCompletion a >> return True+        _       -> return False  -- we don't run 'doOnCompletion' in this case + -- | A variant of 'get' to call from C -- which writes the result to the memory location -- defined by the pointer.--- If there is an exception instead of a result,+-- If there is 'Nothing' instead of a result, -- it writes nothing to the pointer -- and returns 'False'; -- on success, it returns 'True'.+--+-- Note: do _not_ call this on a freed 'Future'+-- (the abortC function of the C side frees it). getC :: Storable a => CFuturePtr -> Ptr a -> IO Bool-getC futurePtr destPtr = do-  -- we assume both StablePtrs are of the same size-  resMVarSPtr <- peekElemOff (castPtr futurePtr :: Ptr (StablePtr (MVar (FutureResult a)))) 1-  -- we catch the exception-  -- as C/C++ could not handle it-  result <- readMVar =<< deRefStablePtr resMVarSPtr-  case result of-    Right a -> poke destPtr a >> return True-    _       -> return False+getC futurePtr destPtr = getCHelper futurePtr (poke destPtr)  -- | Only waits until the calculation gets finished; -- then returns 'True' if it was successful and 'False' otherwise. -- To be called from C.+-- Differs from 'getC' in that it ignores the result.+--+-- Note: do _not_ call this on a freed 'Future'+-- (the abortC function of the C side frees it). waitC :: CFuturePtr -> IO Bool-waitC ptr = do-  -- we assume both StablePtrs are of the same size-  resMVarSPtr <- peekElemOff (castPtr ptr :: Ptr (StablePtr (MVar (Either String ())))) 1-  -- we catch the exception and return an illegal value-  -- in order to unblock a C++ thread waiting for the result-  result <- readMVar =<< deRefStablePtr resMVarSPtr-  case result of-    Right _ -> return True-    _       -> return False+waitC futurePtr = getCHelper futurePtr $ const $ return ()  -- Finally, the foreign export declarations: -- this is quite ugly, but c'est la vie.

@@ -5,6 +5,7 @@ import Control.Concurrent (threadDelay) import OurTasks +-- | Called from main.c. hsTestCase :: IO Bool hsTestCase = do   print "Working"@@ -13,11 +14,11 @@   threadDelay 2000000   _ <- abort future   print "Aborted"-  result <- safeGet future+  result <- get future   -- it should be an exception   case result of-    Left _ -> return True-    _      -> return False+    Nothing  -> return True -- the expected result+    _        -> return False  foreign export ccall hsTestCase :: IO Bool 

@@ -2,6 +2,8 @@ import Control.Concurrent.CFuture import Control.Concurrent (threadDelay) +-- |+-- The task used as an example. task :: IO Int task = sum <$> mapM subtask [1..10]   where@@ -12,5 +14,5 @@     return $ 2 * n  cFunction :: CFuturePtr -> IO ()-cFunction = forkFutureC task+cFunction ptr = forkFutureC ptr task foreign export ccall cFunction :: CFuturePtr -> IO ()