Commits

Grzegorz Chrupała committed d4701b3

Removed monad-atom-tf

  • Participants
  • Parent commits 6c1bcb3

Comments (0)

Files changed (7)

File monad-atom-tf/Control/Monad/Atom.hs

-{-# 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
-    ( AtomTable
-    , Atom
-    , toAtom
-    , fromAtom
-    , maybeToAtom
-    , empty
-    , evalAtom
-    , runAtom
-    , mapping
-    )
-where
-import Control.Monad.State
-import Control.Monad.Identity
-import qualified Data.Map as Map
-import qualified Data.IntMap as IntMap
-import GHC.Generics (Generic)
-
--- | @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)
-
-
--- | @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)
-
-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 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) s = runStateT x s
-{-# INLINE runAtomT #-}
-
--- | @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) = flip evalStateT empty x
-{-# INLINE evalAtomT #-}
-
--- | @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 #-}
-
-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 #-}
-
-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) #-}
-
-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 #-}
-
--- | @empty@ is the initial empty @AtomTable@
-empty :: (Ord a) => AtomTable a
-empty = T 0 Map.empty IntMap.empty
-
--- | The mapping stored in the atom table
-mapping :: (Ord a) => AtomTable a -> Map.Map a Int
-mapping = to
-{-# INLINE mapping #-}
-

File monad-atom-tf/Control/Monad/ST/Atom.hs

-{-# LANGUAGE  GeneralizedNewtypeDeriving 
-  , NoMonomorphismRestriction 
-  , MultiParamTypeClasses
-  , TypeFamilies
-  , FlexibleInstances
-  , FlexibleContexts
-  , DeriveGeneric 
-  , BangPatterns #-}
-
-module Control.Monad.ST.Atom
-       ( Atom
-       , AtomTable
-       , initialize
-       , toAtom
-       , runAtom
-       )
-
-where
-import Control.Applicative
-import Control.Monad.Reader
-import Control.Monad.ST.Lazy (runST, ST, strictToLazyST)
-
-import Control.Monad.Identity
-import qualified Data.HashTable.ST.Basic as H
-import Data.Hashable (Hashable)
-
-import Data.STRef.Lazy
-import GHC.Generics (Generic)
-
-type HashTable s k v = H.HashTable s k v
-
-data AtomTable s a = T { lastID :: !(STRef s Int)
-                       , to :: !(HashTable s a Int) 
-                       }
-
-newtype Atom s a r = Atom { unAtom :: ReaderT (AtomTable s a) (ST s) r }
-                   deriving (Functor, Applicative, Monad)
-
-
-initialize :: ST s (AtomTable s a)
-initialize = do
-   i <- newSTRef (0::Int)
-   h <- strictToLazyST $ H.newSized 1000
-   return $! T i h
-
-toAtom :: (Eq a, Hashable a) => a -> Atom s a Int
-toAtom x = Atom $ do
-  t@(T ir h) <- ask
-  i <- lift $ readSTRef ir
-  r <- lift $ strictToLazyST $ H.lookup h x
-  case r of
-    Just j -> return $! j
-    Nothing -> do
-      let i' = i + 1
-      lift $ strictToLazyST $ H.insert h x i'    
-      lift $ writeSTRef ir i'
-      return $! i'
-
-runAtom :: Atom s a b -> ST s (AtomTable s a) -> ST s b      
-runAtom (Atom x) e = runReaderT x =<< e
-

File monad-atom-tf/LICENSE

-Copyright (c)2011, Grzegorz Chrupała
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Grzegorz Chrupała nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

File monad-atom-tf/Setup.hs

-import Distribution.Simple
-main = defaultMain

File monad-atom-tf/monad-atom-tf.cabal

--- monad-atom.cabal auto-generated by cabal init. For additional
--- options, see
--- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
--- The name of the package.
-Name:                monad-atom-tf
-
--- 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.0.3
-
--- A short (one-line) description of the package.
-Synopsis:            Monadically map objects to unique ints.
-
--- A longer description of the package.
-Description:         Monadically map objects to unique ints.
-
--- The license under which the package is released.
-License:             BSD3
-
--- The file containing the license text.
-License-file:        LICENSE
-
--- The package author(s).
-Author:              Grzegorz Chrupała
-
--- An email address to which users can send suggestions, bug reports,
--- and patches.
-Maintainer:          gchrupala@lsv.uni-saarland.de
-
--- A copyright notice.
--- Copyright:           
-
-Category:            Control
-
-Build-type:          Simple
-
--- Extra files to be distributed with the package, such as examples or
--- a README.
--- Extra-source-files:  
-
--- Constraint on the version of Cabal needed to build this package.
-Cabal-version:       >=1.2
-
-
-Library
-  -- Modules exported by the library.
-  Exposed-modules:     Control.Monad.Atom
-  
-  -- Packages needed in order to build this package.  
-  Build-depends:   base >= 3 && < 5
-                 , containers >= 0.4
-                 , mtl >= 2.0
-                 , ghc-prim 
-  GHC-Options: -O2

File monad-atom-tf/scripts/bench-st.hs

-import qualified Data.Text.Lazy as Text
-import qualified Data.Text.Lazy.IO as Text
-import qualified Data.Text.Lazy.Builder as Text
-import qualified Data.Text.Lazy.Builder.Int as Text
-import Control.Monad.ST.Atom
-import Control.Monad.ST.Lazy
-import Data.Hashable
-
-main = Text.interact $  Text.unlines . process . Text.lines
-       
-process xs = 
---   let (xs',s) = flip runAtom empty . mapM toAtom $ xs
---   in fst 
---       . flip runAtom s . mapM fromAtom
-       map (Text.toLazyText . Text.decimal)
-       . atomize . atomize . atomize . atomize
-       . atomize . atomize . atomize . atomize
-       $ xs
-       
-atomize :: (Hashable a, Eq a) => [a] -> [Int]       
-atomize xs = runST $ flip runAtom initialize . mapM toAtom $ xs

File monad-atom-tf/scripts/bench.hs

-import qualified Data.Text.Lazy as Text
-import qualified Data.Text.Lazy.IO as Text
-import qualified Data.Text.Lazy.Builder as Text
-import qualified Data.Text.Lazy.Builder.Int as Text
-import Control.Monad.Atom
-
-main = Text.interact $  Text.unlines . process . Text.lines
-       
-process xs = 
---   let (xs',s) = flip runAtom empty . mapM toAtom $ xs
---   in fst 
---       . flip runAtom s . mapM fromAtom
-       map (Text.toLazyText . Text.decimal)
-       . evalAtom . mapM toAtom 
-       . evalAtom . mapM toAtom
-       . evalAtom . mapM toAtom
-       . evalAtom . mapM toAtom
-       . evalAtom . mapM toAtom 
-       . evalAtom . mapM toAtom
-       . evalAtom . mapM toAtom
-       . evalAtom . mapM toAtom       
-       $ xs
-