uni-util 2.2.1.2 → 2.3.0.0
raw patch · 9 files changed
+175/−295 lines, 9 filesdep +parsec1dep ~parsec
Dependencies added: parsec1
Dependency ranges changed: parsec
Files
- Util/Binary.hs +117/−157
- Util/BinaryUtils.hs +9/−0
- Util/Computation.hs +12/−1
- Util/Dynamics.hs +1/−101
- Util/ICStringLen.hs +4/−1
- Util/Sources.hs +6/−0
- Util/Thread.hs +0/−15
- Util/ThreadDict.hs +15/−16
- uni-util.cabal +11/−4
Util/Binary.hs view
@@ -2,21 +2,21 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} --- | Library for converting types to and from binary, so that they can--- be written to and from files, stored compactly in memory, and so on.------ This is a preliminary version of the library, hence I have decided--- /not/ to optimise heavily, beyond putting in strictness annotations--- in where they seem appropriate.------ A good place to start optimising would probably be the separate--- "Bytes" libary.------ See also "BinaryInstances", which declares instances for the standard--- types (and one or two others), "BinaryUtils", which contains--- (mostly) material for declaring new instances, "BinaryExtras",--- which contains other miscellaneous utilities, and finally--- "BinaryAll" which just imports and reexports everything.+{- | Library for converting types to and from binary, so that they can+be written to and from files, stored compactly in memory, and so on.++This is a preliminary version of the library, hence I have decided+/not/ to optimise heavily, beyond putting in strictness annotations+in where they seem appropriate.++A good place to start optimising would probably be the separate+"Bytes" libary.++See also "BinaryInstances", which declares instances for the standard+types (and one or two others), "BinaryUtils", which contains+(mostly) material for declaring new instances, "BinaryExtras",+which contains other miscellaneous utilities, and finally+"BinaryAll" which just imports and reexports everything. -} module Util.Binary ( hWrite, -- :: HasBinary a IO => Handle -> a -> IO ()@@ -27,12 +27,12 @@ readFromBytes, -- :: HasBinary a StateBinArea => (Bytes,Int) -> IO a - HasBinary(..),- WriteBinary(..),- ReadBinary(..),+ HasBinary (..),+ WriteBinary (..),+ ReadBinary (..), - -- Ways of constructing WriteBinary/ReadBinary instances (not usually- -- required explicitly).+ {- Ways of constructing WriteBinary/ReadBinary instances (not usually+ required explicitly). -} toWriteBinaryHandle, -- :: Handle -> WriteBinary IO toReadBinaryHandle, -- :: Handle -> ReadBinary IO @@ -43,19 +43,19 @@ -- writing a BinArea -- create- mkEmptyBinArea, -- :: Int -> IO BinArea- -- pass as argument to writeBin- writeBinaryBinArea, -- :: WriteBinary StateBinArea- -- close and get contents.+ mkEmptyBinArea, {- :: Int -> IO BinArea+ pass as argument to writeBin -}+ writeBinaryBinArea, {- :: WriteBinary StateBinArea+ close and get contents. -} closeBinArea, -- :: BinArea -> IO (Bytes,Int) -- reading a BinArea -- create- mkBinArea, -- :: (Bytes,Int) -> BinArea- -- pass to things which read.- readBinaryBinArea, -- :: ReadBinary StateBinArea- -- check that the BinArea is completely read.+ mkBinArea, {- :: (Bytes,Int) -> BinArea+ pass to things which read. -}+ readBinaryBinArea, {- :: ReadBinary StateBinArea+ check that the BinArea is completely read. -} checkFullBinArea, -- :: BinArea -> IO () @@ -76,20 +76,20 @@ -- Our imports import Util.Bytes --- ------------------------------------------------------------------------- The general framework--- Type variable "m" is a monad; "a" is the thing to read or write.------ NB. Bytes values are currently not subject to the garbage-collector,--- and so need to be explicitly freed. The following rules for this--- should be observed.------ (1) For writeBytes, it is only guaranteed that the argument "Bytes"--- will be valid at the actual time of evaluation.--- (2) For readBytes, it is the caller's responsibility to free the returned--- area.--- ----------------------------------------------------------------------+{- ----------------------------------------------------------------------+The general framework+Type variable "m" is a monad; "a" is the thing to read or write. +NB. Bytes values are currently not subject to the garbage-collector,+and so need to be explicitly freed. The following rules for this+should be observed.++(1) For writeBytes, it is only guaranteed that the argument "Bytes"+will be valid at the actual time of evaluation.+(2) For readBytes, it is the caller's responsibility to free the returned+area.+---------------------------------------------------------------------- -}+ -- | A consumer of binary data data WriteBinary m = WriteBinary {@@ -114,13 +114,13 @@ readBin :: ReadBinary m -> m a -- ^ Given a source of binary data, provide an (a) --- ------------------------------------------------------------------------- Reading/Writing HasBinary instances to Handles.--- ----------------------------------------------------------------------+{- ----------------------------------------------------------------------+Reading/Writing HasBinary instances to Handles.+---------------------------------------------------------------------- -} -- | Write an (a) to a 'Handle' hWrite :: HasBinary a IO => Handle -> a -> IO ()-hWrite handle a = writeBin (toWriteBinaryHandle handle) a+hWrite handle = writeBin $ toWriteBinaryHandle handle -- | Read an (a) from a 'Handle'@@ -141,36 +141,12 @@ readBytes = hGetBytes handle } -toWriteBinaryHandleDebug :: Handle -> WriteBinary IO-toWriteBinaryHandleDebug handle =- WriteBinary {- writeByte = (\ b -> bracketDebug 1 (hPutByte handle b)),- writeBytes = (\ b i -> bracketDebug i (hPutBytes handle b i))- }--toReadBinaryHandleDebug :: Handle -> ReadBinary IO-toReadBinaryHandleDebug handle =- ReadBinary {- readByte = bracketDebug 1 (hGetByte handle),- readBytes = (\ i -> bracketDebug i (hGetBytes handle i))- }--bracketDebug :: Int -> IO a -> IO a-bracketDebug i act =- do- putStr ("[" ++ show i)- hFlush stdout- a <- act- putStr "]"- hFlush stdout- return a+{- ----------------------------------------------------------------------+Writing HasBinary instances to a memory area --- ------------------------------------------------------------------------- Writing HasBinary instances to a memory area------ We do this by allocating an area, and then doubling its size as--- necessary.--- ----------------------------------------------------------------------+We do this by allocating an area, and then doubling its size as+necessary.+---------------------------------------------------------------------- -} -- | Somewhere to where you write binary data in memory. data BinArea = BinArea {@@ -180,47 +156,46 @@ } -- | Write an (a) to memory. The 'Int' is the length of the area.-writeToBytes :: HasBinary a StateBinArea => a -> IO (Bytes,Int)+writeToBytes :: HasBinary a StateBinArea => a -> IO (Bytes, Int) writeToBytes = writeToBytes0 1000- -- Be generous, since memory is cheap. Make it a bit less than a power- -- of two, since some memory allocation algorithms (buddy algorithm)- -- like this.+ {- Be generous, since memory is cheap. Make it a bit less than a power+ of two, since some memory allocation algorithms (buddy algorithm)+ like this. -} --- | Write an (a) to memory.--- The integer argument is an initial guess at the number of bytes--- that will be needed. This should be greater than 0. If it is--- too small, there will be unnecessary reallocations; if too large,--- too much memory will be used.-writeToBytes0 :: HasBinary a StateBinArea => Int -> a -> IO (Bytes,Int)---+{- | Write an (a) to memory.+The integer argument is an initial guess at the number of bytes+that will be needed. This should be greater than 0. If it is+too small, there will be unnecessary reallocations; if too large,+too much memory will be used. -}+writeToBytes0 :: HasBinary a StateBinArea => Int -> a -> IO (Bytes, Int) -- The result is returned as a pair (data area,length) writeToBytes0 len0 a = do binArea0 <- mkEmptyBinArea len0- ((),binArea1) <- runStateT (writeBin writeBinaryBinArea a) binArea0+ ((), binArea1) <- runStateT (writeBin writeBinaryBinArea a) binArea0 closeBinArea binArea1 -- | Create an empty 'BinArea', given the initial size. mkEmptyBinArea :: Int -> IO BinArea -- the argument gives the initial size to use (which had better be positive).-mkEmptyBinArea len =+mkEmptyBinArea l = do- bytes <- bytesMalloc len- return (BinArea {- bytes = bytes,- len = len,+ bs <- bytesMalloc l+ return BinArea {+ bytes = bs,+ len = l, next = 0- })+ } -- | Return all the data currently in the 'BinArea'-closeBinArea :: BinArea -> IO (Bytes,Int)+closeBinArea :: BinArea -> IO (Bytes, Int) closeBinArea binArea = do let bytes1 = bytes binArea- len = next binArea- bytes2 <- bytesReAlloc bytes1 len- return (bytes2,len)+ l = next binArea+ bytes2 <- bytesReAlloc bytes1 l+ return (bytes2, l) -- | a state monad containing the BinArea. type StateBinArea = StateT BinArea IO@@ -228,31 +203,26 @@ -- | A 'BinArea' as somewhere to put binary data. writeBinaryBinArea :: WriteBinary StateBinArea writeBinaryBinArea = WriteBinary {- writeByte = (\ byte ->- StateT (\ binArea0 ->+ writeByte = \ byte ->+ StateT $ \ binArea0 -> do let next0 = next binArea0 next1 = next0 + 1 binArea1 <- ensureBinArea binArea0 next1 putByteToBytes byte (bytes binArea1) next0- return ((),binArea1 {next = next1})- )- ),- writeBytes = (\ bytes' len ->- StateT (\ binArea0 ->+ return ((), binArea1 {next = next1})+ , writeBytes = \ bytes' l ->+ StateT $ \ binArea0 -> do let next0 = next binArea0- next1 = next0 + len+ next1 = next0 + l binArea1 <- ensureBinArea binArea0 next1- putBytesToBytes bytes' 0 (bytes binArea1) next0 len- return ((),binArea1 {next = next1})- )- )+ putBytesToBytes bytes' 0 (bytes binArea1) next0 l+ return ((), binArea1 {next = next1}) } - -- | ensure that the given BinArea can hold at least len bytes. ensureBinArea :: BinArea -> Int -> IO BinArea ensureBinArea binArea size =@@ -262,36 +232,36 @@ else do let- len1 = 2*size+ len1 = 2 * size bytes1 <- bytesReAlloc (bytes binArea) len1- return (BinArea {+ return BinArea { bytes = bytes1, len = len1, next = next binArea- })+ } --- ------------------------------------------------------------------------- Reading Binary instances from a memory area--- We use BinArea's for this too. But this is simpler, because we don't have to--- worry about reallocing.--- ----------------------------------------------------------------------+{- ----------------------------------------------------------------------+Reading Binary instances from a memory area+We use BinArea's for this too. But this is simpler, because we don't have to+worry about reallocing.+---------------------------------------------------------------------- -} --- | Read a value from binary data in memory. The 'Int' is the length,--- and there will be an error if this is either too small or too large.-readFromBytes :: HasBinary a StateBinArea => (Bytes,Int) -> IO a-readFromBytes (bl@(bytes',len')) =+{- | Read a value from binary data in memory. The 'Int' is the length,+and there will be an error if this is either too small or too large. -}+readFromBytes :: HasBinary a StateBinArea => (Bytes, Int) -> IO a+readFromBytes bl = do let binArea0 = mkBinArea bl - (a,binArea1) <- runStateT (readBin readBinaryBinArea) binArea0+ (a, binArea1) <- runStateT (readBin readBinaryBinArea) binArea0 checkFullBinArea binArea1 return a --- | Turn binary data in memory into a 'BinArea' (so that you can--- read from it).-mkBinArea :: (Bytes,Int) -> BinArea-mkBinArea (bytes',len') =+{- | Turn binary data in memory into a 'BinArea' (so that you can+read from it). -}+mkBinArea :: (Bytes, Int) -> BinArea+mkBinArea (bytes', len') = BinArea { bytes = bytes', len = len',@@ -300,67 +270,57 @@ checkFullBinArea :: BinArea -> IO () checkFullBinArea binArea =- if next binArea == len binArea- then- return ()- else+ unless (next binArea == len binArea) $ error "Binary.checkFullBinArea: mysterious extra bytes" -- | A BinArea as a source of binary data. readBinaryBinArea :: ReadBinary StateBinArea readBinaryBinArea = ReadBinary {- readByte = StateT (\ binArea0 ->+ readByte = StateT $ \ binArea0 -> do let next0 = next binArea0 next1 = next0 + 1 checkBinArea binArea0 next1 byte <- getByteFromBytes (bytes binArea0) next0- return (byte,binArea0 {next = next1})- ),- readBytes = (\ len ->- StateT (\ binArea0 ->+ return (byte, binArea0 {next = next1})+ , readBytes = \ l ->+ StateT $ \ binArea0 -> do let next0 = next binArea0- next1 = next0 + len+ next1 = next0 + l checkBinArea binArea0 next1- bytes' <- bytesMalloc len- putBytesToBytes (bytes binArea0) next0 bytes' 0 len- return (bytes',binArea0 {next = next1})- )- )+ bytes' <- bytesMalloc l+ putBytesToBytes (bytes binArea0) next0 bytes' 0 l+ return (bytes', binArea0 {next = next1}) } checkBinArea :: BinArea -> Int -> IO () -- check that the given BinArea can hold at least len bytes. checkBinArea binArea newNext =- if newNext > len binArea- then+ when (newNext > len binArea) $ error "Binary.checkBinArea - BinArea overflow on read"- else- return () --- ------------------------------------------------------------------------- Lifting writeBinary and readBinary instances.--- ----------------------------------------------------------------------+{- ----------------------------------------------------------------------+Lifting writeBinary and readBinary instances.+---------------------------------------------------------------------- -} -- | Transform the monad used by a 'WriteBinary' liftWriteBinary :: (forall a . m a -> n a) -> WriteBinary m -> WriteBinary n-liftWriteBinary lift wb =+liftWriteBinary lft wb = let- writeByte2 b = lift (writeByte wb b)- writeBytes2 b i = lift (writeBytes wb b i)+ writeByte2 b = lft (writeByte wb b)+ writeBytes2 b i = lft (writeBytes wb b i) in- WriteBinary {writeByte = writeByte2,writeBytes = writeBytes2}+ WriteBinary {writeByte = writeByte2, writeBytes = writeBytes2} -- | Transform the monad used by a 'ReadBinary' liftReadBinary :: (forall a . m a -> n a) -> ReadBinary m -> ReadBinary n-liftReadBinary lift rb =+liftReadBinary lft rb = let- readByte2 = lift (readByte rb)- readBytes2 i = lift (readBytes rb i)+ readByte2 = lft (readByte rb)+ readBytes2 i = lft (readBytes rb i) in- ReadBinary {readByte = readByte2,readBytes = readBytes2}-+ ReadBinary {readByte = readByte2, readBytes = readBytes2}
Util/BinaryUtils.hs view
@@ -68,6 +68,7 @@ import System.IO(Handle) -- GHC imports+import Control.Applicative import Control.Monad.Trans -- our imports@@ -142,6 +143,14 @@ fn2 arg = fmap mapFn (fn arg) in ArgMonad fn2++instance Applicative m => Applicative (ArgMonad arg m) where+ pure v = ArgMonad (const (pure v))+ ArgMonad fn1 <*> ArgMonad fn2 =+ let+ fn arg = fn1 arg <*> fn2 arg+ in+ ArgMonad fn instance Monad m => Monad (ArgMonad arg m) where (>>=) (ArgMonad fn1) getArgMonad =
Util/Computation.hs view
@@ -105,6 +105,7 @@ ) where +import Control.Applicative import Control.Monad import Control.Exception@@ -301,6 +302,10 @@ Value a -> Value (aToB a) Error e -> Error e +instance Applicative WithError where+ pure = return+ (<*>) = ap+ instance Monad WithError where return v = hasValue v (>>=) aWE toBWe =@@ -309,6 +314,13 @@ newtype MonadWithError m a = MonadWithError (m (WithError a)) +instance Monad m => Functor (MonadWithError m) where+ fmap f (MonadWithError a) = MonadWithError $ liftM (fmap f) a++instance Monad m => Applicative (MonadWithError m) where+ pure = return+ (<*>) = ap+ instance Monad m => Monad (MonadWithError m) where return v = MonadWithError (return (Value v)) (>>=) (MonadWithError act1) getAct2 =@@ -400,4 +412,3 @@ infixr 0 $$ -- This makes $$ have fixity like $.-
Util/Dynamics.hs view
@@ -20,20 +20,7 @@ typeMismatch, dynCast, -- Cast to another value of the same type, or -- error (useful for extracting from existential types).- dynCastOpt,-- mkTypeRep,- -- :: String -> String -> TypeRep-- -- Flavours of Typeable we need not already in Data.Typeable.- -- The only customer for these at the moment seems to be- -- types/DisplayView.hs- Typeable1_1(..),- Typeable2_11(..),- Typeable3_111(..),- Typeable4_0111(..),- Typeable5_00111(..),- Typeable6_000111(..),+ dynCastOpt ) where @@ -89,90 +76,3 @@ dynCastOpt :: (Typeable a,Typeable b) => a -> Maybe b dynCastOpt = Data.Dynamic.cast---- | Construct a TypeRep for a type or type constructor with no arguments.--- The first string should be the module name, the second that of the type.-mkTypeRep :: String -> String -> TypeRep-mkTypeRep s1 s2 = mkTyConApp (mkTyCon (s1 ++ "." ++ s2)) []---- --------------------------------------------------------------- Flavours of Typeable we need not already in Data.Typeable.--- The only customer for these at the moment seems to be--- types/DisplayView.hs--- --------------------------------------------------------------class Typeable1_1 ty where- typeOf1_1 :: Typeable1 typeArg => ty typeArg -> TypeRep--instance (Typeable1_1 ty,Typeable1 typeArg) => Typeable (ty typeArg) where- typeOf (x :: ty typeArg) = (typeOf1_1 x) `mkAppTy` typeOf v- where- v :: typeArg ()- v = error "Dynamics.31"--class Typeable2_11 ty where- typeOf2_11 :: (Typeable1 typeArg1,Typeable1 typeArg2)- => ty typeArg1 typeArg2 -> TypeRep--instance (Typeable2_11 ty,Typeable1 typeArg1)- => Typeable1_1 (ty typeArg1) where- typeOf1_1 (x :: ty typeArg1 typeArg2) =- (typeOf2_11 x) `mkAppTy` (typeOf1 v)- where- v :: typeArg1 ()- v = error "Dynamics.23"--class Typeable3_111 ty where- typeOf3_111 :: (Typeable1 typeArg1,Typeable1 typeArg2,Typeable1 typeArg3)- => ty typeArg1 typeArg2 typeArg3 -> TypeRep--instance (Typeable3_111 ty,Typeable1 typeArg1)- => Typeable2_11 (ty typeArg1) where- typeOf2_11 (x :: ty typeArg1 typeArg2 typeArg3) =- (typeOf3_111 x) `mkAppTy` (typeOf1 v)- where- v :: typeArg1 ()- v = error "Dynamics.23"--class Typeable4_0111 ty where- typeOf4_0111- :: (Typeable ty1,- Typeable1 typeArg1,Typeable1 typeArg2,Typeable1 typeArg3)- => ty ty1 typeArg1 typeArg2 typeArg3 -> TypeRep--instance (Typeable4_0111 ty,Typeable ty1)- => Typeable3_111 (ty ty1) where- typeOf3_111 (x :: ty ty1 typeArg2 typeArg3 typeArg4) =- (typeOf4_0111 x) `mkAppTy` (typeOf v)- where- v :: ty1- v = error "Dynamics.23"--class Typeable5_00111 ty where- typeOf5_00111- :: (Typeable ty1,Typeable ty2,- Typeable1 typeArg1,Typeable1 typeArg2,Typeable1 typeArg3)- => ty ty1 ty2 typeArg1 typeArg2 typeArg3 -> TypeRep--instance (Typeable5_00111 ty,Typeable ty1)- => Typeable4_0111 (ty ty1) where- typeOf4_0111 (x :: ty ty1 ty2 typeArg1 typeArg2 typeArg3) =- (typeOf5_00111 x) `mkAppTy` (typeOf v)- where- v :: ty1- v = error "Dynamics.23"--class Typeable6_000111 ty where- typeOf6_000111- :: (Typeable ty1,Typeable ty2,Typeable ty3,- Typeable1 typeArg1,Typeable1 typeArg2,Typeable1 typeArg3)- => ty ty1 ty2 ty3 typeArg1 typeArg2 typeArg3 -> TypeRep--instance (Typeable6_000111 ty,Typeable ty1)- => Typeable5_00111 (ty ty1) where- typeOf5_00111 (x :: ty ty1 ty2 ty3 typeArg1 typeArg2 typeArg3) =- (typeOf6_000111 x) `mkAppTy` (typeOf v)- where- v :: ty1- v = error "Dynamics.23"-
Util/ICStringLen.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-} -- | This module provides immutable CStrings, which additionally have -- the property that they are automatically freed when the garbage-collector@@ -43,6 +44,9 @@ import System.IO.Unsafe import Foreign.C.String import Foreign.ForeignPtr+#if __GLASGOW_HASKELL__ > 706+import Foreign.ForeignPtr.Unsafe+#endif import Foreign.Marshal.Array import Foreign.Marshal.Alloc import Foreign.C.Types@@ -205,4 +209,3 @@ do bl <- writeToBytes a bytesToICStringLen bl-
Util/Sources.hs view
@@ -160,7 +160,9 @@ import Data.Maybe +import Control.Applicative import Control.Concurrent+import Control.Monad import Data.IORef import Util.ExtendedPrelude(HasMapIO(..))@@ -706,6 +708,10 @@ source2 = seqSourceIO source1 getSource in SimpleSource source2++instance Applicative SimpleSource where+ pure = return+ (<*>) = ap instance Monad SimpleSource where return x = SimpleSource (staticSource x)
Util/Thread.hs view
@@ -9,8 +9,6 @@ ThreadId, - hashThreadId, -- :: ThreadId -> Int32- -- thread creation forkIODebug, -- :: IO () -> IO ThreadId@@ -58,7 +56,6 @@ import Control.Exception import Control.Concurrent import Control.Monad-import Data.HashTable import Data.Int import Util.Computation@@ -217,15 +214,3 @@ mapMConcurrent_ :: (a -> IO ()) -> [a] -> IO () mapMConcurrent_ mapFn as = mapM_ (\ a -> forkIO (mapFn a)) as----- ----------------------------------------------------------------------------- hashThreadId--- ----------------------------------------------------------------------------hashThreadId :: ThreadId -> Int32--- Currently implemented by a horrible hack requiring access to GHC internals.-hashThreadId (GHC.Conc.ThreadId ti) = hashInt (getThreadId ti)--foreign import ccall unsafe "rts_getThreadId" getThreadId- :: GHC.Base.ThreadId# -> Int
Util/ThreadDict.hs view
@@ -7,46 +7,45 @@ modifyThreadDict, -- :: ThreadDict a -> (Maybe a -> IO (Maybe a,b)) -> IO b ) where -import Data.HashTable import Control.Concurrent -import Util.Thread+import qualified Data.Map as Map+import Data.IORef -- ------------------------------------------------------------------------- -- Data types -- ------------------------------------------------------------------------- -newtype ThreadDict a = ThreadDict (HashTable ThreadId a)+newtype ThreadDict a = ThreadDict (IORef (Map.Map ThreadId a)) -- ------------------------------------------------------------------------- -- Functions -- ------------------------------------------------------------------------- newThreadDict :: IO (ThreadDict a)-newThreadDict =- do- table <- new (==) hashThreadId- return (ThreadDict table)+newThreadDict = do+ m <- newIORef Map.empty+ return (ThreadDict m) writeThreadDict :: ThreadDict a -> a -> IO () writeThreadDict (ThreadDict table) a = do ti <- myThreadId- insert table ti a+ atomicModifyIORef table $ \ m -> (Map.insert ti a m, ()) readThreadDict :: ThreadDict a -> IO (Maybe a) readThreadDict (ThreadDict table) = do ti <- myThreadId- Data.HashTable.lookup table ti+ m <- readIORef table+ return $ Map.lookup ti m -modifyThreadDict :: ThreadDict a -> (Maybe a -> IO (Maybe a,b)) -> IO b+modifyThreadDict :: ThreadDict a -> (Maybe a -> IO (Maybe a, b)) -> IO b modifyThreadDict (ThreadDict table) updateFn = do ti <- myThreadId- aOpt0 <- Data.HashTable.lookup table ti- (aOpt1,b) <- updateFn aOpt0- case aOpt1 of- Nothing -> delete table ti- Just a -> insert table ti a- return b+ m <- readIORef table+ (aOpt1, b) <- updateFn $ Map.lookup ti m+ atomicModifyIORef table $ \ im -> ((case aOpt1 of+ Nothing -> Map.delete ti+ Just a -> Map.insert ti a) im, b)
uni-util.cabal view
@@ -1,5 +1,5 @@ name: uni-util-version: 2.2.1.2+version: 2.3.0.0 build-type: Simple license: LGPL license-file: LICENSE@@ -23,6 +23,10 @@ description: add debug traces default: False +flag parsec1+ Description: Use parsec1+ Default: True+ library exposed-modules: Util.Huffman, Util.CompileFlags, Util.Queue,@@ -44,16 +48,19 @@ include-dirs: include c-sources: new_object.c, default_options.c - build-depends: base >= 4 && < 5, parsec < 3.2, mtl, directory,+ build-depends: base >= 4 && < 5, mtl, directory, network, containers, bytestring, array, old-time if flag(base4) build-depends: ghc-prim + if flag(parsec1)+ build-depends: parsec1+ else+ build-depends: parsec+ if flag(debug) cpp-options: -DDEBUG if os(windows) cpp-options: -DWINDOWS-- ghc-options: -fwarn-unused-imports -fno-warn-warnings-deprecations