value-supply 0.1 → 0.2

raw patch · 2 files changed

+12/−17 lines, 2 files

Files

• Data/Supply.hs +11/−16
• value-supply.cabal +1/−1

@@ -34,10 +34,9 @@   , split4   ) where --- Using 'MVar's might be a bit heavy but it ensures that--- multiple threads that share a supply will get distinct names.-import Control.Concurrent.MVar-import System.IO.Unsafe(unsafePerformIO)+-- Usinga an IORef is thread-safe because we update it with 'atomicModifyIORef'.+import Data.IORef+import System.IO.Unsafe(unsafeInterleaveIO)  -- Basics ---------------------------------------------------------------------- @@ -66,20 +65,16 @@ -- the first argument is an initial value, the -- second specifies how to generate a new value from an existing one. newSupply    :: a -> (a -> a) -> IO (Supply a)-newSupply x f = fmap (gen True) (newMVar (iterate f x))--  -- The extra argument to ``gen'' is passed because without-  -- it Hugs spots that the recursive calls are the same but does-  -- not know that unsafePerformIO is unsafe.-  where gen _ r = Node { supplyValue  = unsafePerformIO (genSym r),-                         supplyLeft   = gen False r,-                         supplyRight  = gen True r }+newSupply x f = gen =<< newIORef (iterate f x) -        genSym       :: MVar [a] -> IO a-        genSym r      = do a : as <- takeMVar r-                           putMVar r as-                           return a+  where gen r = do v <- unsafeInterleaveIO (genSym r)+                   ls <- unsafeInterleaveIO (gen r)+                   rs <- unsafeInterleaveIO (gen r)+                   return (Node v ls rs) +        genSym       :: IORef [a] -> IO a+        genSym r      = atomicModifyIORef r (\(a:as) -> (as,a))+                            -- | Generate a new supply by systematically applying a function -- to an existing supply.  This function, together with 'supplyValue' -- form a comonad on 'Supply'.

@@ -1,5 +1,5 @@ Name:           value-supply-Version:        0.1+Version:        0.2 License:        BSD3 License-file:   LICENSE Author:         Iavor S. Diatchki