[Haskell-cafe] Locking, unsafePerformIO and bolt-on thread safety.
Jason Dusek
jason.dusek at gmail.com
Tue May 10 02:45:20 CEST 2011
A friend is making bindings to a C library that offers some
fast math operations. The normal way to use the library is
like this:
int a = ...; int b = ...; int c = ...; int d = ...;
int x = ...;
int m, n;
create_lookup_table(x);
m = perform_math(a, b, x);
n = perform_math(c, d, x);
We see that the lookup table for x must be created before we
can perform math in the field/ring/what-have-you defined by x.
Once we have created the table, though, we're done.
My friend would like to create a pure interface to this
library. One thought was to write an interface to perform_math
that checked if the table was created, created it if not, and
did all this while locking an MVar so that no other instance
could be called at the same time, trashing the table. Doing
this behind unsafePerformIO would seem to be the ticket.
We end up with an implementation like this:
module FastMath where
import Control.Concurrent
import Foreign
import Foreign.C
foreign import ccall create_lookup_table :: CInt -> IO ()
foreign import ccall perform_math :: CInt -> CInt -> CInt -> IO CInt
masterLock = unsafePeformIO (newMVar [CInt])
safe_perform_math a b x = do
list <- takeMVar masterLock
toPut <- if not (x `elem` list)
then do create_lookup_table x
return (x:list)
else return list
result <- perform_math a b x
putMVar masterLock toPut
return result
performMath a b x = unsafePerformIO (safe_perform_math a b x)
This does not compile but I think it gets the point across. Is
this approach safe? The unsafePerformIO in conjunction with
locking has me worried.
--
Jason Dusek
() ascii ribbon campaign - against html e-mail
/\ www.asciiribbon.org - against proprietary attachments
More information about the Haskell-Cafe
mailing list