monad-atom 0.3.0 → 0.4.0
raw patch · 3 files changed
+130/−94 lines, 3 filesdep +ghc-primdep −bytestringdep −cereal
Dependencies added: ghc-prim
Dependencies removed: bytestring, cereal
Files
- Control/Monad/Atom.hs +117/−85
- LICENSE +1/−1
- monad-atom.cabal +12/−8
Control/Monad/Atom.hs view
@@ -1,112 +1,144 @@-{-# LANGUAGE GeneralizedNewtypeDeriving - , NoMonomorphismRestriction +{-# LANGUAGE GeneralizedNewtypeDeriving+ , NoMonomorphismRestriction+ , MultiParamTypeClasses+ , TypeFamilies+ , FlexibleInstances+ , FlexibleContexts+ , DeriveGeneric , BangPatterns #-}+-- | The Atom monad provides functions which convert objects to unique+-- atoms (represented as Ints). Example:+--+-- > example = evalAtom $ do+-- > xs <- mapM toAtom "abcabd"+-- > zs <- mapM fromAtom xs+-- > return $ zip zs xs+--+-- >>> example+-- >>> [('a',0),('b',1),('c',2),('a',0),('b',1),('d',3)]+ module Control.Monad.Atom- ( MonadAtom (..)- , AtomTable+ ( AtomTable , Atom- , AtomT+ , toAtom+ , fromAtom+ , maybeToAtom , empty , evalAtom- , evalAtomT , runAtom- , runAtomT- , atoms+ , mapping ) where import Control.Monad.State import Control.Monad.Identity import qualified Data.Map as Map import qualified Data.IntMap as IntMap-import qualified Data.Serialize as Serialize-import Data.Serialize (Serialize)-import qualified Data.ByteString as Strict--type Blob = Strict.ByteString--data AtomTable = T { lastID :: {-# UNPACK #-} !Int - , to :: Map.Map Blob Int - , from :: IntMap.IntMap Blob } - ---instance Serialize AtomTable where- put t = do Serialize.put (lastID t) - Serialize.put (to t)- Serialize.put (from t)- get = do liftM3 T Serialize.get Serialize.get Serialize.get-+import GHC.Generics (Generic) -class Monad m => MonadAtom m where- -- | Monadically convert the argument into an atom (represented as an Int)- toAtom :: Serialize a => a -> m Int- -- | Monadically convert the argument into an atom, but only if - -- the corresponding atom has already been created- maybeToAtom :: Serialize a => a -> m (Maybe Int)- -- | Monadically convert an atom represented as an Int to its - -- corresponding object- fromAtom :: Serialize a => Int -> m a+-- | @AtomTable@ holds the state necessary for converting to and from+-- @Int@s.+data AtomTable a = T { lastID :: {-# UNPACK #-} !Int+ , to :: !(Map.Map a Int)+ , from :: !(IntMap.IntMap a) }+ deriving (Generic) -instance Monad m => MonadAtom (AtomT m) where- toAtom x = AtomT $ do- let b = enc x- t <- get- case Map.lookup b (to t) of- Just j -> return $! j- Nothing -> do - let i = lastID t- i' = i + 1 - !t' = t { lastID = i'- , to = Map.insert b i (to t) - , from = IntMap.insert i b (from t) }- put t'- return $! lastID t-- maybeToAtom x = - AtomT $ do- t <- get- return . Map.lookup (enc x) . to $ t- - fromAtom i = AtomT $ do- t <- get- return . dec $ (from t) IntMap.! i--table = AtomT get+-- | @AtomT@ is a specialized state monad transformer for converting+-- to and from @Int@s.+newtype AtomT a m r = AtomT (StateT (AtomTable a) m r)+ deriving (Functor, Monad, MonadTrans, MonadIO)+-- | @Atom@ is a specialized state monad for converting to and from+-- @Int@s.+newtype Atom a r = Atom (AtomT a Identity r)+ deriving (Functor, Monad) -empty :: AtomTable-empty = T 0 Map.empty IntMap.empty+class (Monad m) => MonadAtom m where+ type Key m+ -- | @toAtom x@ converts @x@ to a unique @Int@ in the @Atom@ monad+ toAtom :: Key m -> m Int+ -- | @maybeToAtom x@ converts @x@ to a unique @Int@ in the @Atom@+ -- monad only if @x@ already has a corresponding @Int@+ maybeToAtom :: Key m -> m (Maybe Int)+ -- | @fromAtom i@ converts the @Int@ @i@ to its corresponding object+ -- in the Atom monad.+ fromAtom :: Int -> m (Key m)+instance (Ord a, Monad m) => MonadAtom (AtomT a m) where+ type Key (AtomT a m) = a+ toAtom = AtomT . toAtom'+ {-# INLINE toAtom #-}+ maybeToAtom = AtomT . maybeToAtom'+ {-# INLINE maybeToAtom #-}+ fromAtom = AtomT . fromAtom'+ {-# INLINE fromAtom #-}+instance (Ord a) => MonadAtom (Atom a) where+ type Key (Atom a) = a+ toAtom = Atom . toAtom+ {-# INLINE toAtom #-}+ maybeToAtom = Atom . maybeToAtom+ {-# INLINE maybeToAtom #-}+ fromAtom = Atom . fromAtom+ {-# INLINE fromAtom #-} -runAtomT :: AtomT t t1 -> AtomTable -> t (t1, AtomTable)-runAtomT (AtomT x) s = runStateT x s+-- | @runAtomT c s@ runs computation c in the AtomT monad transformer+-- with the initial @AtomTable@ s.+runAtomT :: (Ord a, Monad m) => AtomT a m r -> AtomTable a -> m (r, AtomTable a)+runAtomT (AtomT x) = runStateT x +{-# INLINE runAtomT #-} -runAtom :: Atom t -> AtomTable -> (t, AtomTable)+-- | @runAtom c s@ runs computation c in the Atom monad with the+-- initial @AtomTable@ s.+runAtom :: (Ord a) => Atom a r -> AtomTable a -> (r, AtomTable a) runAtom (Atom x) s = runIdentity (runAtomT x s)+{-# INLINE runAtom #-} +-- | @evalAtomT c@ runs computation c in the AtomT monad transformer+-- with the empty initial @AtomTable@.+evalAtomT :: (Ord a, Monad m) => AtomT a m r -> m r+evalAtomT (AtomT x) = evalStateT x empty+{-# INLINE evalAtomT #-} -evalAtom :: Atom t -> t-evalAtom = fst . flip runAtom empty+-- | @evalAtom c@ runs computation c in the Atom monad with the empty+-- initial @AtomTable@.+evalAtom :: (Ord a) => Atom a r -> r+evalAtom (Atom x) = runIdentity (evalAtomT x)+{-# INLINE evalAtom #-} -evalAtomT :: (Monad m) => AtomT m a -> m a-evalAtomT = liftM fst . flip runAtomT empty+toAtom' :: (Monad m, Ord a) => a -> StateT (AtomTable a) m Int+toAtom' x = do+ let b = x+ t <- get+ case Map.lookup b (to t) of+ Just j -> return $! j+ Nothing -> do+ let i = lastID t+ i' = i + 1+ !t' = t { lastID = i'+ , to = Map.insert b i (to t)+ , from = IntMap.insert i b (from t) }+ put $! t'+ return $! lastID t+{-# SPECIALIZE toAtom' :: (Ord a) => a -> StateT (AtomTable a) Identity Int #-} -newtype AtomT m r = AtomT (StateT AtomTable m r)- deriving (Functor,Monad,MonadTrans,MonadIO)+maybeToAtom' :: (Ord a, Monad m) =>+ a -> StateT (AtomTable a) m (Maybe Int)+maybeToAtom' x = do+ t <- get+ return $! Map.lookup x . to $ t+{-# SPECIALIZE maybeToAtom' :: (Ord a) =>+ a -> StateT (AtomTable a) Identity (Maybe Int) #-} -newtype Atom r = Atom (AtomT Identity r)- deriving (Functor,Monad,MonadAtom)+fromAtom' :: Monad m => Int -> StateT (AtomTable a) m a+fromAtom' i = do+ t <- get+ return $! from t IntMap.! i+{-# SPECIALIZE fromAtom' :: Int -> StateT (AtomTable a) Identity a #-} --- | The list of atoms (as Ints) stored in the atom table-atoms :: AtomTable -> [Int]-atoms = IntMap.keys . from+-- | @empty@ is the initial empty @AtomTable@+empty :: (Ord a) => AtomTable a+empty = T 0 Map.empty IntMap.empty -enc = Serialize.encode-dec bs = case Serialize.decode bs of- Left err -> error (show err)- Right r -> r+-- | The mapping stored in the atom table+mapping :: (Ord a) => AtomTable a -> Map.Map a Int+mapping = to+{-# INLINE mapping #-} -example :: [String]-example = evalAtom $ do - xs <- mapM toAtom . map show $ [1,2,3,1,2,3]- zs <- mapM fromAtom xs - return zs
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c)2011, Grzegorz Chrupała+Copyright (c)2012, Grzegorz Chrupała All rights reserved.
monad-atom.cabal view
@@ -7,14 +7,17 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.3.0+Version: 0.4.0 -- A short (one-line) description of the package.-Synopsis: Monadically convert objects to unique atoms and back.+Synopsis: Monadically convert object to unique integers and back. -- A longer description of the package.-Description: Monadically convert objects to unique atoms and back.+-- Description: +-- URL for the project homepage or repository.+Homepage: https://bitbucket.org/gchrupala/lingo+ -- The license under which the package is released. License: BSD3 @@ -37,7 +40,7 @@ -- Extra files to be distributed with the package, such as examples or -- a README.--- Extra-source-files: +--Extra-source-files: README -- Constraint on the version of Cabal needed to build this package. Cabal-version: >=1.2@@ -48,12 +51,13 @@ Exposed-modules: Control.Monad.Atom -- Packages needed in order to build this package.- Build-depends: base >= 3 && < 5, bytestring >= 0.9, cereal >= 0.3.5,- containers >= 0.4, mtl >= 2.0-+ Build-depends: base >=3 && <5+ , mtl >=2.0+ , containers >=0.4+ , ghc-prim >= 0.2 -- Modules not exported by this package. -- Other-modules: -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: - + GHC-options: -O2