diff --git a/Data/Trie.hs b/Data/Trie.hs --- a/Data/Trie.hs +++ b/Data/Trie.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-} ---------------------------------------------------------------- --- ~ 2008.12.19 +-- ~ 2009.01.03 -- | -- Module : Data.Trie -- Copyright : Copyright (c) 2008--2009 wren ng thornton @@ -55,11 +55,12 @@ import Data.Trie.BitTwiddle import Data.Maybe (isJust) -import Control.Monad (liftM) +import Control.Monad (liftM, liftM3, liftM4) import Control.Applicative (Applicative(..), (<$>)) import Data.Monoid (Monoid(..)) import Data.Foldable (Foldable(foldMap)) import Data.Traversable (Traversable(traverse)) +import Data.Binary ---------------------------------------------------------------- ---------------------------------------------------------------- @@ -212,6 +213,24 @@ traverse f (Arc k (Just v) t) = Arc k . Just <$> f v <*> traverse f t traverse f (Branch p m l r) = Branch p m <$> traverse f l <*> traverse f r +instance Binary a => Binary (Trie a) where + put Empty = put (0 :: Word8) + put (Arc k m t) = do put (1 :: Word8) + put k + put m + put t + put (Branch p m l r) = do put (2 :: Word8) + put p + put m + put l + put r + + get = do tag <- get :: Get Word8 + case tag of + 0 -> return Empty + 1 -> liftM3 Arc get get get + _ -> liftM4 Branch get get get get + {--------------------------------------------------------------- -- Smart constructors and helper functions for building tries ---------------------------------------------------------------} @@ -352,7 +371,7 @@ go _ Empty = z go q (Arc k mv t) - | not (S.null k') = a (Arc k' mv t) + | not (S.null k') = if S.null q' then a (Arc k' mv t) else z | S.null q' = f mv t | otherwise = go q' t where diff --git a/Data/Trie/ByteStringInternal.hs b/Data/Trie/ByteStringInternal.hs --- a/Data/Trie/ByteStringInternal.hs +++ b/Data/Trie/ByteStringInternal.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-} ---------------------------------------------------------------- --- ~ 2008.12.19 +-- ~ 2008.12.24 -- | -- Module : Data.Trie.ByteStringInternal -- Copyright : Copyright (c) 2008--2009 wren ng thornton @@ -16,7 +16,7 @@ module Data.Trie.ByteStringInternal ( ByteString, ByteStringElem - , wordHead + , unsafeWordHead , splitMaximalPrefix ) where @@ -36,42 +36,49 @@ type ByteStringElem = Word8 -- Associated type of ByteString +-- | The size of 'Word' in bytes. +sizeOfWord :: Int +sizeOfWord = sizeOf (undefined :: Word) ---------------------------------------------------------------- -- | Return the first natural 'Word' worth of string, padding by --- zeros as necessary. Number of elements per word, and position --- of elements within the word varies by architecture. -wordHead :: ByteString -> Word -wordHead (PS s o l) = inlinePerformIO $ - withForeignPtr s $ \p -> - liftM (maskBytes l .&.) - (peek (p `plusPtr` o :: Ptr Word)) +-- zeros as necessary. The position of elements within the word +-- varies by architecture, hence this function is quasi-unsafe to +-- use for trieing on the bit-vector representation. A safer version +-- may be forthcoming, though trieing on multiple bytes at once +-- appears impractical at the moment. +unsafeWordHead :: ByteString -> Word +unsafeWordHead (PS s o l) = inlinePerformIO $ + withForeignPtr s $ \p -> + liftM (maskInitialBytes l .&.) + (peek (p `plusPtr` o :: Ptr Word)) --- The 0x are automatically truncated when too large, don't need --- to worry about 'max'ing with sizeOf Word. -maskBytes :: Int -> Word -maskBytes i - | isLittleEndian = case 0 `max` i of - 0 -> 0x0000000000000000 - 1 -> 0x00000000000000FF - 2 -> 0x000000000000FFFF - 3 -> 0x0000000000FFFFFF - 4 -> 0x00000000FFFFFFFF - 5 -> 0x000000FFFFFFFFFF - 6 -> 0x0000FFFFFFFFFFFF - 7 -> 0x00FFFFFFFFFFFFFF - _ -> 0xFFFFFFFFFFFFFFFF - | otherwise = case 0 `max` i of - 0 -> 0x0000000000000000 - 1 -> 0xFF00000000000000 - 2 -> 0xFFFF000000000000 - 3 -> 0xFFFFFF0000000000 - 4 -> 0xFFFFFFFF00000000 - 5 -> 0xFFFFFFFFFF000000 - 6 -> 0xFFFFFFFFFFFF0000 - 7 -> 0xFFFFFFFFFFFFFF00 - _ -> 0xFFFFFFFFFFFFFFFF +maskInitialBytes :: Int -> Word +maskInitialBytes byteCount + | isLittleEndian = case effectiveByteCount of + 0 -> 0x0000000000000000 + 1 -> 0x00000000000000FF + 2 -> 0x000000000000FFFF + 3 -> 0x0000000000FFFFFF + 4 -> 0x00000000FFFFFFFF + 5 -> 0x000000FFFFFFFFFF + 6 -> 0x0000FFFFFFFFFFFF + 7 -> 0x00FFFFFFFFFFFFFF + _ -> 0xFFFFFFFFFFFFFFFF + | otherwise = case effectiveByteCount of + 0 -> 0x0000000000000000 + 1 -> 0xFF00000000000000 + 2 -> 0xFFFF000000000000 + 3 -> 0xFFFFFF0000000000 + 4 -> 0xFFFFFFFF00000000 + 5 -> 0xFFFFFFFFFF000000 + 6 -> 0xFFFFFFFFFFFF0000 + 7 -> 0xFFFFFFFFFFFFFF00 + _ -> 0xFFFFFFFFFFFFFFFF + where + effectiveByteCount = 0 `max` (byteCount `min` sizeOfWord) + -- TODO: How to get this to execute statically?... -- BUG? is 'alloca' safe in 'inlinePerformIO' (used in 'wordHead')? {-# NOINLINE isLittleEndian #-} @@ -124,19 +131,38 @@ (!$) = ($!) -- fix associativity bug --- Calculates the first index where values differ. --- BUG: There has to be a smarter algorithm for this +-- | Calculates the first index where values differ. +-- +-- BUG: There has to be a smarter algorithm for this. In particular, +-- it'd be nice if there was a function like C's @memcmp@, but which +-- returns the index rather than the 'Ordering'. If it were agnostic +-- ot architecture, that'd be even nicer. +-- +-- TODO: rather than revert to @goByte@, we should use xor- and +-- mask-munging so @goWord@ can reuse the information it already +-- has to discover the byte of difference. The trick is making that +-- faster than the current version. And ensuring alignment. {-# INLINE indexOfDifference #-} indexOfDifference :: Ptr ByteStringElem -> Ptr ByteStringElem -> Int -> IO Int -indexOfDifference p1 p2 limit = go 0 +indexOfDifference p1 p2 limit = goByte 0 where - go n = if n >= limit - then return limit - else do c1 <- peekElemOff p1 n - c2 <- peekElemOff p2 n - if c1 == c2 - then go $! n+1 - else return n + {- BUG: using this assumes ByteStrings are Word-aligned + goWord n = if n + sizeOfWord >= limit + then goByte n + else do w1 <- peek (p1 `plusPtr` n :: Ptr Word) + w2 <- peek (p2 `plusPtr` n :: Ptr Word) + if w1 == w2 + then goWord $! n + sizeOfWord + else goByte n + -} + + goByte n = if n >= limit + then return limit + else do c1 <- peekElemOff p1 n + c2 <- peekElemOff p2 n + if c1 == c2 + then goByte $! n+1 + else return n ---------------------------------------------------------------- ----------------------------------------------------------- fin. diff --git a/bytestring-trie.cabal b/bytestring-trie.cabal --- a/bytestring-trie.cabal +++ b/bytestring-trie.cabal @@ -1,9 +1,9 @@ ---------------------------------------------------------------- --- wren ng thornton ~ 2008.12.19 +-- wren ng thornton ~ 2008.12.20 ---------------------------------------------------------------- Name: bytestring-trie -Version: 0.1 +Version: 0.1.1 Cabal-Version: >= 1.2 Build-Type: Simple Stability: beta @@ -14,17 +14,23 @@ Maintainer: wren@community.haskell.org Homepage: http://code.haskell.org/~wren/ Category: Data, Data Structures -Synopsis: Efficient map from strings to values. -Description: Efficient map from strings to values. +Synopsis: An efficient finite map from (byte)strings to values. +Description: An efficient finite map from (byte)strings to values. . - The implementation is based on /big-endian patricia trees/, like "Data.IntMap". We first trie on the elements of "Data.ByteString" and then trie on the big-endian bit representation of those elements. + The implementation is based on /big-endian patricia + trees/, like "Data.IntMap". We first trie on the + elements of "Data.ByteString" and then trie on the + big-endian bit representation of those elements. + Patricia trees have efficient algorithms for union + and other merging operations, but they're also quick + for lookups and insertions. Library Exposed-Modules: Data.Trie , Data.Trie.Convenience Other-Modules: Data.Trie.BitTwiddle , Data.Trie.ByteStringInternal - Build-Depends: base, bytestring + Build-Depends: base, bytestring, binary ---------------------------------------------------------------- ----------------------------------------------------------- fin.