packages feed

stringtable-atom 0.0.1 → 0.0.2

raw patch · 6 files changed

+668/−200 lines, 6 filesdep +containers

Dependencies added: containers

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2008, John Meacham+Copyright (c) 2008, John Meacham, Audrey Tang All rights reserved.  Redistribution and use in source and binary forms, with or without@@ -12,10 +12,10 @@       used to endorse or promote products derived from this software without       specific prior written permission. -THIS SOFTWARE IS PROVIDED BY JOHN MEACHAM ``AS IS'' AND ANY+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 JOHN MEACHAM BE LIABLE FOR ANY+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS 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
− StringTable/Atom.hsc 
@@ -1,191 +0,0 @@-{-# OPTIONS_GHC -fffi -XTypeSynonymInstances -XDeriveDataTypeable #-}-module StringTable.Atom(-    Atom(),-    ToAtom(..),-    FromAtom(..),-    HasHash(..),-    intToAtom,-    isValidAtom,-    unsafeIntToAtom,-    atomCompare,-    unsafeByteIndex,-    dumpTable,-    dumpToFile,-    dumpStringTableStats-    ) where--#include "StringTable_cbits.h"--import qualified Data.ByteString as BS-import qualified Data.ByteString.Internal as BS-import qualified Data.ByteString.Unsafe as BS-import Control.Monad-import Data.Binary-import Data.Binary.Get-import Data.Binary.Put-import Foreign-import Foreign.Marshal-import Data.Word-import Data.Char-import Foreign.C-import Data.Monoid-import Data.Dynamic-import Data.Bits--newtype Atom = Atom (#type atom_t)-    deriving(Typeable,Eq,Ord)--class FromAtom a where-    fromAtom :: Atom -> a-    fromAtomIO :: Atom -> IO a--    fromAtomIO a = return (fromAtom a)-    fromAtom a = unsafePerformIO (fromAtomIO a)--class ToAtom a where-    toAtom :: a -> Atom-    toAtomIO :: a -> IO Atom--    toAtomIO a = return (toAtom a)-    toAtom a = unsafePerformIO (toAtomIO a)--class HasHash a where-    hash32 :: a -> Word32--instance HasHash Atom where-    hash32 a = let (x,y) = fromAtom a :: CStringLen in unsafePerformIO $ hash2 0 x (fromIntegral y)--instance HasHash BS.ByteString where-    hash32 bs = unsafePerformIO $ do-        BS.unsafeUseAsCStringLen bs $ \ (x,y) -> hash2 0 x (fromIntegral y)--instance HasHash String where-    hash32 s = unsafePerformIO $ withCStringLen s $ \ (x,y) -> hash2 0 x (fromIntegral y)--instance FromAtom (String -> String) where-    fromAtom x = shows (fromAtom x :: String)--instance ToAtom Atom where-    toAtom x = x--instance FromAtom Atom where-    fromAtom x = x--instance ToAtom Char where-    toAtom x = toAtom [x]--instance ToAtom CStringLen where-    toAtomIO (cs,len) = do-        if (len > (#const MAX_ENTRY_SIZE))-            then fail "StringTable: atom is too big"-            else stAdd cs (fromIntegral len)----instance ToAtom CString where-    toAtomIO cs = do-        len <- BS.c_strlen cs-        toAtomIO (cs,fromIntegral len :: Int)--instance ToAtom String where-    toAtomIO s = toAtomIO (BS.pack (toUTF s))--instance FromAtom String where-    fromAtom = fromUTF . BS.unpack . fromAtom--instance ToAtom BS.ByteString where-    toAtomIO bs = BS.unsafeUseAsCStringLen bs toAtomIO--instance FromAtom CStringLen where-    fromAtom a@(Atom v) = (stPtr a,fromIntegral $ (v `shiftR` (#const ATOM_LEN_SHIFT)) .&. (#const ATOM_LEN_MASK))--instance FromAtom Word where-    fromAtom (Atom i) = fromIntegral i--instance FromAtom Int where-    fromAtom (Atom i) = fromIntegral i--instance FromAtom BS.ByteString where-    fromAtomIO a = do-        sl <- fromAtomIO a :: IO CStringLen-        BS.unsafePackCStringLen sl--instance Monoid Atom where-    mempty = toAtom BS.empty-    mappend x y = unsafePerformIO $ atomAppend x y--instance Show Atom where-    showsPrec _ atom = (fromAtom atom ++)--instance Read Atom where-    readsPrec _ s = [ (toAtom s,"") ]--intToAtom :: Monad m => Int -> m Atom-intToAtom i = if isValidAtom i then return (Atom $ fromIntegral i) else fail $ "intToAtom: " ++ show i--isValidAtom :: Int -> Bool-isValidAtom i = odd i--unsafeIntToAtom :: Int -> Atom-unsafeIntToAtom x = Atom (fromIntegral x)--unsafeByteIndex :: Atom -> Int -> Word8-unsafeByteIndex atom off = fromIntegral (unsafePerformIO $ peek (stPtr atom `advancePtr` off))--foreign import ccall unsafe "stringtable_lookup" stAdd :: CString -> CInt -> IO Atom-foreign import ccall unsafe "stringtable_ptr" stPtr :: Atom -> CString-foreign import ccall unsafe "stringtable_stats" dumpStringTableStats :: IO ()-foreign import ccall unsafe "dump_table" dumpTable :: IO ()-foreign import ccall unsafe "atom_append" atomAppend :: Atom -> Atom -> IO Atom-foreign import ccall unsafe "lexigraphic_compare" c_atomCompare :: Atom -> Atom -> CInt-foreign import ccall unsafe "dump_to_file" dumpToFile :: IO ()-foreign import ccall unsafe hash2  :: Word32 -> CString -> CInt -> IO Word32--atomCompare a b = if c == 0 then EQ else if c > 0 then GT else LT where-    c = c_atomCompare a b------ | Convert Unicode characters to UTF-8.-toUTF :: String -> [Word8]-toUTF [] = []-toUTF (x:xs) | ord x<=0x007F = (fromIntegral $ ord x):toUTF xs-	     | ord x<=0x07FF = fromIntegral (0xC0 .|. ((ord x `shift` (-6)) .&. 0x1F)):-			       fromIntegral (0x80 .|. (ord x .&. 0x3F)):-			       toUTF xs-	     | otherwise     = fromIntegral (0xE0 .|. ((ord x `shift` (-12)) .&. 0x0F)):-			       fromIntegral (0x80 .|. ((ord x `shift` (-6)) .&. 0x3F)):-			       fromIntegral (0x80 .|. (ord x .&. 0x3F)):-			       toUTF xs---- | Convert UTF-8 to Unicode.--fromUTF :: [Word8] -> String-fromUTF xs = fromUTF' (map fromIntegral xs) where-    fromUTF' [] = []-    fromUTF' (all@(x:xs))-	| x<=0x7F = (chr (x)):fromUTF' xs-	| x<=0xBF = err-	| x<=0xDF = twoBytes all-	| x<=0xEF = threeBytes all-	| otherwise   = err-    twoBytes (x1:x2:xs) = chr  ((((x1 .&. 0x1F) `shift` 6) .|.-			       (x2 .&. 0x3F))):fromUTF' xs-    twoBytes _ = error "fromUTF: illegal two byte sequence"--    threeBytes (x1:x2:x3:xs) = chr ((((x1 .&. 0x0F) `shift` 12) .|.-				    ((x2 .&. 0x3F) `shift` 6) .|.-				    (x3 .&. 0x3F))):fromUTF' xs-    threeBytes _ = error "fromUTF: illegal three byte sequence"--    err = error "fromUTF: illegal UTF-8 character"--instance Binary Atom where-    get = do-        x <- getWord8-        bs <- getBytes (fromIntegral x)-        return $ toAtom bs-    put a = do-        let bs = fromAtom a-        putWord8 $ fromIntegral $ BS.length bs-        putByteString bs
+ src/StringTable/Atom.hsc view
@@ -0,0 +1,191 @@+{-# OPTIONS_GHC -fffi -XTypeSynonymInstances -XDeriveDataTypeable #-}+module StringTable.Atom(+    Atom(),+    ToAtom(..),+    FromAtom(..),+    HasHash(..),+    intToAtom,+    isValidAtom,+    unsafeIntToAtom,+    atomCompare,+    unsafeByteIndex,+    dumpTable,+    dumpToFile,+    dumpStringTableStats+    ) where++#include "StringTable_cbits.h"++import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe as BS+import Control.Monad+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Foreign+import Foreign.Marshal+import Data.Word+import Data.Char+import Foreign.C+import Data.Monoid+import Data.Dynamic+import Data.Bits++newtype Atom = Atom (#type atom_t)+    deriving(Typeable,Eq,Ord)++class FromAtom a where+    fromAtom :: Atom -> a+    fromAtomIO :: Atom -> IO a++    fromAtomIO a = return (fromAtom a)+    fromAtom a = unsafePerformIO (fromAtomIO a)++class ToAtom a where+    toAtom :: a -> Atom+    toAtomIO :: a -> IO Atom++    toAtomIO a = return (toAtom a)+    toAtom a = unsafePerformIO (toAtomIO a)++class HasHash a where+    hash32 :: a -> Word32++instance HasHash Atom where+    hash32 a = let (x,y) = fromAtom a :: CStringLen in unsafePerformIO $ hash2 0 x (fromIntegral y)++instance HasHash BS.ByteString where+    hash32 bs = unsafePerformIO $ do+        BS.unsafeUseAsCStringLen bs $ \ (x,y) -> hash2 0 x (fromIntegral y)++instance HasHash String where+    hash32 s = unsafePerformIO $ withCStringLen s $ \ (x,y) -> hash2 0 x (fromIntegral y)++instance FromAtom (String -> String) where+    fromAtom x = shows (fromAtom x :: String)++instance ToAtom Atom where+    toAtom x = x++instance FromAtom Atom where+    fromAtom x = x++instance ToAtom Char where+    toAtom x = toAtom [x]++instance ToAtom CStringLen where+    toAtomIO (cs,len) = do+        if (len > (#const MAX_ENTRY_SIZE))+            then fail "StringTable: atom is too big"+            else stAdd cs (fromIntegral len)++++instance ToAtom CString where+    toAtomIO cs = do+        len <- BS.c_strlen cs+        toAtomIO (cs,fromIntegral len :: Int)++instance ToAtom String where+    toAtomIO s = toAtomIO (BS.pack (toUTF s))++instance FromAtom String where+    fromAtom = fromUTF . BS.unpack . fromAtom++instance ToAtom BS.ByteString where+    toAtomIO bs = BS.unsafeUseAsCStringLen bs toAtomIO++instance FromAtom CStringLen where+    fromAtom a@(Atom v) = (stPtr a,fromIntegral $ (v `shiftR` (#const ATOM_LEN_SHIFT)) .&. (#const ATOM_LEN_MASK))++instance FromAtom Word where+    fromAtom (Atom i) = fromIntegral i++instance FromAtom Int where+    fromAtom (Atom i) = fromIntegral i++instance FromAtom BS.ByteString where+    fromAtomIO a = do+        sl <- fromAtomIO a :: IO CStringLen+        BS.unsafePackCStringLen sl++instance Monoid Atom where+    mempty = toAtom BS.empty+    mappend x y = unsafePerformIO $ atomAppend x y++instance Show Atom where+    showsPrec _ atom = (fromAtom atom ++)++instance Read Atom where+    readsPrec _ s = [ (toAtom s,"") ]++intToAtom :: Monad m => Int -> m Atom+intToAtom i = if isValidAtom i then return (Atom $ fromIntegral i) else fail $ "intToAtom: " ++ show i++isValidAtom :: Int -> Bool+isValidAtom i = odd i++unsafeIntToAtom :: Int -> Atom+unsafeIntToAtom x = Atom (fromIntegral x)++unsafeByteIndex :: Atom -> Int -> Word8+unsafeByteIndex atom off = fromIntegral (unsafePerformIO $ peek (stPtr atom `advancePtr` off))++foreign import ccall unsafe "stringtable_lookup" stAdd :: CString -> CInt -> IO Atom+foreign import ccall unsafe "stringtable_ptr" stPtr :: Atom -> CString+foreign import ccall unsafe "stringtable_stats" dumpStringTableStats :: IO ()+foreign import ccall unsafe "dump_table" dumpTable :: IO ()+foreign import ccall unsafe "atom_append" atomAppend :: Atom -> Atom -> IO Atom+foreign import ccall unsafe "lexigraphic_compare" c_atomCompare :: Atom -> Atom -> CInt+foreign import ccall unsafe "dump_to_file" dumpToFile :: IO ()+foreign import ccall unsafe hash2  :: Word32 -> CString -> CInt -> IO Word32++atomCompare a b = if c == 0 then EQ else if c > 0 then GT else LT where+    c = c_atomCompare a b++++-- | Convert Unicode characters to UTF-8.+toUTF :: String -> [Word8]+toUTF [] = []+toUTF (x:xs) | ord x<=0x007F = (fromIntegral $ ord x):toUTF xs+	     | ord x<=0x07FF = fromIntegral (0xC0 .|. ((ord x `shift` (-6)) .&. 0x1F)):+			       fromIntegral (0x80 .|. (ord x .&. 0x3F)):+			       toUTF xs+	     | otherwise     = fromIntegral (0xE0 .|. ((ord x `shift` (-12)) .&. 0x0F)):+			       fromIntegral (0x80 .|. ((ord x `shift` (-6)) .&. 0x3F)):+			       fromIntegral (0x80 .|. (ord x .&. 0x3F)):+			       toUTF xs++-- | Convert UTF-8 to Unicode.++fromUTF :: [Word8] -> String+fromUTF xs = fromUTF' (map fromIntegral xs) where+    fromUTF' [] = []+    fromUTF' (all@(x:xs))+	| x<=0x7F = (chr (x)):fromUTF' xs+	| x<=0xBF = err+	| x<=0xDF = twoBytes all+	| x<=0xEF = threeBytes all+	| otherwise   = err+    twoBytes (x1:x2:xs) = chr  ((((x1 .&. 0x1F) `shift` 6) .|.+			       (x2 .&. 0x3F))):fromUTF' xs+    twoBytes _ = error "fromUTF: illegal two byte sequence"++    threeBytes (x1:x2:x3:xs) = chr ((((x1 .&. 0x0F) `shift` 12) .|.+				    ((x2 .&. 0x3F) `shift` 6) .|.+				    (x3 .&. 0x3F))):fromUTF' xs+    threeBytes _ = error "fromUTF: illegal three byte sequence"++    err = error "fromUTF: illegal UTF-8 character"++instance Binary Atom where+    get = do+        x <- getWord8+        bs <- getBytes (fromIntegral x)+        return $ toAtom bs+    put a = do+        let bs = fromAtom a+        putWord8 $ fromIntegral $ BS.length bs+        putByteString bs
+ src/StringTable/AtomMap.hs view
@@ -0,0 +1,319 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module StringTable.AtomMap  ( +            -- * Map type+              AtomMap(..), Key          -- instance Eq,Show++            -- * Operators+            , (!), (\\)++            -- * Query+            , null+            , size+            , member+            , notMember+	    , lookup+            , findWithDefault+            +            -- * Construction+            , empty+            , singleton++            -- ** Insertion+            , insert+            , insertWith, insertWithKey, insertLookupWithKey+            +            -- ** Delete\/Update+            , delete+            , adjust+            , adjustWithKey+            , update+            , updateWithKey+            , updateLookupWithKey+            , alter+  +            -- * Combine++            -- ** Union+            , union         +            , unionWith          +            , unionWithKey+            , unions+            , unionsWith++            -- ** Difference+            , difference+            , differenceWith+            , differenceWithKey+            +            -- ** Intersection+            , intersection           +            , intersectionWith+            , intersectionWithKey++            -- * Traversal+            -- ** Map+            , map+            , mapWithKey+            , mapAccum+            , mapAccumWithKey+            +            -- ** Fold+            , fold+            , foldWithKey++            -- * Conversion+            , elems+            , keys+  	    , keysSet+            , assocs+            +            -- ** Lists+            , toList+            , fromList+            , fromListWith+            , fromListWithKey++            -- ** Ordered lists+            , toAscList+            , fromAscList+            , fromAscListWith+            , fromAscListWithKey+            , fromDistinctAscList++            -- * Filter +            , filter+            , filterWithKey+            , partition+            , partitionWithKey++            , mapMaybe+            , mapMaybeWithKey+            , mapEither+            , mapEitherWithKey++            , split         +            , splitLookup   ++            -- * Submap+            , isSubmapOf, isSubmapOfBy+            , isProperSubmapOf, isProperSubmapOfBy+            +            -- * Min\/Max++            , maxView+            , minView+            , findMin   +            , findMax+            , deleteMin+            , deleteMax+            , deleteFindMin+            , deleteFindMax+            , updateMin+            , updateMax+            , updateMinWithKey+            , updateMaxWithKey +            , minViewWithKey+            , maxViewWithKey++            -- * Debugging+            , showTree+            , showTreeWith+            ) where++import Prelude hiding (lookup, filter)+import StringTable.Atom+import qualified Data.IntMap as IM+import qualified StringTable.AtomSet as AtomSet+import Data.Monoid+import Control.Monad (liftM)++type Key = Atom++newtype AtomMap a = MkAtomMap { fromAtomMap :: IM.IntMap a }+    deriving (Eq, Ord, Functor, Monoid)++instance Show a => Show (AtomMap a) where+    show = show . toList++fromList :: [(Atom, a)] -> AtomMap a+fromList ps = MkAtomMap $ IM.fromList [ (fromAtom l, x) | (l, x) <- ps ]++fromListWith :: (a -> a -> a) -> [(Atom, a)] -> AtomMap a+fromListWith f ps = MkAtomMap $ IM.fromListWith f [ (fromAtom l, x) | (l, x) <- ps ]++toList :: AtomMap a -> [(Atom, a)]+toList lm = [ (unsafeIntToAtom l, x) | (l, x) <- IM.toList $ fromAtomMap lm ]++mapWithKey :: (Atom -> a -> b) -> AtomMap a -> AtomMap b+mapWithKey f lm = MkAtomMap $ IM.mapWithKey (f . unsafeIntToAtom) (fromAtomMap lm)++elems :: AtomMap a -> [a]+elems = IM.elems . fromAtomMap++union :: AtomMap a -> AtomMap a -> AtomMap a+union (MkAtomMap x) (MkAtomMap y) = MkAtomMap (IM.union x y)++unionWith :: (a -> a -> a) -> AtomMap a -> AtomMap a -> AtomMap a+unionWith f (MkAtomMap x) (MkAtomMap y) = MkAtomMap (IM.unionWith f x y)++unions :: [AtomMap a] -> AtomMap a+unions = MkAtomMap . IM.unions . Prelude.map fromAtomMap++unionsWith :: (a -> a -> a) -> [AtomMap a] -> AtomMap a+unionsWith f = MkAtomMap . IM.unionsWith f . Prelude.map fromAtomMap++lookup :: Atom -> AtomMap a -> Maybe a+lookup l = IM.lookup (fromAtom l) . fromAtomMap++insert :: Atom -> a -> AtomMap a -> AtomMap a+insert l v = MkAtomMap . IM.insert (fromAtom l) v . fromAtomMap++insertWith :: (a -> a -> a) -> Atom -> a -> AtomMap a -> AtomMap a+insertWith f l v = MkAtomMap . IM.insertWith f (fromAtom l) v . fromAtomMap++member :: Atom -> AtomMap a -> Bool+member l = IM.member (fromAtom l) . fromAtomMap++keys :: AtomMap a -> [Atom]+keys = Prelude.map unsafeIntToAtom . IM.keys . fromAtomMap++keysSet :: AtomMap a -> AtomSet.AtomSet+keysSet x = AtomSet.MkAtomSet (IM.keysSet (fromAtomMap x))++filter :: (a -> Bool) -> AtomMap a -> AtomMap a+filter f = MkAtomMap . IM.filter f . fromAtomMap++mapMaybe :: (a -> Maybe b) -> AtomMap a -> AtomMap b+mapMaybe f = MkAtomMap . IM.mapMaybe f . fromAtomMap++mapMaybeWithKey :: (Atom -> a -> Maybe b) -> AtomMap a -> AtomMap b+mapMaybeWithKey f = MkAtomMap . IM.mapMaybeWithKey (f . unsafeIntToAtom) . fromAtomMap++intersection :: AtomMap a -> AtomMap b -> AtomMap a+intersection (MkAtomMap x) (MkAtomMap y) = MkAtomMap (IM.intersection x y)++(!) :: AtomMap a -> Key -> a+m ! k = (IM.!) (fromAtomMap m) (fromAtom k)++(\\) :: AtomMap a -> AtomMap b -> AtomMap a+(\\) (MkAtomMap x) (MkAtomMap y) = MkAtomMap ((IM.\\) x y)++fromAscList :: [(Key,a)] -> AtomMap a+fromAscList xs = fromList xs++fromDistinctAscList :: [(Key,a)] -> AtomMap a+fromDistinctAscList xs = fromList xs++delete :: Key -> AtomMap a -> AtomMap a+delete x y = MkAtomMap (IM.delete (fromAtom x) (fromAtomMap y))++adjust ::  (a -> a) -> Key -> AtomMap a -> AtomMap a+adjust x y z = MkAtomMap (IM.adjust ( x) (fromAtom y) (fromAtomMap z))+adjustWithKey ::  (Key -> a -> a) -> Key -> AtomMap a -> AtomMap a+adjustWithKey x y z = MkAtomMap (IM.adjustWithKey ((. unsafeIntToAtom) x) (fromAtom y) (fromAtomMap z))+assocs :: AtomMap a -> [(Key,a)]+assocs x = map (\(k, v) -> (unsafeIntToAtom k, v)) (IM.assocs (fromAtomMap x))+difference :: AtomMap a -> AtomMap b -> AtomMap a+difference x y = MkAtomMap (IM.difference (fromAtomMap x) (fromAtomMap y))+differenceWith :: (a -> b -> Maybe a) -> AtomMap a -> AtomMap b -> AtomMap a+differenceWith x y z = MkAtomMap (IM.differenceWith ( x) (fromAtomMap y) (fromAtomMap z))+differenceWithKey :: (Key -> a -> b -> Maybe a) -> AtomMap a -> AtomMap b -> AtomMap a+differenceWithKey x y z = MkAtomMap (IM.differenceWithKey ((. unsafeIntToAtom) x) (fromAtomMap y) (fromAtomMap z))+empty :: AtomMap a+empty  = MkAtomMap (IM.empty )+filterWithKey :: (Key -> a -> Bool) -> AtomMap a -> AtomMap a+filterWithKey x y = MkAtomMap (IM.filterWithKey ((. unsafeIntToAtom) x) (fromAtomMap y))+findWithDefault :: a -> Key -> AtomMap a -> a+findWithDefault x y z =  (IM.findWithDefault ( x) (fromAtom y) (fromAtomMap z))+fold :: (a -> b -> b) -> b -> AtomMap a -> b+fold x y z =  (IM.fold ( x) ( y) (fromAtomMap z))+foldWithKey :: (Key -> a -> b -> b) -> b -> AtomMap a -> b+foldWithKey x y z =  (IM.foldWithKey ((. unsafeIntToAtom) x) ( y) (fromAtomMap z))+fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> AtomMap a+fromAscListWith x y = MkAtomMap (IM.fromAscListWith ( x) (map (\(k, v) -> (fromAtom k, v)) y))+fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> AtomMap a+fromAscListWithKey x y = MkAtomMap (IM.fromAscListWithKey ((. unsafeIntToAtom) x) (map (\(k, v) -> (fromAtom k, v)) y))+fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> AtomMap a+fromListWithKey x y = MkAtomMap (IM.fromListWithKey ((. unsafeIntToAtom) x) (map (\(k, v) -> (fromAtom k, v)) y))+insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> AtomMap a -> (Maybe a, AtomMap a)+insertLookupWithKey x y z w = (\(x, y) -> (x, MkAtomMap y)) (IM.insertLookupWithKey ((. unsafeIntToAtom) x) (fromAtom y) ( z) (fromAtomMap w))+insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> AtomMap a -> AtomMap a+insertWithKey x y z w = MkAtomMap (IM.insertWithKey ((. unsafeIntToAtom) x) (fromAtom y) ( z) (fromAtomMap w))+intersectionWith :: (a -> b -> a) -> AtomMap a -> AtomMap b -> AtomMap a+intersectionWith x y z = MkAtomMap (IM.intersectionWith ( x) (fromAtomMap y) (fromAtomMap z))+intersectionWithKey :: (Key -> a -> b -> a) -> AtomMap a -> AtomMap b -> AtomMap a+intersectionWithKey x y z = MkAtomMap (IM.intersectionWithKey ((. unsafeIntToAtom) x) (fromAtomMap y) (fromAtomMap z))+isProperSubmapOf :: Eq a => AtomMap a -> AtomMap a -> Bool+isProperSubmapOf x y =  (IM.isProperSubmapOf (fromAtomMap x) (fromAtomMap y))+isProperSubmapOfBy :: (a -> b -> Bool) -> AtomMap a -> AtomMap b -> Bool+isProperSubmapOfBy x y z =  (IM.isProperSubmapOfBy ( x) (fromAtomMap y) (fromAtomMap z))+isSubmapOf :: Eq a => AtomMap a -> AtomMap a -> Bool+isSubmapOf x y =  (IM.isSubmapOf (fromAtomMap x) (fromAtomMap y))+isSubmapOfBy :: (a -> b -> Bool) -> AtomMap a -> AtomMap b -> Bool+isSubmapOfBy x y z =  (IM.isSubmapOfBy ( x) (fromAtomMap y) (fromAtomMap z))+mapAccum :: (a -> b -> (a,c)) -> a -> AtomMap b -> (a,AtomMap c)+mapAccum x y z = (\(x, y) -> (x, MkAtomMap y)) (IM.mapAccum ( x) ( y) (fromAtomMap z))+mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> AtomMap b -> (a,AtomMap c)+mapAccumWithKey x y z = (\(x, y) -> (x, MkAtomMap y)) (IM.mapAccumWithKey ((\f x y -> f x (unsafeIntToAtom y)) x) ( y) (fromAtomMap z))+mapEither :: (a -> Either b c) -> AtomMap a -> (AtomMap b, AtomMap c)+mapEither x y = (\(x, y) -> (MkAtomMap x, MkAtomMap y)) (IM.mapEither ( x) (fromAtomMap y))+mapEitherWithKey :: (Key -> a -> Either b c) -> AtomMap a -> (AtomMap b, AtomMap c)+mapEitherWithKey x y = (\(x, y) -> (MkAtomMap x, MkAtomMap y)) (IM.mapEitherWithKey ((. unsafeIntToAtom) x) (fromAtomMap y))+maxViewWithKey :: (Monad m) => AtomMap a -> m ((Key, a), AtomMap a)+maxViewWithKey x = liftM (\((x, y), z) -> ((unsafeIntToAtom x, y), MkAtomMap z)) (IM.maxViewWithKey (fromAtomMap x))+minViewWithKey :: (Monad m) => AtomMap a -> m ((Key, a), AtomMap a)+minViewWithKey x = liftM (\((x, y), z) -> ((unsafeIntToAtom x, y), MkAtomMap z)) (IM.minViewWithKey (fromAtomMap x))+notMember :: Key -> AtomMap a -> Bool+notMember x y =  (IM.notMember (fromAtom x) (fromAtomMap y))+partition :: (a -> Bool) -> AtomMap a -> (AtomMap a,AtomMap a)+partition x y = (\(x, y) -> (MkAtomMap x, MkAtomMap y)) (IM.partition ( x) (fromAtomMap y))+partitionWithKey :: (Key -> a -> Bool) -> AtomMap a -> (AtomMap a,AtomMap a)+partitionWithKey x y = (\(x, y) -> (MkAtomMap x, MkAtomMap y)) (IM.partitionWithKey ((. unsafeIntToAtom) x) (fromAtomMap y))+showTree :: Show a => AtomMap a -> String+showTree x =  (IM.showTree (fromAtomMap x))+showTreeWith :: Show a => Bool -> Bool -> AtomMap a -> String+showTreeWith x y z =  (IM.showTreeWith ( x) ( y) (fromAtomMap z))+singleton :: Key -> a -> AtomMap a+singleton x y = MkAtomMap (IM.singleton (fromAtom x) ( y))+size :: AtomMap a -> Int+size x =  (IM.size (fromAtomMap x))+split :: Key -> AtomMap a -> (AtomMap a,AtomMap a)+split x y = (\(x, y) -> (MkAtomMap x, MkAtomMap y)) (IM.split (fromAtom x) (fromAtomMap y))+splitLookup :: Key -> AtomMap a -> (AtomMap a,Maybe a,AtomMap a)+splitLookup x y = (\(x, y, z) -> (MkAtomMap x, y, MkAtomMap z)) (IM.splitLookup (fromAtom x) (fromAtomMap y))+toAscList :: AtomMap a -> [(Key,a)]+toAscList x = map (\(k, v) -> (unsafeIntToAtom k, v)) (IM.toAscList (fromAtomMap x))+unionWithKey :: (Key -> a -> a -> a) -> AtomMap a -> AtomMap a -> AtomMap a+unionWithKey x y z = MkAtomMap (IM.unionWithKey ((. unsafeIntToAtom) x) (fromAtomMap y) (fromAtomMap z))+update ::  (a -> Maybe a) -> Key -> AtomMap a -> AtomMap a+update x y z = MkAtomMap (IM.update ( x) (fromAtom y) (fromAtomMap z))+updateLookupWithKey ::  (Key -> a -> Maybe a) -> Key -> AtomMap a -> (Maybe a,AtomMap a)+updateLookupWithKey x y z = (\(x, y) -> (x, MkAtomMap y)) (IM.updateLookupWithKey ((. unsafeIntToAtom) x) (fromAtom y) (fromAtomMap z))+updateMax :: (a -> a) -> AtomMap a -> AtomMap a+updateMax x y = MkAtomMap (IM.updateMax ( x) (fromAtomMap y))+updateMaxWithKey :: (Key -> a -> a) -> AtomMap a -> AtomMap a+updateMaxWithKey x y = MkAtomMap (IM.updateMaxWithKey ((. unsafeIntToAtom) x) (fromAtomMap y))+updateMin :: (a -> a) -> AtomMap a -> AtomMap a+updateMin x y = MkAtomMap (IM.updateMin ( x) (fromAtomMap y))+updateMinWithKey :: (Key -> a -> a) -> AtomMap a -> AtomMap a+updateMinWithKey x y = MkAtomMap (IM.updateMinWithKey ((. unsafeIntToAtom) x) (fromAtomMap y))+updateWithKey ::  (Key -> a -> Maybe a) -> Key -> AtomMap a -> AtomMap a+updateWithKey x y z = MkAtomMap (IM.updateWithKey ((. unsafeIntToAtom) x) (fromAtom y) (fromAtomMap z))+alter :: (Maybe a -> Maybe a) -> Key -> AtomMap a -> AtomMap a+alter x y z = MkAtomMap (IM.alter ( x) (fromAtom y) (fromAtomMap z))+maxView :: (Monad m) => AtomMap a -> m (a, AtomMap a)+maxView x = liftM (\(x, y) -> (x, MkAtomMap y)) (IM.maxView (fromAtomMap x))+minView :: (Monad m) => AtomMap a -> m (a, AtomMap a)+minView x = liftM (\(x, y) -> (x, MkAtomMap y)) (IM.minView (fromAtomMap x))+findMax :: AtomMap a -> a+findMax x =  (IM.findMax (fromAtomMap x))+findMin :: AtomMap a -> a+findMin x =  (IM.findMin (fromAtomMap x))+deleteMax :: AtomMap a -> AtomMap a+deleteMax x = MkAtomMap (IM.deleteMax (fromAtomMap x))+deleteMin :: AtomMap a -> AtomMap a+deleteMin x = MkAtomMap (IM.deleteMin (fromAtomMap x))+deleteFindMax :: AtomMap a -> (a, AtomMap a)+deleteFindMax x = (\(x, y) -> (x, MkAtomMap y)) (IM.deleteFindMax (fromAtomMap x))+deleteFindMin :: AtomMap a -> (a, AtomMap a)+deleteFindMin x = (\(x, y) -> (x, MkAtomMap y)) (IM.deleteFindMin (fromAtomMap x))
+ src/StringTable/AtomSet.hs view
@@ -0,0 +1,148 @@+module StringTable.AtomSet  ( +            -- * Set type+              AtomSet(..)          -- instance Eq,Show++            -- * Operators+            , (\\)++            -- * Query+            , null+            , size+            , member+            , notMember+            , isSubsetOf+            , isProperSubsetOf+            +            -- * Construction+            , empty+            , singleton+            , insert+            , delete+            +            -- * Combine+            , union, unions+            , difference+            , intersection+            +            -- * Filter+            , filter+            , partition+            , split+            , splitMember++            -- * Min\/Max+            , findMin   +            , findMax+            , deleteMin+            , deleteMax+            , deleteFindMin+            , deleteFindMax+            , maxView+            , minView++            -- * Map+	    , map++            -- * Fold+            , fold++            -- * Conversion+            -- ** List+            , elems+            , toList+            , fromList+            +            -- ** Ordered list+            , toAscList+            , fromAscList+            , fromDistinctAscList+                        +            -- * Debugging+            , showTree+            , showTreeWith+            ) where++import Prelude hiding (lookup, filter, null, map)+import qualified Prelude (map)+import StringTable.Atom+import qualified Data.IntSet as IS+import Data.Monoid+import Control.Monad (liftM)++newtype AtomSet = MkAtomSet { fromAtomSet :: IS.IntSet }+    deriving (Eq, Ord)++null :: AtomSet -> Bool+null x =  (IS.null (fromAtomSet x))+size :: AtomSet -> Atom+size x = unsafeIntToAtom (IS.size (fromAtomSet x))+member :: Atom -> AtomSet -> Bool+member x y =  (IS.member (fromAtom x) (fromAtomSet y))+notMember :: Atom -> AtomSet -> Bool+notMember x y =  (IS.notMember (fromAtom x) (fromAtomSet y))+isSubsetOf :: AtomSet -> AtomSet -> Bool+isSubsetOf x y =  (IS.isSubsetOf (fromAtomSet x) (fromAtomSet y))+isProperSubsetOf :: AtomSet -> AtomSet -> Bool+isProperSubsetOf x y =  (IS.isProperSubsetOf (fromAtomSet x) (fromAtomSet y))+empty :: AtomSet+empty  = MkAtomSet (IS.empty )+singleton :: Atom -> AtomSet+singleton x = MkAtomSet (IS.singleton (fromAtom x))+insert :: Atom -> AtomSet -> AtomSet+insert x y = MkAtomSet (IS.insert (fromAtom x) (fromAtomSet y))+delete :: Atom -> AtomSet -> AtomSet+delete x y = MkAtomSet (IS.delete (fromAtom x) (fromAtomSet y))+unions :: [AtomSet] -> AtomSet+unions x = MkAtomSet (IS.unions (Prelude.map fromAtomSet x))+difference :: AtomSet -> AtomSet -> AtomSet+difference x y = MkAtomSet (IS.difference (fromAtomSet x) (fromAtomSet y))+intersection :: AtomSet -> AtomSet -> AtomSet+intersection x y = MkAtomSet (IS.intersection (fromAtomSet x) (fromAtomSet y))+filter :: (Atom -> Bool) -> AtomSet -> AtomSet+filter x y = MkAtomSet (IS.filter ((. unsafeIntToAtom) x) (fromAtomSet y))+partition :: (Atom -> Bool) -> AtomSet -> (AtomSet,AtomSet)+partition x y = (\(x, y) -> (MkAtomSet x, MkAtomSet y)) (IS.partition ((. unsafeIntToAtom) x) (fromAtomSet y))+split :: Atom -> AtomSet -> (AtomSet,AtomSet)+split x y = (\(x, y) -> (MkAtomSet x, MkAtomSet y)) (IS.split (fromAtom x) (fromAtomSet y))+splitMember :: Atom -> AtomSet -> (AtomSet,Bool,AtomSet)+splitMember x y = (\(x, y, z) -> (MkAtomSet x, y, MkAtomSet z)) (IS.splitMember (fromAtom x) (fromAtomSet y))+findMin :: AtomSet -> Atom+findMin x = unsafeIntToAtom (IS.findMin (fromAtomSet x))+findMax :: AtomSet -> Atom+findMax x = unsafeIntToAtom (IS.findMax (fromAtomSet x))+deleteMin :: AtomSet -> AtomSet+deleteMin x = MkAtomSet (IS.deleteMin (fromAtomSet x))+deleteMax :: AtomSet -> AtomSet+deleteMax x = MkAtomSet (IS.deleteMax (fromAtomSet x))+deleteFindMin :: AtomSet -> (Atom, AtomSet)+deleteFindMin x = (\(x, y) -> (unsafeIntToAtom x, MkAtomSet y)) (IS.deleteFindMin (fromAtomSet x))+deleteFindMax :: AtomSet -> (Atom, AtomSet)+deleteFindMax x = (\(x, y) -> (unsafeIntToAtom x, MkAtomSet y)) (IS.deleteFindMax (fromAtomSet x))+maxView :: (Monad m) => AtomSet -> m (Atom, AtomSet)+maxView x = liftM (\(x, y) -> (unsafeIntToAtom x, MkAtomSet y)) (IS.maxView (fromAtomSet x))+minView :: (Monad m) => AtomSet -> m (Atom, AtomSet)+minView x = liftM (\(x, y) -> (unsafeIntToAtom x, MkAtomSet y)) (IS.minView (fromAtomSet x))+map :: (Atom->Atom) -> AtomSet -> AtomSet+map x y = MkAtomSet (IS.map ((\f -> fromAtom . f . unsafeIntToAtom) x) (fromAtomSet y))+fold :: (Atom -> b -> b) -> b -> AtomSet -> b+fold x y z =  (IS.fold ((. unsafeIntToAtom) x) ( y) (fromAtomSet z))+elems :: AtomSet -> [Atom]+elems x = Prelude.map unsafeIntToAtom (IS.elems (fromAtomSet x))+toList :: AtomSet -> [Atom]+toList x = Prelude.map unsafeIntToAtom (IS.toList (fromAtomSet x))+fromList :: [Atom] -> AtomSet+fromList x = MkAtomSet (IS.fromList (Prelude.map fromAtom x))+toAscList :: AtomSet -> [Atom]+toAscList x = Prelude.map unsafeIntToAtom (IS.toAscList (fromAtomSet x))+fromAscList :: [Atom] -> AtomSet +fromAscList x = MkAtomSet (IS.fromAscList (Prelude.map fromAtom x))+fromDistinctAscList :: [Atom] -> AtomSet+fromDistinctAscList x = MkAtomSet (IS.fromDistinctAscList (Prelude.map fromAtom x))+showTree :: AtomSet -> String+showTree x =  (IS.showTree (fromAtomSet x))+showTreeWith :: Bool -> Bool -> AtomSet -> String+showTreeWith x y z =  (IS.showTreeWith ( x) ( y) (fromAtomSet z))+union :: AtomSet -> AtomSet -> AtomSet+union x y = MkAtomSet (IS.union (fromAtomSet x) (fromAtomSet y))+(\\) :: AtomSet -> AtomSet -> AtomSet+(\\) x y = MkAtomSet (IS.union (fromAtomSet x) (fromAtomSet y))
stringtable-atom.cabal view
@@ -1,16 +1,16 @@ Name:                stringtable-atom-Version:             0.0.1+Version:             0.0.2 Category:            Data-Synopsis:            Maps strings to Atoms for fast equality and ordering comparison-Description:         Maps strings to Atoms for fast equality and ordering comparison+Synopsis:            Memoize Strings as Atoms for fast comparison and sorting, with maps and sets+Description:         Memoize Strings as Atoms for fast comparison and sorting, with maps and sets License:             BSD3 License-File:        LICENSE Author:              John Meacham Maintainer:          audreyt@audreyt.org-Copyright:           John Meacham, 2008-Exposed-modules:     StringTable.Atom+Copyright:           John Meacham 2008, Audrey Tang 2008+Exposed-modules:     StringTable.Atom StringTable.AtomMap StringTable.AtomSet -Build-Depends:       base, bytestring>=0.9.0.1, binary+Build-Depends:       base, bytestring>=0.9.0.1, binary, containers Build-Type:          Simple Tested-With:         GHC==6.8.2 @@ -19,3 +19,4 @@ extra-source-files:  cbits/StringTable_cbits.h include-dirs:        cbits cc-options:          -O2 -std=c99+hs-source-dirs:      src