bytestring-trie 0.2.4.3 → 0.2.5.0
raw patch · 5 files changed
+156/−350 lines, 5 filesdep ~basedep ~binarydep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, binary, bytestring
API changes (from Hackage documentation)
+ Data.Trie.Internal: instance Data.Semigroup.Semigroup a => Data.Semigroup.Semigroup (Data.Trie.Internal.Trie a)
Files
- README.md +0/−1
- bytestring-trie.cabal +11/−21
- src/Data/Trie/ByteStringInternal.hs +46/−67
- src/Data/Trie/ByteStringInternal/indexOfDifference.c +0/−175
- src/Data/Trie/Internal.hs +99/−86
README.md view
@@ -52,7 +52,6 @@ language extensions. The complete list of extensions used is: * CPP-* ForeignFunctionInterface * MagicHash * NoImplicitPrelude
bytestring-trie.cabal view
@@ -1,5 +1,5 @@ --------------------------------------------------------------- wren gayle romano <wren@cpan.org> ~ 2019.02.23+-- wren gayle romano <wren@cpan.org> ~ 2019.02.25 ------------------------------------------------------------ -- By and large Cabal >=1.2 is fine; but@@ -10,7 +10,7 @@ Build-Type: Simple Name: bytestring-trie-Version: 0.2.4.3+Version: 0.2.5.0 Stability: provisional Homepage: http://wrengr.org Author: wren gayle romano@@ -53,22 +53,15 @@ GHC ==7.8.1, GHC ==7.8.2, GHC ==7.8.3, GHC ==7.8.4, GHC ==7.10.1, GHC ==7.10.2, GHC ==7.10.3, GHC ==8.0.1, GHC ==8.0.2,- GHC ==8.2.1, GHC ==8.2.2- -- TODO: re-enable these and get them to work.- -- GHC ==8.4.1, GHC ==8.4.2, GHC ==8.4.3,- -- GHC ==8.6.1, GHC ==8.6.2+ GHC ==8.2.1, GHC ==8.2.2,+ GHC ==8.4.1, GHC ==8.4.2, GHC ==8.4.3,+ GHC ==8.6.1, GHC ==8.6.2 Source-Repository head Type: git Location: https://github.com/wrengr/bytestring-trie.git -------------------------------------------------------------Flag useCinternal- Default: False- Description: Use optimized C implementation for indexOfDifference.- See notes in Data.Trie.ByteStringInternal.-------------------------------------------------------------- Library Hs-Source-Dirs: src Exposed-Modules: Data.Trie@@ -77,15 +70,12 @@ Other-Modules: Data.Trie.BitTwiddle , Data.Trie.ByteStringInternal , Data.Trie.Errors- Build-Depends: base >= 4 && < 4.11- , bytestring >= 0.9 && < 0.11- , binary+ -- The lower bounds are more restrictive than necessary.+ -- But then, we don't maintain any CI tests for older+ -- versions, so these are the lowest bounds we've verified.+ Build-Depends: base >= 4.5 && < 4.13+ , bytestring >= 0.9.2 && < 0.11+ , binary >= 0.5.1 && < 0.8.7 - if flag(useCinternal)- C-Sources: src/Data/Trie/ByteStringInternal/indexOfDifference.c- CC-Options: -O3- Cpp-Options: -D__USE_C_INTERNAL__--- Also need to add stuff to run Configure.hs, FWIW- ------------------------------------------------------------ ------------------------------------------------------- fin.
src/Data/Trie/ByteStringInternal.hs view
@@ -1,29 +1,16 @@-{--The C algorithm does not appear to give notable performance-improvements, at least when building tries based on /usr/dict on-little-endian 32-bit machines. The implementation also appears-somewhat buggy (cf test/TrieFile.hs) and using the FFI complicates-distribution.--{-# LANGUAGE CPP, ForeignFunctionInterface #-}-{-# CFILES ByteStringInternal/indexOfDifference.c #-}--}- {-# OPTIONS_GHC -Wall -fwarn-tabs #-}--------------------------------------------------------------------- ~ 2009.02.06+------------------------------------------------------------+-- ~ 2019.02.25 -- | -- Module : Data.Trie.ByteStringInternal--- Copyright : Copyright (c) 2008--2015 wren gayle romano+-- Copyright : Copyright (c) 2008--2019 wren gayle romano -- License : BSD3 -- Maintainer : wren@community.haskell.org -- Stability : experimental--- Portability : portable+-- Portability : GHC-only -- -- Helper functions on 'ByteString's for "Data.Trie.Internal".------------------------------------------------------------------+------------------------------------------------------------ module Data.Trie.ByteStringInternal ( ByteString, ByteStringElem@@ -31,41 +18,35 @@ ) where import qualified Data.ByteString as S-import Data.ByteString.Internal (ByteString(..), inlinePerformIO)+import Data.ByteString.Internal (ByteString(PS)) import Data.Word--import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)-import Foreign.Ptr (Ptr, plusPtr)-import Foreign.Storable (Storable(..))--{--#ifdef __USE_C_INTERNAL__-import Foreign.C.Types (CInt)-import Control.Monad (liftM)-#endif--}------------------------------------------------------------------+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Storable (Storable(..))+-- This module name is since @__GLASGOW_HASKELL__ >= 611@.+import GHC.IO (unsafeDupablePerformIO) +------------------------------------------------------------ -- | Associated type of 'ByteString'-type ByteStringElem = Word8 +type ByteStringElem = Word8 -----------------------------------------------------------------+------------------------------------------------------------ -- | Returns the longest shared prefix and the two remaining suffixes -- for a pair of strings. -- -- > s == (\(pre,s',z') -> pre `append` s') (breakMaximalPrefix s z) -- > z == (\(pre,s',z') -> pre `append` z') (breakMaximalPrefix s z)--breakMaximalPrefix :: ByteString -> ByteString- -> (ByteString, ByteString, ByteString) breakMaximalPrefix+ :: ByteString+ -> ByteString+ -> (ByteString, ByteString, ByteString)+breakMaximalPrefix str1@(PS s1 off1 len1) str2@(PS s2 off2 len2) | len1 == 0 = (S.empty, S.empty, str2) | len2 == 0 = (S.empty, str1, S.empty)- | otherwise = inlinePerformIO $+ | otherwise = unsafeDupablePerformIO $ withForeignPtr s1 $ \p1 -> withForeignPtr s2 $ \p2 -> do i <- indexOfDifference@@ -77,44 +58,45 @@ else newPS s2 off2 i let s1' = newPS s1 (off1 + i) (len1 - i) let s2' = newPS s2 (off2 + i) (len2 - i)- + return $! (,,) !$ pre !$ s1' !$ s2' --- | C-style pointer addition, without the liberal type of 'plusPtr'.+-- | Get the 'sizeOf' the type, without requiring @-XScopedTypeVariables@+-- nor making a spurious call to 'unsafePerformIO' or similar.+sizeOfPtr :: Storable a => Ptr a -> Int+sizeOfPtr = sizeOf . (undefined :: Ptr a -> a)+{-# INLINE sizeOfPtr #-}++-- | C-style pointer addition, without the excessively liberal type+-- of 'plusPtr'. ptrElemOff :: Storable a => Ptr a -> Int -> Ptr a+ptrElemOff p i = p `plusPtr` (i * sizeOfPtr p) {-# INLINE ptrElemOff #-}-ptrElemOff p i =- p `plusPtr` (i * sizeOf (undefined `asTypeOf` inlinePerformIO (peek p))) +-- | Smart-constructor to share 'S.empty' as appropriate. newPS :: ForeignPtr ByteStringElem -> Int -> Int -> ByteString+newPS s o l = if l <= 0 then S.empty else PS s o l {-# INLINE newPS #-}-newPS s o l =- if l <= 0 then S.empty else PS s o l -- | fix associativity bug (!$) :: (a -> b) -> a -> b-{-# INLINE (!$) #-} (!$) = ($!)+{-# INLINE (!$) #-} -----------------------------------------------------------------+------------------------------------------------------------+-- This naive algorithm doesn't depend on architecture details. We+-- could speed things up (in theory) by checking a natural word at+-- a time and then falling back to checking each byte once the+-- mismatched word is found. But in practice that doesn't seem to+-- actually speed things up.+-- -- | Calculates the first index where values differ.--indexOfDifference :: Ptr ByteStringElem -> Ptr ByteStringElem -> Int -> IO Int-{--#ifdef __USE_C_INTERNAL__--indexOfDifference p q i =- liftM fromIntegral $! c_indexOfDifference p q (fromIntegral i)---- This could probably be not IO, but the wrapper requires that anyways...-foreign import ccall unsafe "ByteStringInternal/indexOfDifference.h indexOfDifference"- c_indexOfDifference :: Ptr ByteStringElem -> Ptr ByteStringElem -> CInt -> IO CInt--#else--}---- Use the naive algorithm which doesn't depend on architecture details+indexOfDifference+ :: Ptr ByteStringElem+ -> Ptr ByteStringElem+ -> Int+ -> IO Int indexOfDifference p1 p2 limit = goByte 0 where goByte n =@@ -125,9 +107,6 @@ if c1 == c2 then goByte $! n+1 else return n-{--#endif--} ----------------------------------------------------------------------------------------------------------------------------- fin.+------------------------------------------------------------+------------------------------------------------------- fin.
− src/Data/Trie/ByteStringInternal/indexOfDifference.c
@@ -1,175 +0,0 @@-/* ---------------------------------------------------------------- ~ 2009.01.07--- |--- Module : Data.Trie.ByteStringInternal.indexOfDifference--- Copyright : Copyright (c) 2008--2015 wren gayle romano--- License : BSD3--- Maintainer : wren@community.haskell.org--- Stability : beta--- Portability : portable------ More efficient implementation (in theory) than testing characters--- byte by byte. However, the gains seem to be minimal and ---more--- importantly--- there seem to be obscure bugs that only show up--- in extensive testing (e.g. running TrieFile on /usr/dict). Maybe--- worth pursuing further, especially if SSE's 126-bit registers--- or GCC's vectors can be leveraged in a portable way.-------------------------------------------------------------- */--/* Defines certain architecture characteristics.- * Created by Configure.hs */-#include "indexOfDifference.h"--typedef unsigned char Word8;-typedef unsigned short Word16;-typedef unsigned long Word32;-typedef unsigned long long Word64;--/* Hopefully this makes Nat the most optimal size, or the same as int */-#ifdef __hDataTrie_Nat64__- typedef Word64 Nat;-# define MIN_NAT ((Nat) 0x8000000000000000ull)-#elif defined(__hDataTrie_Nat32__)- typedef Word32 Nat;-# define MIN_NAT ((Nat) 0x80000000)-#else- /* No definition. Unknown architecture.- * Maybe it'd be worth supporting 16-bit as well...?- * or maybe fail back to 8-bit? */-#endif--/* cf also <http://www.monkeyspeak.com/alignment/> */-#define NAT_MISALIGNMENT(p) (((int)(p)) % sizeof(Nat))---#define READ_WORD8(p) (*((Word8*) (p)))-#define READ_NAT(p) (*((Nat*) (p)))---/* ---------------------------------------------------------- */-/* Compare up to the first @limit@ bytes of @p1@ against @p2@- * and return the first index where they differ. */--/* TODO: Consider replacing loops by Duff's Device, or similar- <http://en.wikipedia.org/wiki/Duff%27s_device> */--int indexOfDifference(const void* p1, const void* p2, const int limit) {- /* @i@ measures how many bytes are shared,- * Thus it's the 0-based index of difference. */- int i = 0;- if (limit <= 0) return 0;- - - /* Munge until Nat-aligned (They seem to always be).- * Should fail back to this naive version on unknown arch */- {- int x1 = NAT_MISALIGNMENT(p1);- int x2 = NAT_MISALIGNMENT(p2);- if (x1 != x2) {- /* FIX: what if they're misaligned differently?- * For now we'll use Word8 all the way */- x1 = limit;- }- while (i < x1) {- if (READ_WORD8(p1+i) == READ_WORD8(p2+i)) {- i += sizeof(Word8);- } else {- return i;- }- }- if (x1 == limit) {- return limit;- } else {- /* Fall through */- }- }- - - /* Check one Nat at a time until we find a mismatch */- Nat diff;- do {- diff = READ_NAT(p1+i) ^ READ_NAT(p2+i);- - /* If the diff is valid and zero, then increment the loop */- if (i + sizeof(Nat) <= limit && diff == 0) {- i += sizeof(Nat);- } else {- break;- }- } while (i < limit);- - - /* Trim incomplete Nat at the end of the strings */- if (i + sizeof(Nat) > limit) {- #ifdef __hDataTrie_isLittleEndian__- diff &= ((1 << ((limit-i) * 8*sizeof(Word8))) - 1);- #else- diff &= MIN_NAT >> ((limit-i) * 8*sizeof(Word8) - 1);- #endif- - if (0 == diff) return limit;- }- - - /* Found a difference. Do binary search to identify first- * byte in Nat which doesn't match. */- Word32 w32;- #ifdef __hDataTrie_Nat64__- # ifdef __hDataTrie_isLittleEndian__- const Word32 first32 = (Word32) (diff & 0x00000000FFFFFFFFull);- # else- const Word32 first32 = (Word32)((diff & 0xFFFFFFFF00000000ull) >> 32);- # endif- if (0 == first32) {- i += 4;- # ifdef __hDataTrie_isLittleEndian__- w32 = (Word32)((diff & 0xFFFFFFFF00000000ull) >> 32);- # else- w32 = (Word32) (diff & 0x00000000FFFFFFFFull);- # endif- } else {- w32 = first32;- }- #elif defined(__hDataTrie_Nat32__)- w32 = diff;- #else- /* WTF? */- #endif- - - Word16 w16;- #if defined(__hDataTrie_Nat32__) || defined(__hDataTrie_Nat64__)- # ifdef __hDataTrie_isLittleEndian__- const Word16 first16 = (Word16) (w32 & 0x0000FFFF);- # else- const Word16 first16 = (Word16)((w32 & 0xFFFF0000) >> 16);- # endif- if (0 == first16) {- i += 2;- # ifdef __hDataTrie_isLittleEndian__- w16 = (Word16)((w32 & 0xFFFF0000) >> 16);- # else- w16 = (Word16) (w32 & 0x0000FFFF);- # endif- } else {- w16 = first16;- }- #else- /* WTF? */- #endif- - - Word8 w8;- #ifdef __hDataTrie_isLittleEndian__- const Word8 first8 = (Word8) (w16 & 0x00FF);- #else- const Word8 first8 = (Word8)((w16 & 0xFF00) >> 8);- #endif- if (0 == first8) {- i += 1;- }- - return i;-}-/* ---------------------------------------------------------- */-/* ----------------------------------------------------- fin. */
src/Data/Trie/Internal.hs view
@@ -2,16 +2,16 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs -fno-warn-unused-imports #-} {-# LANGUAGE NoImplicitPrelude #-} --- For list fusion on toListBy, and for applicative hiding+-- For list fusion on toListBy, and guarding `base` versions. {-# LANGUAGE CPP #-} -------------------------------------------------------------------- ~ 2014.10.09+------------------------------------------------------------+-- ~ 2019.02.24 -- | -- Module : Data.Trie.Internal--- Copyright : Copyright (c) 2008--2015 wren gayle romano+-- Copyright : Copyright (c) 2008--2019 wren gayle romano -- License : BSD3--- Maintainer : wren@community.haskell.org+-- Maintainer : wren@cpan.org -- Stability : provisional -- Portability : portable (with CPP) --@@ -20,32 +20,32 @@ -- from "Data.Trie", which is the preferred API for users. This -- module is for developers who need deeper (and potentially fragile) -- access to the abstract type.-----------------------------------------------------------------+------------------------------------------------------------ module Data.Trie.Internal ( -- * Data types Trie(), showTrie- + -- * Functions for 'ByteString's , breakMaximalPrefix- + -- * Basic functions , empty, null, singleton, size- + -- * Conversion and folding functions , foldrWithKey, toListBy- + -- * Query functions , lookupBy_, submap , match_, matches_- + -- * Single-value modification , alterBy, alterBy_, adjustBy- + -- * Combining tries , mergeBy- + -- * Mapping functions , mapBy , filterMap@@ -53,7 +53,7 @@ , contextualMap' , contextualFilterMap , contextualMapBy- + -- * Priority-queue functions , minAssoc, maxAssoc , updateMinViewBy, updateMaxViewBy@@ -67,7 +67,9 @@ import Data.Trie.BitTwiddle import Data.Binary-+#if MIN_VERSION_base(4,9,0)+import Data.Semigroup (Semigroup(..))+#endif import Data.Monoid (Monoid(..)) import Control.Monad (liftM, liftM3, liftM4) import Control.Monad (ap)@@ -78,13 +80,13 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Exts (build) #endif----------------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------+------------------------------------------------------------ -{---------------------------------------------------------------+{----------------------------------------------------------- -- ByteString Big-endian Patricia Trie datatype----------------------------------------------------------------}+-----------------------------------------------------------} {- In our idealized representation, we use a (directed) discrete graph to represent our finite state machine. To organize the set of@@ -173,9 +175,9 @@ -- TODO? add Ord instance like Data.Map? -{---------------------------------------------------------------+{----------------------------------------------------------- -- Trie instances: serialization et cetera----------------------------------------------------------------}+-----------------------------------------------------------} -- This instance does not unveil the innards of our abstract type. -- It doesn't emit truly proper Haskell code though, since ByteStrings@@ -191,7 +193,7 @@ showTrie t = shows' id t "" where spaces f = map (const ' ') (f "")- + shows' _ Empty = (".\n"++) shows' ss (Branch p m l r) = let s' = ("--"++) . shows p . (","++) . shows m . ("-+"++)@@ -213,7 +215,7 @@ put Empty = do 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@@ -221,9 +223,9 @@ _ -> liftM4 Branch get get get get -{---------------------------------------------------------------+{----------------------------------------------------------- -- Trie instances: Abstract Nonsense----------------------------------------------------------------}+-----------------------------------------------------------} instance Functor Trie where fmap f = go@@ -289,7 +291,7 @@ -- 3. (m >>= f) >>= g == m >>= (\x -> f x >>= g) instance Monad Trie where return = singleton S.empty- + (>>=) Empty _ = empty (>>=) (Branch p m l r) f = branch p m (l >>= f) (r >>= f) (>>=) (Arc k Nothing t) f = arc k Nothing (t >>= f)@@ -298,6 +300,17 @@ unionL = mergeBy (\x _ -> Just x) +#if MIN_VERSION_base(4,9,0)+-- The "Data.Semigroup" module is in base since 4.9.0.0; but having+-- the 'Semigroup' superclass for the 'Monoid' instance only comes+-- into force in base 4.11.0.0.+instance (Semigroup a) => Semigroup (Trie a) where+ (<>) = mergeBy $ \x y -> Just (x <> y)+ -- TODO: optimized implementations of:+ -- sconcat :: NonEmpty a -> a+ -- stimes :: Integral b => b -> a -> a+#endif+ -- This instance is more sensible than Data.IntMap and Data.Map's instance (Monoid a) => Monoid (Trie a) where mempty = empty@@ -328,9 +341,9 @@ -} -{---------------------------------------------------------------+{----------------------------------------------------------- -- Extra mapping functions----------------------------------------------------------------}+-----------------------------------------------------------} -- | Apply a function to all values, potentially removing them. filterMap :: (a -> Maybe b) -> Trie a -> Trie b@@ -397,9 +410,9 @@ go q (Branch p m l r) = branch p m (go q l) (go q r) -{---------------------------------------------------------------+{----------------------------------------------------------- -- Smart constructors and helper functions for building tries----------------------------------------------------------------}+-----------------------------------------------------------} -- | Smart constructor to prune @Empty@ from @Branch@es. branch :: Prefix -> Mask -> Trie a -> Trie a -> Trie a@@ -449,9 +462,9 @@ getPrefix Empty = error "getPrefix: no Prefix of Empty" -{---------------------------------------------------------------+{----------------------------------------------------------- -- Error messages----------------------------------------------------------------}+-----------------------------------------------------------} -- TODO: shouldn't we inline the logic and just NOINLINE the string constant? There are only three use sites, which themselves aren't inlined... errorLogHead :: String -> ByteString -> ByteStringElem@@ -461,12 +474,12 @@ | otherwise = S.head q ----------------------------------------------------------------------------------------------------------------------------------+------------------------------------------------------------+------------------------------------------------------------ -{---------------------------------------------------------------+{----------------------------------------------------------- -- Basic functions----------------------------------------------------------------}+-----------------------------------------------------------} -- | /O(1)/, Construct the empty trie. empty :: Trie a@@ -501,12 +514,12 @@ size' (Arc _ (Just _) t) f n = size' t f $! n + 1 -{------------------------------------------------------------------ Conversion functions ----------------------------------------------------------------}+{-----------------------------------------------------------+-- Conversion functions+-----------------------------------------------------------} -- Still rather inefficient--- +-- -- TODO: rewrite list-catenation to be lazier (real CPS instead of -- function building? is the function building really better than -- (++) anyways?)@@ -563,9 +576,9 @@ #endif -{---------------------------------------------------------------+{----------------------------------------------------------- -- Query functions (just recurse)----------------------------------------------------------------}+-----------------------------------------------------------} -- | Generic function to find a value (if it exists) and the subtrie -- rooted at the prefix. The first function argument is called if and@@ -582,10 +595,10 @@ -- | Deal with epsilon query (when there is no epsilon value) lookupBy_' q t@(Branch _ _ _ _) | S.null q = f Nothing t lookupBy_' q t = go q t- + -- | The main recursion go _ Empty = z- + go q (Arc k mv t) = let (_,k',q') = breakMaximalPrefix k q in case (not $ S.null k', S.null q') of@@ -593,11 +606,11 @@ (True, False) -> z (False, True) -> f mv t (False, False) -> go q' t- + go q t_@(Branch _ _ _ _) = findArc t_ where qh = errorLogHead "lookupBy_" q- + -- | /O(min(m,W))/, where /m/ is number of @Arc@s in this -- branching, and /W/ is the word size of the Prefix,Mask type. findArc (Branch p m l r)@@ -626,7 +639,7 @@ submap' Nothing Empty = errorEmptyAfterNothing "submap" submap' Nothing (Arc _ _ _) = errorArcAfterNothing "submap" submap' mx t = Arc q mx t- + errorInvariantBroken :: String -> String -> a {-# NOINLINE errorInvariantBroken #-} errorInvariantBroken s e = error (s ++ ": Invariant was broken" ++ e')@@ -659,10 +672,10 @@ -- | Deal with epsilon query (when there is no epsilon value) start q (Branch _ _ _ _) | S.null q = Nothing start q t = goNothing 0 q t- + -- | The initial recursion goNothing _ _ Empty = Nothing- + goNothing n q (Arc k mv t) = let (p,k',q') = breakMaximalPrefix k q n' = n + S.length p@@ -676,11 +689,11 @@ Nothing -> goNothing n' q' t Just v -> goJust n' v n' q' t else Nothing- + goNothing n q t_@(Branch _ _ _ _) = findArc t_ where qh = errorLogHead "match_" q- + -- | /O(min(m,W))/, where /m/ is number of @Arc@s in this -- branching, and /W/ is the word size of the Prefix,Mask type. findArc (Branch p m l r)@@ -689,10 +702,10 @@ | otherwise = findArc r findArc t@(Arc _ _ _) = goNothing n q t findArc Empty = Nothing- + -- | The main recursion goJust n0 v0 _ _ Empty = Just (n0,v0)- + goJust n0 v0 n q (Arc k mv t) = let (p,k',q') = breakMaximalPrefix k q n' = n + S.length p@@ -709,11 +722,11 @@ Nothing -> goJust n0 v0 n' q' t Just v -> goJust n' v n' q' t else Just (n0,v0)- + goJust n0 v0 n q t_@(Branch _ _ _ _) = findArc t_ where qh = errorLogHead "match_" q- + -- | /O(min(m,W))/, where /m/ is number of @Arc@s in this -- branching, and /W/ is the word size of the Prefix,Mask type. findArc (Branch p m l r)@@ -748,10 +761,10 @@ -- | Deal with epsilon query (when there is no epsilon value) start q (Branch _ _ _ _) | S.null q = id start q t = go 0 q t- + -- | The main recursion go _ _ Empty = id- + go n q (Arc k mv t) = let (p,k',q') = breakMaximalPrefix k q n' = n + S.length p@@ -762,11 +775,11 @@ . if S.null q' then id else go n' q' t else id- + go n q t_@(Branch _ _ _ _) = findArc t_ where qh = errorLogHead "matches_" q- + -- | /O(min(m,W))/, where /m/ is number of @Arc@s in this -- branching, and /W/ is the word size of the Prefix,Mask type. findArc (Branch p m l r)@@ -777,9 +790,9 @@ findArc Empty = id -{---------------------------------------------------------------+{----------------------------------------------------------- -- Single-value modification functions (recurse and clone spine)----------------------------------------------------------------}+-----------------------------------------------------------} -- TODO: We should CPS on Empty to avoid cloning spine if no change. -- Difficulties arise with the calls to 'branch' and 'arc'. Will@@ -796,7 +809,7 @@ -- TODO: benchmark to be sure that this doesn't introduce unforseen performance costs because of the uncurrying etc. --- | A variant of 'alterBy' which also allows modifying the sub-trie. +-- | A variant of 'alterBy' which also allows modifying the sub-trie. alterBy_ :: (ByteString -> a -> Maybe a -> Trie a -> (Maybe a, Trie a)) -> ByteString -> a -> Trie a -> Trie a alterBy_ f_ q_ x_@@ -805,22 +818,22 @@ where f = f_ q_ x_ nothing q = uncurry (arc q) (f Nothing Empty)- + alterEpsilon t_@Empty = uncurry (arc q_) (f Nothing t_) alterEpsilon t_@(Branch _ _ _ _) = uncurry (arc q_) (f Nothing t_) alterEpsilon t_@(Arc k mv t) | S.null k = uncurry (arc q_) (f mv t) | otherwise = uncurry (arc q_) (f Nothing t_)- - ++ go q Empty = nothing q- + go q t@(Branch p m l r) | nomatch qh p m = branchMerge p t qh (nothing q) | zero qh m = branch p m (go q l) r | otherwise = branch p m l (go q r) where qh = errorLogHead "alterBy" q- + go q t_@(Arc k mv t) = let (p,k',q') = breakMaximalPrefix k q in case (not $ S.null k', S.null q') of@@ -832,11 +845,11 @@ l -> arc' (branchMerge (getPrefix l) l (getPrefix r) r) where r = Arc k' mv t- + -- inlined version of 'arc' arc' | S.null p = id | otherwise = Arc p Nothing- + (False, True) -> uncurry (arc k) (f mv t) (False, False) -> arc k mv (go q' t) @@ -853,19 +866,19 @@ | otherwise = go q_ where f = f_ q_ x_- + adjustEpsilon (Arc k (Just v) t) | S.null k = Arc k (Just (f v)) t adjustEpsilon t_ = t_- + go _ Empty = Empty- + go q t@(Branch p m l r) | nomatch qh p m = t | zero qh m = Branch p m (go q l) r | otherwise = Branch p m l (go q r) where qh = errorLogHead "adjustBy" q- + go q t_@(Arc k mv t) = let (_,k',q') = breakMaximalPrefix k q in case (not $ S.null k', S.null q') of@@ -875,9 +888,9 @@ (False, False) -> Arc k mv (go q' t) -{---------------------------------------------------------------+{----------------------------------------------------------- -- Trie-combining functions----------------------------------------------------------------}+-----------------------------------------------------------} -- TEST CASES: foldr (unionL . uncurry singleton) empty t -- foldr (uncurry insert) empty t@@ -907,12 +920,12 @@ (Arc k1 mv1@(Just _) t1) | S.null k1 = arc k1 mv1 (go t1 t0_) mergeBy' t0_ t1_ = go t0_ t1_- - ++ -- | The main recursion go Empty t1 = t1 go t0 Empty = t0- + -- /O(n+m)/ for this part where /n/ and /m/ are sizes of the branchings go t0@(Branch p0 m0 l0 r0) t1@(Branch p1 m1 l1 r1)@@ -924,11 +937,11 @@ union0 | nomatch p1 p0 m0 = branchMerge p0 t0 p1 t1 | zero p1 m0 = branch p0 m0 (go l0 t1) r0 | otherwise = branch p0 m0 l0 (go r0 t1)- + union1 | nomatch p0 p1 m1 = branchMerge p0 t0 p1 t1 | zero p0 m1 = branch p1 m1 (go t0 l1) r1 | otherwise = branch p1 m1 l1 (go t0 r1)- + -- We combine these branches of 'go' in order to clarify where the definitions of 'p0', 'p1', 'm'', 'p'' are relevant. However, this may introduce inefficiency in the pattern matching automaton... -- TODO: check. And get rid of 'go'' if it does. go t0_ t1_ = go' t0_ t1_@@ -937,7 +950,7 @@ p1 = getPrefix t1_ m' = branchMask p0 p1 p' = mask p0 m'- + go' (Arc k0 mv0 t0) (Arc k1 mv1 t1) | m' == 0 =@@ -962,7 +975,7 @@ | nomatch p1 p0 m0 = branchMerge p0 t0_ p1 t1_ | zero p1 m0 = branch p0 m0 (go l t1_) r | otherwise = branch p0 m0 l (go r t1_)- + -- Inlined branchMerge. Both tries are disjoint @Arc@s now. go' _ _ | zero p0 m' = Branch p' m' t0_ t1_ go' _ _ = Branch p' m' t1_ t0_@@ -976,9 +989,9 @@ mergeMaybe f (Just v0) (Just v1) = f v0 v1 -{---------------------------------------------------------------+{----------------------------------------------------------- -- Priority-queue functions----------------------------------------------------------------}+-----------------------------------------------------------} minAssoc :: Trie a -> Maybe (ByteString, a) minAssoc = go S.empty@@ -1025,5 +1038,5 @@ go q (Arc k mv t) = mapView (arc k mv) (go (S.append q k) t) go q (Branch p m l r) = mapView (branch p m l) (go q r) ----------------------------------------------------------------------------------------------------------------------------- fin.+------------------------------------------------------------+------------------------------------------------------- fin.