radix-tree 0.1 → 1.0.0.0

raw patch · 77 files changed

+32092/−889 lines, 77 filesdep +hspecdep +randomdep +template-haskelldep −HUnitdep −QuickCheckdep −gaugedep ~basedep ~bytestringdep ~containerssetup-changednew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec, random, template-haskell

Dependencies removed: HUnit, QuickCheck, gauge, hashtables, tasty, tasty-hunit, tasty-quickcheck, unordered-containers

Dependency ranges changed: base, bytestring, containers, deepseq, primitive, text

API changes (from Hackage documentation)

Files

• Setup.hs +0/−2
• bench/RadixTreeBench.hs +0/−146
• no/No/Set/Word.hs +387/−0
• no/No/Tree.hs +632/−0
• radix-tree.cabal +136/−135
• src/Data/ByteArray/NonEmpty.hs +152/−0
• src/Data/Patricia/Word/Common.hs +9/−0
• src/Data/Patricia/Word/Conversion.hs +30/−0
• src/Data/Patricia/Word/Debug.hs +24/−0
• src/Data/Patricia/Word/Lazy.hs +246/−0
• src/Data/Patricia/Word/Lazy/Debug.hs +72/−0
• src/Data/Patricia/Word/Lazy/Internal.hs +2583/−0
• src/Data/Patricia/Word/Lazy/TH.hs +28/−0
• src/Data/Patricia/Word/Lazy/Unsafe.hs +75/−0
• src/Data/Patricia/Word/Strict.hs +278/−0
• src/Data/Patricia/Word/Strict/Debug.hs +72/−0
• src/Data/Patricia/Word/Strict/Internal.hs +3051/−0
• src/Data/Patricia/Word/Strict/TH.hs +28/−0
• src/Data/Patricia/Word/Strict/Unsafe.hs +78/−0
• src/Data/Radix1Tree/Word8/Key.hs +58/−0
• src/Data/Radix1Tree/Word8/Key/Unsafe.hs +88/−0
• src/Data/Radix1Tree/Word8/Lazy.hs +791/−0
• src/Data/Radix1Tree/Word8/Lazy/Debug.hs +30/−0
• src/Data/Radix1Tree/Word8/Lazy/TH.hs +20/−0
• src/Data/Radix1Tree/Word8/Lazy/Unsafe.hs +218/−0
• src/Data/Radix1Tree/Word8/Strict.hs +928/−0
• src/Data/Radix1Tree/Word8/Strict/Debug.hs +30/−0
• src/Data/Radix1Tree/Word8/Strict/TH.hs +20/−0
• src/Data/Radix1Tree/Word8/Strict/Unsafe.hs +250/−0
• src/Data/RadixNTree/Word8/Common.hs +25/−0
• src/Data/RadixNTree/Word8/Conversion.hs +38/−0
• src/Data/RadixNTree/Word8/Debug.hs +29/−0
• src/Data/RadixNTree/Word8/Key.hs +379/−0
• src/Data/RadixNTree/Word8/Lazy.hs +5076/−0
• src/Data/RadixNTree/Word8/Lazy/Debug.hs +109/−0
• src/Data/RadixNTree/Word8/Lazy/TH.hs +41/−0
• src/Data/RadixNTree/Word8/Strict.hs +5643/−0
• src/Data/RadixNTree/Word8/Strict/Debug.hs +109/−0
• src/Data/RadixNTree/Word8/Strict/TH.hs +41/−0
• src/Data/RadixTree.hs +0/−33
• src/Data/RadixTree/Internal.hs +0/−454
• src/Data/RadixTree/Word8/Key.hs +90/−0
• src/Data/RadixTree/Word8/Key/Unsafe.hs +32/−0
• src/Data/RadixTree/Word8/Lazy.hs +789/−0
• src/Data/RadixTree/Word8/Lazy/Debug.hs +30/−0
• src/Data/RadixTree/Word8/Lazy/TH.hs +20/−0
• src/Data/RadixTree/Word8/Lazy/Unsafe.hs +57/−0
• src/Data/RadixTree/Word8/Strict.hs +926/−0
• src/Data/RadixTree/Word8/Strict/Debug.hs +30/−0
• src/Data/RadixTree/Word8/Strict/TH.hs +20/−0
• src/Data/RadixTree/Word8/Strict/Unsafe.hs +71/−0
• src/Data/Zebra/Word.hs +140/−0
• src/Data/Zebra/Word/Debug.hs +114/−0
• src/Data/Zebra/Word/Internal.hs +2906/−0
• src/Data/Zebra/Word/Unsafe.hs +76/−0
• src/Numeric/Long.hs +47/−0
• src/Radix/Common.hs +53/−0
• src/Radix/Exception.hs +21/−0
• src/Radix/Word/Common.hs +36/−0
• src/Radix/Word/Debug.hs +23/−0
• src/Radix/Word/Foundation.hs +68/−0
• src/Radix/Word8/Common.hs +10/−0
• src/Radix/Word8/Debug.hs +23/−0
• src/Radix/Word8/Foundation.hs +62/−0
• test/TestMain.hs +0/−119
• test/properties/Main.hs +33/−0
• test/properties/Test/Kit.hs +60/−0
• test/properties/Test/Patricia/Word/Lazy.hs +795/−0
• test/properties/Test/Patricia/Word/Sample.hs +140/−0
• test/properties/Test/Patricia/Word/Strict.hs +907/−0
• test/properties/Test/RadixNTree/Word8/Key.hs +154/−0
• test/properties/Test/RadixNTree/Word8/Sample.hs +268/−0
• test/properties/Test/RadixTree/Word8/Lazy.hs +820/−0
• test/properties/Test/RadixTree/Word8/Strict.hs +848/−0
• test/properties/Test/Random.hs +42/−0
• test/properties/Test/Zebra/Word.hs +344/−0
• test/properties/Test/Zebra/Word/Sample.hs +233/−0

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,146 +0,0 @@-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main (main) where--import Control.Arrow-import Control.DeepSeq-import Control.Exception--import Data.Foldable--import qualified Data.ByteString.Short as BSS-import qualified Data.HashMap.Strict as HM-import qualified Data.Map.Strict as M-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.IO as TLIO--import qualified Data.HashTable.IO as HT--import Gauge--import qualified Data.RadixTree.Internal as RT--main :: IO ()-main = do-  let config = defaultConfig-        { resamples   = 10000-        , displayMode = Condensed-        , rerunsLimit = 1-        }--  contents <- TLIO.readFile "/tmp/tags-ebac8dcc87fd1f1b1e7016d6585549309e3c5016-haskell-mode"-  let tags :: [TL.Text]-      tags = filter (not . TL.null) $ map (head . TL.splitOn "\t") $ drop 1 $ TL.lines contents--      decodeBS = TE.encodeUtf8 . TL.toStrict-      decode = BSS.toShort . decodeBS--      tags' :: [BSS.ShortByteString]-      tags' = map decode tags--      tags'' :: [(BSS.ShortByteString, ())]-      tags'' = map (id &&& const ()) tags'--      tagsRev'' :: [(BSS.ShortByteString, ())]-      tagsRev'' = map ((BSS.pack . reverse . BSS.unpack) &&& const ()) tags'--      -- tagsBS :: [(BS.ByteString, ())]-      -- tagsBS = map (decodeBS &&& const ()) tags--      queriesPresent :: [BSS.ShortByteString]-      queriesPresent = tags' ++ map (BSS.pack . reverse . BSS.unpack) tags'--      queriesMissing :: [BSS.ShortByteString]-      queriesMissing = map (BSS.pack . reverse . BSS.unpack) tags'--      queriesBoth :: [BSS.ShortByteString]-      queriesBoth = tags' ++ map (BSS.pack . reverse . BSS.unpack) tags'--  evaluate $ rnf tags'-  evaluate $ rnf tags''-  evaluate $ rnf tagsRev''-  evaluate $ rnf queriesPresent-  evaluate $ rnf queriesMissing-  evaluate $ rnf queriesBoth--  let radixTree    = RT.fromList tags''-      radixTreeRev = RT.fromList tagsRev''-      treeMap      = M.fromList  tags''-      treeMapRev   = M.fromList  tagsRev''-      hashMap      = HM.fromList tags''-      hashMapRev   = HM.fromList tagsRev''--  evaluate $ rnf radixTree-  evaluate $ rnf radixTreeRev-  evaluate $ rnf treeMap-  evaluate $ rnf treeMapRev-  evaluate $ rnf hashMap-  evaluate $ rnf hashMapRev--  (basic  :: HT.BasicHashTable  BSS.ShortByteString ()) <- HT.new-  -- (linear :: HT.LinearHashTable BSS.ShortByteString ()) <- HT.new-  (cuckoo :: HT.CuckooHashTable BSS.ShortByteString ()) <- HT.new-  for_ tags'' $ \(k, v) -> do-    HT.insert basic  k v-    -- HT.insert linear k v-    HT.insert cuckoo k v--  defaultMainWith config-    [ bgroup "creation"-      [ bench "Data.RadixTree"  $ nf RT.fromList tags''-      , bench "Data.Map"        $ nf M.fromList tags''-      , bench "Data.HashMap"    $ nf HM.fromList tags''-      , bench "BasicHashTable"  $ nfIO $ do-          (ht :: HT.BasicHashTable  BSS.ShortByteString ()) <- HT.new-          for_ tags'' $ \(k, v) -> HT.insert ht k v-      -- , bench "LinearHashTable"  $ nfIO $ do-      --     (ht :: HT.LinearHashTable BSS.ShortByteString ()) <- HT.new-      --     for_ tags'' $ \(k, v) -> HT.insert ht k v-      , bench "CuckooHashTable"  $ nfIO $ do-          (ht :: HT.CuckooHashTable BSS.ShortByteString ()) <- HT.new-          for_ tags'' $ \(k, v) -> HT.insert ht k v-      ]-    , bgroup "lookup"-        [ bgroup "present"-          [ bench "Data.RadixTree"  $ nf (map (`RT.lookup` radixTree)) queriesPresent-          , bench "Data.Map"        $ nf (map (`M.lookup`  treeMap))   queriesPresent-          , bench "Data.HashMap"    $ nf (map (`HM.lookup` hashMap))   queriesPresent-          , bench "BasicHashTable"  $ nfIO $ traverse (HT.lookup basic)  queriesPresent-          -- , bench "LinearHashTable" $ nfIO $ traverse (HT.lookup linear) queriesPresent-          , bench "CuckooHashTable" $ nfIO $ traverse (HT.lookup cuckoo) queriesPresent-          ]-        , bgroup "missing"-          [ bench "Data.RadixTree"  $ nf (map (`RT.lookup` radixTree)) queriesMissing-          , bench "Data.Map"        $ nf (map (`M.lookup`  treeMap))   queriesMissing-          , bench "Data.HashMap"    $ nf (map (`HM.lookup` hashMap))   queriesMissing-          , bench "BasicHashTable"  $ nfIO $ traverse (HT.lookup basic)  queriesMissing-          -- , bench "LinearHashTable" $ nfIO $ traverse (HT.lookup linear) queriesMissing-          , bench "CuckooHashTable" $ nfIO $ traverse (HT.lookup cuckoo) queriesMissing-          ]-        , bgroup "both"-          [ bench "Data.RadixTree"  $ nf (map (`RT.lookup` radixTree)) queriesBoth-          , bench "Data.Map"        $ nf (map (`M.lookup`  treeMap))   queriesBoth-          , bench "Data.HashMap"    $ nf (map (`HM.lookup` hashMap))   queriesBoth-          , bench "BasicHashTable"  $ nfIO $ traverse (HT.lookup basic)  queriesBoth-          -- , bench "LinearHashTable" $ nfIO $ traverse (HT.lookup linear) queriesBoth-          , bench "CuckooHashTable" $ nfIO $ traverse (HT.lookup cuckoo) queriesBoth-          ]-        ]-    , bgroup "keys"-      [ bench "Data.RadixTree" $ nf RT.keys radixTree-      , bench "Data.Map"       $ nf M.keys treeMap-      , bench "Data.HashMap"   $ nf HM.keys hashMap-      ]-    , bgroup "toList"-      [ bench "Data.RadixTree" $ nf RT.toList radixTree-      , bench "Data.Map"       $ nf M.toList treeMap-      , bench "Data.HashMap"   $ nf HM.toList hashMap-      ]-    , bgroup "union"-      [ bench "Data.RadixTree" $ nf (uncurry RT.union) (radixTree, radixTreeRev)-      , bench "Data.Map"       $ nf (uncurry M.union) (treeMap, treeMapRev)-      , bench "Data.HashMap"   $ nf (uncurry HM.union) (hashMap, hashMapRev)-      ]-    ]

@@ -0,0 +1,387 @@+{-# LANGUAGE DerivingStrategies+           , GeneralizedNewtypeDeriving+           , PatternSynonyms+           , ViewPatterns #-}++module No.Set.Word+  ( Color (..)+  , other++  , NoSet (Mono, ..)++  , No.Set.Word.lookup+  , lookupL+  , findL+  , lookupR+  , findR++  , Range (..)+  , monoL+  , monoR+  , monoRange++  , size+  , sizeL+  , sizeR+  , sizeRange++  , fillL+  , fillR+  , fillRange++  , No.Set.Word.foldl+  , No.Set.Word.foldl'+  , No.Set.Word.foldr+  , No.Set.Word.foldr'++  , foldlL+  , foldlL'+  , foldrL+  , foldrL'++  , foldlR+  , foldlR'+  , foldrR+  , foldrR'++  , foldlRange+  , foldlRange'+  , foldrRange+  , foldrRange'++  , complement++  , union+  , disjoint+  , intersection++  , difference+  , symmetricDifference++  , PartialOrdering (..)+  , No.Set.Word.compare+  ) where+++import           Data.Zebra.Word (Color (..), PartialOrdering (..))+import           Data.Zebra.Word.Unsafe (Range (..))++import           Data.Foldable+import           Data.Sequence (Seq (..))+import qualified Data.Sequence as Seq+import           Numeric.Natural++++other :: Color -> Color+other Black = White+other White = Black++++newtype NoSet = NoSet { getNoSet :: Seq (Color, Word, Word) }+                deriving newtype Eq++instance Show NoSet where+  showsPrec _ (NoSet xs) =+    showList . fmap (\(_, kL, kR) -> (kL, kR))+             . filter (\(c, _, _) -> c == White)+             $ toList xs++pattern Mono :: Color -> NoSet+pattern Mono c <- (monotone -> Just c)+  where+    Mono c = NoSet $ Seq.singleton (c, 0, maxBound)++monotone :: NoSet -> Maybe Color+monotone (NoSet (Seq.Empty Seq.:|> (c, _, _))) = Just c+monotone _                                     = Nothing++++lookup :: Word -> NoSet -> Color+lookup w no =+  let ~(NoSet l, _) = unsafeSplitL w no+  in case l of+       _ :|> (c, _, _) -> c+       Empty           ->+         error $ "No.Set.Word.lookup: out of bounds (" <> shows w ")"++++lookupL :: Color -> Word -> NoSet -> Maybe Word+lookupL x w no =+  let ~(NoSet l, _) = unsafeSplitL w no+  in case l of+       _ :|> _ -> go l+       Empty   ->+         error $ "No.Set.Word.lookupL: out of bounds (" <> shows w ")"++  where+    go (l :|> (c, _, b)) | c == x    = Just b+                         | otherwise = go l+    go Empty = Nothing++findL :: Word -> Color -> Word -> NoSet -> Word+findL d x w no =+  case lookupL x w no of+    Just a  -> a+    Nothing -> d++++lookupR :: Color -> Word -> NoSet -> Maybe Word+lookupR x w no =+  let ~(_, NoSet r) = unsafeSplitR w no+  in case r of+       _ :<| _ -> go r+       Empty   ->+         error $ "No.Set.Word.lookupR: out of bounds (" <> shows w ")"++  where+    go ((c, a, _) :<| r) | c == x    = Just a+                         | otherwise = go r+    go Empty = Nothing++findR :: Word -> Color -> Word -> NoSet -> Word+findR d x w no =+  case lookupR x w no of+    Just a  -> a+    Nothing -> d++++monoL :: Word -> NoSet -> Maybe Color+monoL k = monotone . fst . unsafeSplitL k++monoR :: Word -> NoSet -> Maybe Color+monoR k = monotone . snd . unsafeSplitR k++monoRange :: Range -> NoSet -> Maybe Color+monoRange r = monotone . (\(_, m, _) -> m) . unsafeSplitRange r++++size :: Color -> NoSet -> Natural+size x =+  let f (c, a, b) z+        | c == x    = fromIntegral (b - a) + 1 + z+        | otherwise = z++  in Data.Foldable.foldr f 0 . getNoSet++sizeL :: Color -> Word -> NoSet -> Natural+sizeL x k = size x . fst . unsafeSplitL k++sizeR :: Color -> Word -> NoSet -> Natural+sizeR x k = size x . snd . unsafeSplitR k++sizeRange :: Color -> Range -> NoSet -> Natural+sizeRange x r = size x . (\(_, m, _) -> m) . unsafeSplitRange r++++fillL :: Word -> Color -> NoSet -> NoSet+fillL w x no =+  let ~(_, NoSet _r) = unsafeSplitL w no+  in case _r of+       (c, _, b) :<| r | c == x    -> NoSet $ (c, 0, b) :<| r+                       | otherwise -> NoSet $ (x, 0, w) :<| _r++       _                           -> Mono x++fillR :: Word -> Color -> NoSet -> NoSet+fillR w x no =+  let ~(NoSet _l, _) = unsafeSplitR w no+  in case _l of+       l :|> (c, a, _) | c == x    -> NoSet $ l :|> (c, a, maxBound)+                       | otherwise -> NoSet $ _l :|> (x, w, maxBound)++       _                           -> Mono x++fillRange :: Range -> Color -> NoSet -> NoSet+fillRange rng@(Range kL kR) x no =+  let ~(NoSet _l, _, NoSet _r) = unsafeSplitRange rng no+  in case (_l, _r) of+       (l :|> (cL, a, _), (cR, _, b) :<| r) ->+         case (cL == cR, cL == x) of+           (True , True ) -> NoSet $ l <> ((x, a, b) :<| r)+           (True , False) -> NoSet $ _l <> ((x, kL, kR) :<| _r)+           (False, True ) -> NoSet $ (l :|> (x, a, kR)) <> _r+           (False, False) -> NoSet $ _l <> ((x, a, b) :<| r)++       (l :|> (cL, a, _), Empty)+         | cL == x   -> NoSet $ l :|> (cL, a, maxBound)+         | otherwise -> NoSet $ _l :|> (x, kL, maxBound)++       (Empty, (cR, _, b) :<| r)+         | cR == x   -> NoSet $ (cR, 0, b) :<| r+         | otherwise -> NoSet $ (x, 0, kR) :<| _r++       (Empty, Empty) -> Mono x++++unsafeSplitL :: Word -> NoSet -> (NoSet, NoSet)+unsafeSplitL k (NoSet xs) =+  let ~(_l, r) = Seq.spanl (\(_, a, _) -> a <= k) xs+  in case _l of+       l :|> (c, a, b) | b > k -> (NoSet $ l :|> (c, a, k), NoSet $ (c, k + 1, b) :<| r)+       _                       -> (NoSet _l, NoSet r)++unsafeSplitR :: Word -> NoSet -> (NoSet, NoSet)+unsafeSplitR k (NoSet xs) =+  let ~(_r, l) = Seq.spanr (\(_, _, b) -> b >= k) xs+  in case _r of+      (c, a, b) :<| r | a < k -> (NoSet $ l :|> (c, a, k - 1), NoSet $ (c, k, b) :<| r)+      _                       -> (NoSet l, NoSet _r)++unsafeSplitRange :: Range -> NoSet -> (NoSet, NoSet, NoSet)+unsafeSplitRange (Range kL kR) no =+  let ~(l, no') = unsafeSplitR kL no+      ~(m, r)   = unsafeSplitL kR no'+  in (l, m, r)++++foldl, foldl' :: (a -> Range -> Color -> a) -> a -> NoSet -> a+foldl  f z0 = Data.Foldable.foldl  (\z (c, a, b) -> f z (UnsafeRange a b) c) z0 . getNoSet+foldl' f z0 = Data.Foldable.foldl' (\z (c, a, b) -> f z (UnsafeRange a b) c) z0 . getNoSet++foldr, foldr' :: (Range -> Color -> a -> a) -> a -> NoSet -> a+foldr  f z0 = Data.Foldable.foldr  (\(c, a, b) -> f (UnsafeRange a b) c) z0 . getNoSet+foldr' f z0 = Data.Foldable.foldr' (\(c, a, b) -> f (UnsafeRange a b) c) z0 . getNoSet++++foldlL, foldlL' :: Word -> (a -> Range -> Color -> a) -> a -> NoSet -> a+foldlL  w f z = No.Set.Word.foldl  f z . fst . unsafeSplitL w+foldlL' w f z = No.Set.Word.foldl' f z . fst . unsafeSplitL w++foldrL, foldrL' :: Word -> (Range -> Color -> a -> a) -> a -> NoSet -> a+foldrL  w f z = No.Set.Word.foldr  f z . fst . unsafeSplitL w+foldrL' w f z = No.Set.Word.foldr' f z . fst . unsafeSplitL w++++foldlR, foldlR' :: Word -> (a -> Range -> Color -> a) -> a -> NoSet -> a+foldlR  w f z = No.Set.Word.foldl  f z . snd . unsafeSplitR w+foldlR' w f z = No.Set.Word.foldl' f z . snd . unsafeSplitR w++foldrR, foldrR' :: Word -> (Range -> Color -> a -> a) -> a -> NoSet -> a+foldrR  w f z = No.Set.Word.foldr  f z . snd . unsafeSplitR w+foldrR' w f z = No.Set.Word.foldr' f z . snd . unsafeSplitR w++++foldlRange, foldlRange' :: Range -> (a -> Range -> Color -> a) -> a -> NoSet -> a+foldlRange  r f z = No.Set.Word.foldl  f z . (\(_, m, _) -> m) . unsafeSplitRange r+foldlRange' r f z = No.Set.Word.foldl' f z . (\(_, m, _) -> m) . unsafeSplitRange r++foldrRange, foldrRange' :: Range -> (Range -> Color -> a -> a) -> a -> NoSet -> a+foldrRange  r f z = No.Set.Word.foldr  f z . (\(_, m, _) -> m) . unsafeSplitRange r+foldrRange' r f z = No.Set.Word.foldr' f z . (\(_, m, _) -> m) . unsafeSplitRange r++++-- | Combines two sets into an ascending non-overlapping list of+--   consecutive double-colored ranges.+--+--   Both sets must be defined over the same ranges for this function to make sense.+crush :: NoSet -> NoSet -> [(Color, Range, Color)]+crush (NoSet xs) (NoSet ys) = go xs ys+  where+    go Empty                Empty                = []+    go ((cL, aL, bL) :<| l) ((cR, aR, bR) :<| r) =+      case bL `Prelude.compare` bR of+        LT -> (cL, UnsafeRange aL bL, cR) : go l ((cR, bL + 1, bR) :<| r)+        GT -> (cL, UnsafeRange aR bR, cR) : go ((cL, bR + 1, bL) :<| l) r+        EQ -> (cL, UnsafeRange aL bL, cR) : go l r++    go _ _ =+      error "No.Set.Word.crush: unequally sized sets"++++complement :: NoSet -> NoSet+complement = NoSet . fmap (\(c, a, b) -> (other c, a, b)) . getNoSet++++union :: Color -> NoSet -> NoSet -> NoSet+union x =+  merge $ \cL cR ->+    if cL == cR && cL /= x+      then cL+      else x++disjoint :: Color -> NoSet -> NoSet -> Bool+disjoint x a b =+  case intersection x a b of+    Mono y -> x /= y+    _      -> False++intersection :: Color -> NoSet -> NoSet -> NoSet+intersection x =+  merge $ \cL cR ->+    if cL == cR && cL == x+      then x+      else other x++difference :: Color -> NoSet -> NoSet -> NoSet+difference x =+  merge $ \cL cR ->+    if cL /= cR && cL == x+      then x+      else other x++symmetricDifference :: Color -> NoSet -> NoSet -> NoSet+symmetricDifference x =+  merge $ \cL cR ->+    if cL == cR+      then other x+      else x+++++data Carry = Carry Color Word+           | NoCarry++merge :: (Color -> Color -> Color) -> NoSet -> NoSet -> NoSet+merge f as bs = NoSet . Seq.fromList . unify NoCarry $ crush as bs+  where+    unify carry [] =+      case carry of+        NoCarry   -> []+        Carry c k -> (c, k, maxBound) : []++    unify carry ((cL, Range a _, cR) : rest) =+      let cM = f cL cR+      in case carry of+           NoCarry   -> unify (Carry cM a) rest+           Carry c k+             | c == cM   -> unify carry rest+             | otherwise -> (c, k, a - 1) : unify (Carry cM a) rest++++compare :: Color -> NoSet -> NoSet -> PartialOrdering+compare x as bs = Data.Foldable.foldr go Equal $ crush as bs+  where+    go (cL, _, cR) p =+      case p of+        Subset+          | cL == cR || cR == x -> Subset+          | otherwise           -> Incomparable++        Superset+          | cL == cR || cL == x -> Superset+          | otherwise           -> Incomparable++        Equal+          | cL == cR  -> Equal+          | cR == x   -> Subset+          | otherwise -> Superset++        Incomparable -> Incomparable

@@ -0,0 +1,632 @@+{-# LANGUAGE DerivingStrategies+           , GeneralizedNewtypeDeriving+           , PatternSynonyms #-}++module No.Tree+  ( NoTree+  , empty+  , singleton++  , No.Tree.null++  , fromList+  , No.Tree.toList++  , No.Tree.map+  , mapWithKey++  , size+  , No.Tree.foldl+  , foldlWithKey+  , No.Tree.foldr+  , foldrWithKey+  , No.Tree.foldMap+  , foldMapWithKey++  , No.Tree.traverse+  , traverseWithKey++  , No.Tree.lookup+  , find+  , member++  , prefix+  , subtree++  , insert+  , insertWith+  , adjust+  , delete+  , update+  , alter++  , prune+  , shape++  , Openness (..)+  , lookupL+  , adjustL+  , adjustLWithKey+  , deleteL+  , updateL+  , updateLWithKey+  , takeL++  , lookupR+  , adjustR+  , adjustRWithKey+  , deleteR+  , updateR+  , updateRWithKey+  , takeR++  , Range (WordRange, StringRange, ..)+  , adjustRange+  , adjustRangeWithKey+  , deleteRange+  , updateRange+  , updateRangeWithKey+  , takeRange++  , unionL+  , unionWithKey++  , difference+  , differenceWithKey++  , intersectionL+  , intersectionWithKey++  , No.Tree.compare++  , splitL+  , splitR+  , splitLookup++  , No.Tree.filter+  , filterWithKey++  , No.Tree.mapMaybe+  , mapMaybeWithKey++  , partition+  , partitionWithKey++  , mapEither+  , mapEitherWithKey++  , lookupMin+  , lookupMinWithKey+  , lookupMax+  , lookupMaxWithKey++  , adjustMin+  , adjustMinWithKey+  , adjustMax+  , adjustMaxWithKey++  , deleteMin+  , deleteMax++  , updateMin+  , updateMinWithKey+  , updateMax+  , updateMaxWithKey++  , minView+  , maxView+  ) where++import           Data.Patricia.Word.Strict (PartialOrdering (..))+import           Data.RadixTree.Word8.Strict (Openness (..))++import           Data.Sequence (Seq (..))+import qualified Data.Sequence as Seq+import           Data.Maybe+import           Data.Either+import           Data.Foldable (toList)+import qualified Data.List as List+import           Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NonEmpty++++newtype NoTree k a = NoTree { getNoTree :: Seq (k, a) }+                     deriving newtype (Show, Eq)++empty :: NoTree k a+empty = NoTree Seq.empty++singleton :: k -> a -> NoTree k a+singleton k a = NoTree $ Seq.singleton (k, a)+++null :: NoTree k a -> Bool+null = Seq.null . getNoTree++++fromList :: Ord k => [(k, a)] -> NoTree k a+fromList = NoTree . Seq.fromList . List.nubBy (\(k, _) (l, _) -> k == l) . List.sortOn fst++toList :: NoTree k a -> [(k, a)]+toList (NoTree as) = Data.Foldable.toList as++++map :: (a -> b) -> NoTree k a -> NoTree k b+map f = mapWithKey (\_ -> f)++mapWithKey :: (k -> a -> b) -> NoTree k a -> NoTree k b+mapWithKey f (NoTree as) = NoTree $ fmap (\(ks, a) -> (ks, f ks a)) as+++size :: NoTree k a -> Int+size = No.Tree.foldr (\_ -> (+) 1) 0++foldl :: (b -> a -> b) -> b -> NoTree k a -> b+foldl f = foldlWithKey (\z _ -> f z)++foldlWithKey :: (b -> k -> a -> b) -> b -> NoTree k a -> b+foldlWithKey f z (NoTree as) = Prelude.foldl (\z' (ks, a) -> f z' ks a) z as++foldr :: (a -> b -> b) -> b -> NoTree k a -> b+foldr f = foldrWithKey (\_ -> f)++foldrWithKey :: (k -> a -> b -> b) -> b -> NoTree k a -> b+foldrWithKey f z (NoTree as) = Prelude.foldr (\(ks, a) -> f ks a) z as++foldMap :: Monoid m => (a -> m) -> NoTree k a -> m+foldMap f = foldMapWithKey (\_ -> f)++foldMapWithKey :: Monoid m => (k -> a -> m) -> NoTree k a -> m+foldMapWithKey f (NoTree as) = Prelude.foldMap (\(ks, a) -> f ks a) as++traverse :: Applicative f => (a -> f b) -> NoTree k a -> f (NoTree k b)+traverse f = traverseWithKey (\_ -> f)++traverseWithKey+  :: Applicative f => (k -> a -> f b) -> NoTree k a -> f (NoTree k b)+traverseWithKey f (NoTree as) =+  NoTree <$> Prelude.traverse (\(ks, a) -> (,) ks <$> f ks a) as++++lookup :: Ord k => k -> NoTree k a -> Maybe a+lookup k = (\(_, mx, _) -> mx) <$> splitLookup k++find :: Ord k => a -> k -> NoTree k a -> a+find d k = (\(_, mx, _) -> fromMaybe d mx) <$> splitLookup k++member :: Ord k => k -> NoTree k a -> Bool+member k = (\(_, mx, _) -> maybe False (\_ -> True) mx) <$> splitLookup k++++subtree :: Ord k => [k] -> NoTree [k] a -> NoTree [k] a+subtree ks (NoTree as) =+  let (_, bs) = Seq.spanl (\(w, _) -> not $ List.isPrefixOf ks w) as+      (cs, _) = Seq.spanl (\(w, _) ->       List.isPrefixOf ks w) bs++  in NoTree $ fmap (\(k, a) -> (drop (length ks) k, a)) cs++prefix :: [k] -> NoTree [k] a -> NoTree [k] a+prefix k (NoTree as) = NoTree $ fmap (\(w, a) -> (k <> w, a)) as++++insert :: Ord k => k -> a -> NoTree k a -> NoTree k a+insert k a = alter (\_ -> Just a) k++insertWith :: Ord k => (a -> a) -> k -> a -> NoTree k a -> NoTree k a+insertWith f k a = alter (Just . maybe a f) k++adjust :: Ord k => (a -> a) -> k -> NoTree k a -> NoTree k a+adjust f = alter (fmap f)++delete :: Ord k => k -> NoTree k a -> NoTree k a+delete k = alter (\_ -> Nothing) k++update :: Ord k => (a -> Maybe a) -> k -> NoTree k a -> NoTree k a+update f k = alter (f =<<) k++alter :: Ord k => (Maybe a -> Maybe a) -> k -> NoTree k a -> NoTree k a+alter f k no =+  let ~(NoTree as, mx, NoTree bs) = splitLookup k no+  in case f mx of+       Just y  -> NoTree $ as <> ((k, y) :<| bs)+       Nothing -> NoTree $ as <> bs++++prune :: Ord k => Openness -> [k] -> NoTree [k] a -> NoTree [k] a+prune o ks xs =+  let (NoTree ls, NoTree ms, NoTree rs) = breakOnPrefix ks xs++  in NoTree $ ls <> case ms of+                      (x, y) :<| _ | x == ks, Open <- o -> (x, y) :<| rs+                      _                                 -> rs++shape :: Ord k => (NoTree [k] a -> NoTree [k] a) -> [k] -> NoTree [k] a -> NoTree [k] a+shape f ks xs =+  let (NoTree ls, NoTree ms, NoTree rs) = breakOnPrefix ks xs++      NoTree ms' = f . NoTree $ fmap (\(k, a) -> (drop (length ks) k, a)) ms++  in NoTree $ ls <> fmap (\(k, a) -> (ks <> k, a)) ms' <> rs++breakOnPrefix :: Ord k => [k] -> NoTree [k] a -> (NoTree [k] a, NoTree [k] a, NoTree [k] a)+breakOnPrefix ks (NoTree xs) =+  let ~(as, bs) = Seq.spanl (\(ws, _) -> take (length ks) ws < ks) xs+      ~(cs, ds) = Seq.spanl (\(ws, _) -> List.isPrefixOf ks ws) bs++  in (NoTree as, NoTree cs, NoTree ds)++++lookupL :: Ord k => Openness -> k -> NoTree k a -> Maybe (k, a)+lookupL o k no =+  let NoTree as = takeL o k no+  in case as of+       _ :|> ka  -> Just ka+       Seq.Empty -> Nothing++adjustL :: Ord k => (a -> a) -> Openness -> k -> NoTree k a -> NoTree k a+adjustL f = shapeL (No.Tree.map f)++adjustLWithKey :: Ord k => (k -> a -> a) -> Openness -> k -> NoTree k a -> NoTree k a+adjustLWithKey f = shapeL (mapWithKey f)++deleteL :: Ord k => Openness -> k -> NoTree k a -> NoTree k a+deleteL = shapeL (\_ -> empty)++updateL :: Ord k => (a -> Maybe a) -> Openness -> k -> NoTree k a -> NoTree k a+updateL f = shapeL (No.Tree.mapMaybe f)++updateLWithKey :: Ord k => (k -> a -> Maybe a) -> Openness -> k -> NoTree k a -> NoTree k a+updateLWithKey f = shapeL (mapMaybeWithKey f)++takeL :: Ord k => Openness -> k -> NoTree k a -> NoTree k a+takeL Closed = deleteR Open+takeL Open   = deleteR Closed++shapeL :: Ord k => (NoTree k a -> NoTree k a) -> Openness -> k -> NoTree k a -> NoTree k a+shapeL f o k no =+  let ~(NoTree as, mx, NoTree bs) = splitLookup k no+  in case mx of+       Nothing -> NoTree $ getNoTree (f $ NoTree as) <> bs+       Just x  ->+         case o of+           Closed -> NoTree $ getNoTree (f $ NoTree (as :|> (k, x))) <> bs+           Open   -> NoTree $ getNoTree (f $ NoTree as) <> ((k, x) :<| bs)++++lookupR :: Ord k => Openness -> k -> NoTree k a -> Maybe (k, a)+lookupR o k no =+  let NoTree as = takeR o k no+  in case as of+       ka :<| _  -> Just ka+       Seq.Empty -> Nothing++adjustR :: Ord k => (a -> a) -> Openness -> k -> NoTree k a -> NoTree k a+adjustR f = shapeR (No.Tree.map f)++adjustRWithKey :: Ord k => (k -> a -> a) -> Openness -> k -> NoTree k a -> NoTree k a+adjustRWithKey f = shapeR (mapWithKey f)++deleteR :: Ord k => Openness -> k -> NoTree k a -> NoTree k a+deleteR = shapeR (\_ -> empty)++updateR :: Ord k => (a -> Maybe a) -> Openness -> k -> NoTree k a -> NoTree k a+updateR f = shapeR (No.Tree.mapMaybe f)++updateRWithKey :: Ord k => (k -> a -> Maybe a) -> Openness -> k -> NoTree k a -> NoTree k a+updateRWithKey f = shapeR (mapMaybeWithKey f)++takeR :: Ord k => Openness -> k -> NoTree k a -> NoTree k a+takeR Closed = deleteL Open+takeR Open   = deleteL Closed++shapeR :: Ord k => (NoTree k a -> NoTree k a) -> Openness -> k -> NoTree k a -> NoTree k a+shapeR f o k no =+  let ~(NoTree as, mx, NoTree bs) = splitLookup k no+  in case mx of+       Nothing -> NoTree $ as <> getNoTree (f $ NoTree bs)+       Just x  ->+         case o of+           Closed -> NoTree $ as <> getNoTree (f . NoTree $ (k, x) :<| bs)+           Open   -> NoTree $ (as :|> (k, x)) <> getNoTree (f $ NoTree bs)++++data Range k = UnsafeRange+                 {-# UNPACK #-} !Openness+                 k+                 {-# UNPACK #-} !Openness+                 k++instance Show k => Show (Range k) where+  showsPrec d (UnsafeRange oL kL oR kR) =+    showParen (d > 10) $+      showString "Range " . shows oL+              . showChar ' ' . shows kL+              . showChar ' ' . shows oR+              . showChar ' ' . shows kR++pattern WordRange+  :: (Bounded k, Num k, Ord k)+  => Openness+  -> k+  -> Openness+  -> k+  -> Range k+pattern WordRange oL kL oR kR <- UnsafeRange oL kL oR kR+  where+    WordRange o1 k1 o2 k2 =+      case Prelude.compare k1 k2 of+        LT -> UnsafeRange o1 k1 o2 k2+        GT -> UnsafeRange o2 k2 o1 k1+        EQ ->+          let o | Closed <- o1, Closed <- o2 = Closed+                | otherwise                  = Open++          in if k1 == maxBound+               then UnsafeRange Open (maxBound - 1) o maxBound+               else UnsafeRange o k1 Open (k1 + 1)++pattern StringRange+  :: (Bounded k, Ord k, Num k)+  => Openness+  -> NonEmpty k+  -> Openness+  -> NonEmpty k+  -> Range (NonEmpty k)+pattern StringRange oL kL oR kR <- UnsafeRange oL kL oR kR+  where+    StringRange o1 k1 o2 k2 =+      case Prelude.compare k1 k2 of+        LT -> UnsafeRange o1 k1 o2 k2+        GT -> UnsafeRange o2 k2 o1 k1+        EQ ->+          let o | Closed <- o1, Closed <- o2 = Closed+                | otherwise                  = Open++              x = NonEmpty.last k1+              xs = NonEmpty.init k1++          in if x == maxBound+               then UnsafeRange Open (NonEmpty.fromList $ xs <> [x - 1]) o k1+               else UnsafeRange o k1 Open (NonEmpty.fromList $ xs <> [x + 1])++++adjustRange :: Ord k => (a -> a) -> Range k -> NoTree k a -> NoTree k a+adjustRange f = shapeRange (No.Tree.map f)++adjustRangeWithKey :: Ord k => (k -> a -> a) -> Range k -> NoTree k a -> NoTree k a+adjustRangeWithKey f = shapeRange (mapWithKey f)++deleteRange :: Ord k => Range k -> NoTree k a -> NoTree k a+deleteRange = shapeRange (\_ -> empty)++updateRange :: Ord k => (a -> Maybe a) -> Range k -> NoTree k a -> NoTree k a+updateRange f = shapeRange (No.Tree.mapMaybe f)++updateRangeWithKey :: Ord k => (k -> a -> Maybe a) -> Range k -> NoTree k a -> NoTree k a+updateRangeWithKey f = shapeRange (mapMaybeWithKey f)++takeRange :: Ord k => Range k -> NoTree k a -> NoTree k a+takeRange (UnsafeRange oL kL oR kR) = takeR oL kL . takeL oR kR++shapeRange :: Ord k => (NoTree k a -> NoTree k a) -> Range k -> NoTree k a -> NoTree k a+shapeRange f (UnsafeRange oL kL oR kR) = shapeR (shapeL f oR kR) oL kL++++merge+  :: Ord k+  => (k -> a -> b -> Maybe c)+  -> (a -> Maybe c)+  -> (b -> Maybe c)+  -> NoTree k a+  -> NoTree k b+  -> NoTree k c+merge f l r (NoTree as) (NoTree bs) =+  NoTree . Seq.fromList $ go (Data.Foldable.toList as) (Data.Foldable.toList bs)+  where+    go ((ks, x) : xs) ((ls, y) : ys) =+      case Prelude.compare ks ls of+        LT -> let rest = go xs ((ls, y) : ys)+              in case l x of+                   Just z  -> (ks, z) : rest+                   Nothing -> rest++        EQ -> let rest = go xs ys+              in case f ks x y of+                   Just z  -> (ks, z) : rest+                   Nothing -> rest++        GT -> let rest = go ((ks, x) : xs) ys+              in case r y of+                   Just z  -> (ls, z) : rest+                   Nothing -> rest++    go xs [] = Data.Maybe.mapMaybe (\(ks, x) -> (,) ks <$> l x) xs+    go [] ys = Data.Maybe.mapMaybe (\(ls, y) -> (,) ls <$> r y) ys++++unionL :: Ord k => NoTree k a -> NoTree k a -> NoTree k a+unionL = unionWithKey (\_ a _ -> a)++unionWithKey+  :: Ord k => (k -> a -> a -> a) -> NoTree k a -> NoTree k a -> NoTree k a+unionWithKey f = merge (\ks a b -> Just $ f ks a b) Just Just+++difference :: Ord k => NoTree k a -> NoTree k b -> NoTree k a+difference = differenceWithKey (\_ _ _ -> Nothing)++differenceWithKey+  :: Ord k => (k -> a -> b -> Maybe a) -> NoTree k a -> NoTree k b -> NoTree k a+differenceWithKey f = merge f Just (\_ -> Nothing)+++intersectionL :: Ord k => NoTree k a -> NoTree k b -> NoTree k a+intersectionL = intersectionWithKey (\_ a _ -> a)++intersectionWithKey+  :: Ord k => (k -> a -> b -> c) -> NoTree k a -> NoTree k b -> NoTree k c+intersectionWithKey f =+  merge (\k a b -> Just $ f k a b) (\_ -> Nothing) (\_ -> Nothing)++++compare :: (Eq a, Ord k) => NoTree k a -> NoTree k a -> PartialOrdering+compare xs@(NoTree as) ys@(NoTree bs)+  | as == bs                                   = Equal++  | NoTree is <- intersectionL xs ys, is == as+  , NoTree us <- unionL        xs ys, us == bs = Subset++  | NoTree is <- intersectionL xs ys, is == bs+  , NoTree us <- unionL        xs ys, us == as = Superset++  | otherwise                                  = Incomparable++++splitL :: Ord k => Openness -> k -> NoTree k a -> (NoTree k a, NoTree k a)+splitL o k t =+  let (NoTree l, mx, NoTree r) = splitLookup k t+  in case mx of+       Just x  -> case o of+                    Closed -> (NoTree $ l :|> (k, x), NoTree r)+                    Open   -> (NoTree $ l, NoTree $ (k, x) :<| r)++       Nothing -> (NoTree l, NoTree r)++splitR :: Ord k => k -> NoTree k a -> (NoTree k a, NoTree k a)+splitR k t =+  let (l, mx, NoTree r) = splitLookup k t+  in ( l+     , NoTree $ case mx of+                  Just x  -> (k, x) :<| r+                  Nothing -> r+     )++splitLookup :: Ord k => k -> NoTree k a -> (NoTree k a, Maybe a, NoTree k a)+splitLookup ws (NoTree as) =+  let (before, after) = Seq.spanl (\(ks, _) -> ks < ws) as+  in case after of+       (cs, a) :<| rest | cs == ws -> (NoTree before, Just a , NoTree rest)+       _                           -> (NoTree before, Nothing, NoTree after)++++filter :: (a -> Bool) -> NoTree k a -> NoTree k a+filter f = fst . partition f++filterWithKey :: (k -> a -> Bool) -> NoTree k a -> NoTree k a+filterWithKey f = fst . partitionWithKey f++mapMaybe :: (a -> Maybe b) -> NoTree k a -> NoTree k b+mapMaybe f = fst . mapEitherWithKey (\_ -> maybe (Right ()) Left . f)++mapMaybeWithKey :: (k -> a -> Maybe b) -> NoTree k a -> NoTree k b+mapMaybeWithKey f = fst . mapEitherWithKey (\ks -> maybe (Right ()) Left . f ks)++partition :: (a -> Bool) -> NoTree k a -> (NoTree k a, NoTree k a)+partition f = mapEitherWithKey (\_ a -> if f a then Left a else Right a)++partitionWithKey :: (k -> a -> Bool) -> NoTree k a -> (NoTree k a, NoTree k a)+partitionWithKey f = mapEitherWithKey (\ks a -> if f ks a then Left a else Right a)++mapEither :: (a -> Either b c) -> NoTree k a -> (NoTree k b, NoTree k c)+mapEither f = mapEitherWithKey (\_ -> f)++mapEitherWithKey+  :: (k -> a -> Either b c) -> NoTree k a -> (NoTree k b, NoTree k c)+mapEitherWithKey f (NoTree as) =+  let ~(bs, cs) = partitionEithers $+                    flip fmap (Data.Foldable.toList as) $ \(ks, a) ->+                      case f ks a of+                        Left b  -> Left (ks, b)+                        Right c -> Right (ks, c)++  in (NoTree $ Seq.fromList bs, NoTree $ Seq.fromList cs)++++lookupMin :: NoTree k a -> Maybe a+lookupMin t = (\ (_, a, _) -> a) <$> minView t++lookupMinWithKey :: NoTree k a -> Maybe (k, a)+lookupMinWithKey t = (\ (k, a, _) -> (k, a)) <$> minView t++deleteMin :: NoTree k a -> NoTree k a+deleteMin = updateMin (\_ -> Nothing)++adjustMin :: (a -> a) -> NoTree k a -> NoTree k a+adjustMin f = adjustMinWithKey (\_ -> f)++adjustMinWithKey :: (k -> a -> a) -> NoTree k a -> NoTree k a+adjustMinWithKey f = updateMinWithKey (\k a -> Just $ f k a)++updateMin :: (a -> Maybe a) -> NoTree k a -> NoTree k a+updateMin f = updateMinWithKey (\_ -> f)++updateMinWithKey :: (k -> a -> Maybe a) -> NoTree k a -> NoTree k a+updateMinWithKey f (NoTree as) =+  NoTree $+    case as of+      (k, a) :<| bs ->+        case f k a of+          Just b  -> (k, b) :<| bs+          Nothing -> bs++      Empty         -> Seq.empty++minView :: NoTree k a -> Maybe (k, a, NoTree k a)+minView (NoTree as) =+  case as of+    (k, a) :<| bs -> Just (k, a, NoTree bs)+    Empty         -> Nothing++++lookupMax :: NoTree k a -> Maybe a+lookupMax t = (\ (_, _, a) -> a) <$> maxView t++lookupMaxWithKey :: NoTree k a -> Maybe (k, a)+lookupMaxWithKey t = (\ (_, k, a) -> (k, a)) <$> maxView t++deleteMax :: NoTree k a -> NoTree k a+deleteMax = updateMax (\_ -> Nothing)++adjustMax :: (a -> a) -> NoTree k a -> NoTree k a+adjustMax f = adjustMaxWithKey (\_ -> f)++adjustMaxWithKey :: (k -> a -> a) -> NoTree k a -> NoTree k a+adjustMaxWithKey f = updateMaxWithKey (\k a -> Just $ f k a)++updateMax :: (a -> Maybe a) -> NoTree k a -> NoTree k a+updateMax f = updateMaxWithKey (\_ -> f)++updateMaxWithKey :: (k -> a -> Maybe a) -> NoTree k a -> NoTree k a+updateMaxWithKey f (NoTree as) =+  NoTree $+    case as of+      bs :|> (k, a) ->+        case f k a of+          Just b  -> bs :|> (k, b)+          Nothing -> bs++      Empty         -> Seq.empty++maxView :: NoTree k a -> Maybe (NoTree k a, k, a)+maxView (NoTree as) =+  case as of+    bs :|> (k, a) -> Just (NoTree bs, k, a)+    Empty         -> Nothing

@@ -1,143 +1,144 @@-name:-  radix-tree-version:-  0.1-category:-  Data Structures-synopsis:-  Radix tree data structive over short byte-strings-description:-  This module provides a memory-efficient map from-  Data.ByteString.Short keys to arbitrary values implemented as a radix-  tree datastructure. Memory efficiency is achieved by sharing common-  prefixes of all keys.-license:-  BSD3-license-file:-  LICENSE-author:-  Sergey Vinokurov-maintainer:-  Sergey Vinokurov <serg.foo@gmail.com>-copyright:-  (c) 2018 Sergey Vinokurov-tested-with:-  GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3+name:          radix-tree+version:       1.0.0.0 -cabal-version:-  2.0-build-type:-  Simple+category:      Data Structures+synopsis:      Radix trees.+description:   Radix and PATRICIA trees, both spine-strict and spine-lazy. -homepage: https://github.com/sergv/radix-tree+license:       BSD3+license-file:  LICENSE +author:        Sergey Vinokurov, Oleksii Divak+maintainer:    Oleksii Divak <frozenwitness@gmail.com>+copyright:     (c) 2018 Sergey Vinokurov++cabal-version: 2.0+build-type:    Simple++homepage:      https://github.com/sergv/radix-tree+ source-repository head-    type: git-    location: https://github.com/sergv/radix-tree.git+  type: git+  location: https://github.com/sergv/radix-tree.git  library-  exposed-modules:-    Data.RadixTree-    Data.RadixTree.Internal-  hs-source-dirs:-    src-  build-depends:-    base >= 4.9 && < 5,-    bytestring,-    containers,-    deepseq,-    primitive-  default-language:-    Haskell2010-  ghc-options:-    -Wall-    -fwarn-name-shadowing-    -fno-warn-type-defaults-  if impl(ghc >= 8.0)-    ghc-options:-      -Wcompat-      -Whi-shadowing-      -Widentities-      -Wincomplete-record-updates-      -Wincomplete-uni-patterns-      -Wmissing-exported-signatures-  if impl(ghc >= 8.2)-    ghc-options:-      -Wcpp-undef-      -Wmissing-home-modules-      -Wunbanged-strict-patterns+  exposed-modules:  Data.Patricia.Word.Lazy+                    Data.Patricia.Word.Lazy.Debug+                    Data.Patricia.Word.Lazy.TH+                    Data.Patricia.Word.Lazy.Unsafe+                    Data.Patricia.Word.Strict+                    Data.Patricia.Word.Strict.Debug+                    Data.Patricia.Word.Strict.TH+                    Data.Patricia.Word.Strict.Unsafe -test-suite radix-tree-test-  type:-    exitcode-stdio-1.0-  main-is:-    test/TestMain.hs-  build-depends:-    HUnit,-    QuickCheck,-    base >= 4.9 && < 5,-    bytestring,-    containers,-    tasty,-    tasty-hunit,-    tasty-quickcheck,-    radix-tree-  default-language:-    Haskell2010-  ghc-options:-    -rtsopts-    -Wall-    -fwarn-name-shadowing-    -fno-warn-type-defaults-  if impl(ghc >= 8.0)-    ghc-options:-      -Wall-missed-specialisations-      -Wcompat-      -Whi-shadowing-      -Widentities-      -Wincomplete-record-updates-      -Wincomplete-uni-patterns-      -Wmissing-exported-signatures-  if impl(ghc >= 8.2)-    ghc-options:-      -Wcpp-undef-      -Wmissing-home-modules-      -Wunbanged-strict-patterns+                    Data.RadixTree.Word8.Key+                    Data.RadixTree.Word8.Key.Unsafe+                    Data.RadixTree.Word8.Lazy+                    Data.RadixTree.Word8.Lazy.Debug+                    Data.RadixTree.Word8.Lazy.TH+                    Data.RadixTree.Word8.Lazy.Unsafe+                    Data.RadixTree.Word8.Strict+                    Data.RadixTree.Word8.Strict.Debug+                    Data.RadixTree.Word8.Strict.TH+                    Data.RadixTree.Word8.Strict.Unsafe -benchmark radix-tree-bench-  type:-    exitcode-stdio-1.0-  main-is:-    bench/RadixTreeBench.hs-  hs-source-dirs:-    . bench-  build-depends:-    base >= 4.9 && < 5,-    bytestring,-    containers,-    deepseq,-    gauge >= 0.2.3,-    hashtables,-    radix-tree,-    text,-    unordered-containers-  default-language:-    Haskell2010-  ghc-options:-    -rtsopts-    -Wall-    -fwarn-name-shadowing-    -fno-warn-type-defaults-  if impl(ghc >= 8.0)-    ghc-options:-      -Wcompat-      -Whi-shadowing-      -Widentities-      -Wincomplete-record-updates-      -Wincomplete-uni-patterns-      -Wmissing-exported-signatures-  if impl(ghc >= 8.2)-    ghc-options:-      -Wcpp-undef-      -Wmissing-home-modules-      -Wunbanged-strict-patterns+                    Data.Radix1Tree.Word8.Key+                    Data.Radix1Tree.Word8.Key.Unsafe+                    Data.Radix1Tree.Word8.Lazy+                    Data.Radix1Tree.Word8.Lazy.Debug+                    Data.Radix1Tree.Word8.Lazy.TH+                    Data.Radix1Tree.Word8.Lazy.Unsafe+                    Data.Radix1Tree.Word8.Strict+                    Data.Radix1Tree.Word8.Strict.Debug+                    Data.Radix1Tree.Word8.Strict.TH+                    Data.Radix1Tree.Word8.Strict.Unsafe++                    Data.Zebra.Word+                    Data.Zebra.Word.Debug+                    Data.Zebra.Word.Unsafe++  other-modules:    Data.ByteArray.NonEmpty++                    Data.Patricia.Word.Common+                    Data.Patricia.Word.Conversion+                    Data.Patricia.Word.Debug+                    Data.Patricia.Word.Lazy.Internal+                    Data.Patricia.Word.Strict.Internal++                    Data.RadixNTree.Word8.Common+                    Data.RadixNTree.Word8.Conversion+                    Data.RadixNTree.Word8.Debug+                    Data.RadixNTree.Word8.Key+                    Data.RadixNTree.Word8.Lazy+                    Data.RadixNTree.Word8.Lazy.Debug+                    Data.RadixNTree.Word8.Lazy.TH+                    Data.RadixNTree.Word8.Strict+                    Data.RadixNTree.Word8.Strict.Debug+                    Data.RadixNTree.Word8.Strict.TH++                    Data.Zebra.Word.Internal++                    Numeric.Long++                    Radix.Common+                    Radix.Exception+                    Radix.Word8.Common+                    Radix.Word8.Debug+                    Radix.Word8.Foundation+                    Radix.Word.Common+                    Radix.Word.Debug+                    Radix.Word.Foundation++  hs-source-dirs:   src++  build-depends:    base             >= 4.12 && < 5+                  , bytestring       >= 0.10.4 && < 0.13+                  , deepseq          >= 1.4.3 && < 1.6+                  , primitive        >= 0.7 && < 0.10+                  , template-haskell >= 2.17 && < 3+                  , text             >= 2.0 && < 2.2++  default-language: Haskell2010++  ghc-options:      -Wall++test-suite properties+  type:             exitcode-stdio-1.0++  main-is:          Main.hs++  other-modules:    No.Set.Word+                    No.Tree++                    Test.Kit++                    Test.Patricia.Word.Lazy+                    Test.Patricia.Word.Sample+                    Test.Patricia.Word.Strict++                    Test.RadixNTree.Word8.Key+                    Test.RadixNTree.Word8.Sample++                    Test.RadixTree.Word8.Lazy+                    Test.RadixTree.Word8.Strict++                    Test.Random++                    Test.Zebra.Word+                    Test.Zebra.Word.Sample++  hs-source-dirs:   no+                  , test/properties++  ghc-options:      -Wall++  build-depends:    base+                  , bytestring+                  , containers >= 0.5 && < 0.8+                  , hspec      >= 2 && < 3+                  , primitive+                  , radix-tree+                  , random     >= 1.2.0 && < 1.3+                  , text++  default-language: Haskell2010

@@ -0,0 +1,152 @@+{-# LANGUAGE BangPatterns+           , RankNTypes+           , ScopedTypeVariables+           , UnboxedTuples #-}++module Data.ByteArray.NonEmpty+  ( Step (..)++  , fromStep+  , toNonEmpty+  , toList++  , dropByteArray++  , appendByteArray+  , dropAppendByteArray+  , fromStepAppend++  , splitByteArray+  ) where++import           Control.Monad.ST+import           Data.Primitive.ByteArray+import           Data.List.NonEmpty (NonEmpty (..))+import           Data.Word++++-- | Single step of destroying a key.+data Step a b = More a b+              | Done++{-# INLINE fromStep #-}+fromStep :: (x -> Step Word8 x) -> Word8 -> x -> ByteArray+fromStep (more :: x -> Step Word8 x) = \w0 -> go 1 (\marr -> writeByteArray marr 0 w0)+  where+    go :: Int -> (forall s. MutableByteArray s -> ST s ()) -> x -> ByteArray+    go !n write s =+      case more s of+        More w s' ->+          let write' marr = do+                write marr+                writeByteArray marr n w++          in go (n + 1) write' s'++        Done      ->+          runST $ do+            marr <- newByteArray n+            write marr+            unsafeFreezeByteArray marr++++{-# INLINE toNonEmpty #-}+toNonEmpty :: ByteArray -> NonEmpty Word8+toNonEmpty arr = indexByteArray arr 0 :| toListFrom 1 arr++{-# INLINE toList #-}+toList :: ByteArray -> [Word8]+toList = toListFrom 0++{-# INLINE toListFrom #-}+toListFrom :: Int -> ByteArray -> [Word8]+toListFrom n0 arr = go n0+  where+    go n+      | n >= sizeofByteArray arr = []+      | otherwise                = indexByteArray arr n : go (n + 1)++++dropByteArray :: Int -> ByteArray -> ByteArray+dropByteArray n arr =+  runST $ do+    let len = sizeofByteArray arr - n+    mbrr <- newByteArray len+    copyByteArray mbrr 0 arr n len+    unsafeFreezeByteArray mbrr++++appendByteArray :: ByteArray -> ByteArray -> ByteArray+appendByteArray arr brr =+  runST $ do+    let alen = sizeofByteArray arr+        blen = sizeofByteArray brr+    mcrr <- newByteArray (alen + blen)+    copyByteArray mcrr 0    arr 0 alen+    copyByteArray mcrr alen brr 0 blen+    unsafeFreezeByteArray mcrr++++dropAppendByteArray :: Int -> ByteArray -> ByteArray -> ByteArray+dropAppendByteArray n arr brr =+  runST $ do+    let alen = sizeofByteArray arr - n+        blen = sizeofByteArray brr+    mcrr <- newByteArray (alen + blen)+    copyByteArray mcrr 0    arr n alen+    copyByteArray mcrr alen brr 0 blen+    unsafeFreezeByteArray mcrr++++{-# INLINE fromStepAppend #-}+fromStepAppend :: (x -> Step Word8 x) -> Word8 -> x -> ByteArray -> ByteArray+fromStepAppend (more :: x -> Step Word8 x) = \w0 s0 arr ->+  let go :: Int -> (forall s. MutableByteArray s -> ST s ()) -> x -> ByteArray+      go !n write s =+        case more s of+          More w s' ->+            let write' mbrr = do+                  writeByteArray mbrr n w+                  write mbrr++            in go (n + 1) write' s'++          Done      ->+            runST $ do+              let alen = sizeofByteArray arr+              mbrr <- newByteArray (n + alen)+              write mbrr+              copyByteArray mbrr n arr 0 alen+              unsafeFreezeByteArray mbrr++  in go 1 (\mbrr -> writeByteArray mbrr 0 w0) s0++++data Wrap = Wrap {-# UNPACK #-} !ByteArray {-# UNPACK #-} !ByteArray++splitByteArray :: Int -> Int -> ByteArray -> (# ByteArray, ByteArray #)+splitByteArray offset n arr =+  let f = runST $ do+            let alen = sizeofByteArray arr++            mbrr <- newByteArray n+            copyByteArray mbrr 0 arr offset n+            brr <- unsafeFreezeByteArray mbrr++            let clen = alen - n++            mcrr <- newByteArray clen+            copyByteArray mcrr 0 arr n clen+            crr <- unsafeFreezeByteArray mcrr++            pure $ Wrap brr crr++  in case f of+       Wrap brr crr -> (# brr, crr #)

@@ -0,0 +1,9 @@+module Data.Patricia.Word.Common+  ( Lookup (..)+  ) where++++-- | Key together with the value.+data Lookup a = Lookup {-# UNPACK #-} !Word a+                deriving Show

@@ -0,0 +1,30 @@+module Data.Patricia.Word.Conversion where++import           Data.Patricia.Word.Lazy.Internal as Lazy+import           Data.Patricia.Word.Strict.Internal as Strict++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Create a lazy 'Lazy.Patricia' tree from a strict one.+--+--   The resulting tree does not share its data representation with the original.+toLazy :: StrictPatricia a -> LazyPatricia a+toLazy t =+  case t of+    Strict.Bin p l r -> Lazy.Bin p (toLazy l) (toLazy r)+    Strict.Tip k a   -> Lazy.Tip k a+    Strict.Nil       -> Lazy.Nil++++-- | \(\mathcal{O}(n)\).+--   Create a strict 'Strict.Patricia' tree from a lazy one.+--+--   The resulting tree does not share its data representation with the original.+toStrict :: LazyPatricia a -> StrictPatricia a+toStrict t =+  case t of+    Lazy.Bin p l r -> Strict.Bin p (toStrict l) (toStrict r)+    Lazy.Tip k a   -> Strict.Tip k a+    Lazy.Nil       -> Strict.Nil

@@ -0,0 +1,24 @@+module Data.Patricia.Word.Debug+  ( Validity (..)+  , Reason (..)+  ) where++import           Radix.Word.Foundation++++-- | Whether the tree is well-formed.+data Validity = Valid+              | Invalid Reason+                deriving Show++-- | Reason for why the tree is considered malformed.+data Reason = -- | Prefix is @0@.+              ZeroPrefix+            | -- | Prefix below diverges from the prefix above.+              PrefixBelow Prefix Prefix+              -- | Key diverges the prefix above.+            | KeyBelow Prefix Key+              -- | One of the branches is empty.+            | MalformedBin Prefix+              deriving Show

@@ -0,0 +1,246 @@+{-|+    @'LazyPatricia' a@ is a spine-lazy big-endian PATRICIA tree, a compressed+    trie with a radix of 2, using 'Word's as keys.++    == Laziness++    Evaluating any particular entry in the tree to WHNF forces the evaluation+    of the part of the spine leading up to that entry to normal form.++    == Performance++    Each function's time complexity is provided in the documentation.++    Laziness-amortized functions specify two time complexities:+    time to construct the return value (denoted with a \(\texttt{+}\)) and time to+    fully apply the function to the tree.++    \(n\) refers to the number of evaluated entries in the resulting tree.+    Parts of the tree are denoted using subscripts: \(n_L\) refers to the left side,+    \(n_R\) to the right side, \(n_I\) to a range (interval), and+    \(n_M\) to entries collected with the use of a 'Monoid'.++    \(W\) is the size of 'Word' in bits, i.e. @'Data.Bits.finiteBitSize' (0 :: 'Word')@.++    == Implementation++    See the implementation section in "Data.Patricia.Word.Strict".+ -}++module Data.Patricia.Word.Lazy+  ( LazyPatricia+  , Patricia++    -- * Construct+  , empty+  , singleton++    -- ** Convert+  , toStrict++    -- * Single-key+    -- ** Lookup+  , Data.Patricia.Word.Lazy.Internal.lookup+  , Data.Patricia.Word.Lazy.Internal.find+  , member++    -- ** Insert+  , insert+  , insertWith++    -- ** Map+  , adjust++    -- ** Delete+  , delete++    -- ** Update+  , update++  , alter++    -- ** Take+  , splitLookup++    -- * Directional+    -- ** Lookup+  , Lookup (..)+  , lookupL+  , lookupR++    -- ** Map+    -- | === Left+  , adjustL+  , adjustLWithKey++    -- | === Right+  , adjustR+  , adjustRWithKey++    -- ** Delete+  , deleteL+  , deleteR++    -- ** Update+    -- | === Left+  , updateL+  , updateLWithKey++    -- | === Right+  , updateR+  , updateRWithKey++    -- ** Take+    -- | === Left+  , takeL+  , splitL++    -- | === Right+  , takeR+  , splitR++    -- * Range+  , Range (Range)++    -- ** Map+  , adjustRange+  , adjustRangeWithKey++    -- ** Delete+  , deleteRange++    -- ** Update+  , updateRange+  , updateRangeWithKey++    -- ** Take+  , takeRange++    -- * Edges++    -- ** Lookup+    -- | === Min+  , lookupMin+  , lookupMinWithKey++    -- | === Max+  , lookupMax+  , lookupMaxWithKey++    -- ** Map+    -- | === Min+  , adjustMin+  , adjustMinWithKey++    -- | === Max+  , adjustMax+  , adjustMaxWithKey++    -- ** Delete+  , deleteMin+  , deleteMax++    -- ** Update+    -- | === Min+  , updateMin+  , updateMinWithKey++    -- | === Max+  , updateMax+  , updateMaxWithKey++    -- ** View+    -- | === Min+  , ViewL (..)+  , minView++    -- | === Max+  , ViewR (..)+  , maxView++    -- * Full tree+    -- ** Size+  , Data.Patricia.Word.Lazy.Internal.null+  , size++    -- ** Map+  , Data.Patricia.Word.Lazy.Internal.map+  , mapWithKey++    -- ** Fold+    -- | === Left-to-right+  , Data.Patricia.Word.Lazy.Internal.foldl+  , Data.Patricia.Word.Lazy.Internal.foldl'+  , foldlWithKey+  , foldlWithKey'++    -- | === Right-to-left+  , Data.Patricia.Word.Lazy.Internal.foldr+  , Data.Patricia.Word.Lazy.Internal.foldr'+  , foldrWithKey+  , foldrWithKey'++    -- | === Monoid+  , Data.Patricia.Word.Lazy.Internal.foldMap+  , foldMapWithKey++    -- ** Traverse+  , Data.Patricia.Word.Lazy.Internal.traverse+  , traverseWithKey++    -- ** Filter+    -- | === One side+  , Data.Patricia.Word.Lazy.Internal.filter+  , filterWithKey++  , mapMaybe+  , mapMaybeWithKey++    -- | === Both sides+  , partition+  , partitionWithKey++  , mapEither+  , mapEitherWithKey++    -- ** Comparison+  , PartialOrdering (..)+  , Data.Patricia.Word.Lazy.Internal.compare++    -- ** Union+  , union+  , unionL+  , unionWith+  , unionWithKey++    -- ** Difference+  , difference+  , differenceWith+  , differenceWithKey++    -- ** Intersection+  , disjoint+  , intersection+  , intersectionL+  , intersectionWith+  , intersectionWithKey++    -- ** Merge+    -- | See 'Data.Patricia.Word.Lazy.Unsafe.merge'.+  ) where++import           Data.Patricia.Word.Common+import           Data.Patricia.Word.Conversion+import           Data.Patricia.Word.Lazy.Internal+import           Radix.Common+import           Radix.Word.Common++++-- | \(\mathcal{O}(1)\). Empty tree.+empty :: Patricia a+empty = Nil++-- | \(\mathcal{O}(1)\). Tree with a single entry.+singleton :: Word -> a -> Patricia a+singleton = Tip

@@ -0,0 +1,72 @@+{-|+    Safe functions for datatype introspection.+ -}++module Data.Patricia.Word.Lazy.Debug+  ( -- * Show+    showsTree++    -- * Validate+  , Validity (..)+  , Reason (..)+  , validate+  ) where++import           Data.Patricia.Word.Debug+import           Data.Patricia.Word.Lazy.Internal+import           Numeric.Long+import           Radix.Word.Debug++++-- | \(\mathcal{O}(n)\).+--   Shows the internal structure of the tree.+showsTree :: (a -> ShowS) -> Patricia a -> ShowS+showsTree f = go 0+  where+    go i t =+      mappend (replicate i ' ') .+        case t of+          Bin p l r ->+            showString "Bin " . showPrefix p . showChar '\n'+                              . go (i + 2) l . showChar '\n'+                              . go (i + 2) r++          Tip k a   ->+            showString "Tip " . showLongHex k . showString " => " . f a++          Nil       -> showString "Nil"++++-- | \(\mathcal{O}(n)\).+--   Checks whether the tree is well-formed.+validate :: Patricia a -> Validity+validate t =+  case t of+    Bin p l r+      | p == 0    -> Invalid ZeroPrefix+      | otherwise ->+          case go L p l of+            Valid -> go R p r+            err   -> err++    Tip _ _ -> Valid++    Nil -> Valid+  where+    go s q x =+      case x of+        Bin p l r+          | p == 0                 -> Invalid ZeroPrefix+          | not $ validBelow q s p -> Invalid $ PrefixBelow q p+          | otherwise              ->+              case go L p l of+                Valid -> go R p r+                err   -> err++        Tip k _+          | not $ validBelow q s k -> Invalid $ KeyBelow q k+          | otherwise              -> Valid++        Nil -> Invalid $ MalformedBin q

@@ -0,0 +1,2583 @@+{-# LANGUAGE BangPatterns+           , DeriveLift+           , GADTs+           , RankNTypes+           , ScopedTypeVariables+           , UnboxedTuples #-}++module Data.Patricia.Word.Lazy.Internal+  ( LazyPatricia+  , Patricia (..)++  , Data.Patricia.Word.Lazy.Internal.null+  , size++  , Data.Patricia.Word.Lazy.Internal.map+  , mapWithKey++  , Data.Patricia.Word.Lazy.Internal.foldl+  , Data.Patricia.Word.Lazy.Internal.foldl'+  , foldlWithKey+  , foldlWithKey'++  , Data.Patricia.Word.Lazy.Internal.foldr+  , Data.Patricia.Word.Lazy.Internal.foldr'+  , foldrWithKey+  , foldrWithKey'++  , Data.Patricia.Word.Lazy.Internal.foldMap+  , foldMapWithKey++  , Data.Patricia.Word.Lazy.Internal.traverse+  , traverseWithKey++  , union+  , unionL+  , unionWith+  , unionWithKey++  , difference+  , differenceWith+  , differenceWithKey++  , Data.Patricia.Word.Lazy.Internal.compare++  , disjoint+  , intersection+  , intersectionL+  , intersectionWith+  , intersectionWithKey++  , merge++  , Data.Patricia.Word.Lazy.Internal.lookup+  , Data.Patricia.Word.Lazy.Internal.find+  , member+  , takeOne++  , insert+  , insertWith++  , adjust++  , delete++  , update++  , alter++  , lookupL+  , lookupR++  , adjustL+  , adjustLWithKey++  , adjustR+  , adjustRWithKey++  , deleteL+  , deleteR++  , updateL+  , updateR+  , updateLWithKey+  , updateRWithKey++  , adjustRange+  , unsafeAdjustRange++  , adjustRangeWithKey+  , unsafeAdjustRangeWithKey++  , deleteRange+  , unsafeDeleteRange++  , updateRange+  , unsafeUpdateRange++  , updateRangeWithKey+  , unsafeUpdateRangeWithKey++  , takeRange+  , unsafeTakeRange++  , takeL+  , takeR++  , splitL+  , splitR+  , splitLookup++  , Data.Patricia.Word.Lazy.Internal.filter+  , filterWithKey++  , mapMaybe+  , mapMaybeWithKey++  , partition+  , partitionWithKey++  , mapEither+  , mapEitherWithKey++  , lookupMin+  , lookupMinWithKey+  , lookupMax+  , lookupMaxWithKey++  , unsafeLookupMin+  , unsafeLookupMinWithKey+  , unsafeLookupMax+  , unsafeLookupMaxWithKey++  , deleteMin+  , deleteMax++  , adjustMin+  , adjustMinWithKey+  , adjustMax+  , adjustMaxWithKey++  , updateMin+  , updateMinWithKey+  , updateMax+  , updateMaxWithKey++  , ViewL (..)+  , minView+  , unsafeMinView++  , ViewR (..)+  , maxView+  , unsafeMaxView+  ) where++import           Data.Patricia.Word.Common+import           Radix.Common+import           Radix.Exception+import           Radix.Word.Common+import           Radix.Word.Foundation++import           Control.Applicative+import           Control.DeepSeq+import           Control.Exception (throw)+import           Data.Bits+import           Data.Foldable+import           Data.Functor.Classes+import           Language.Haskell.TH.Syntax (Lift)+import           Text.Read+import           Text.Show++++-- | Convenience synonym.+type LazyPatricia = Patricia++-- | Spine-lazy PATRICIA tree.+data Patricia a = Bin+                    {-# UNPACK #-} !Prefix+                    (Patricia a)          -- ^ Masked bit is @0@.+                    (Patricia a)          -- ^ Masked bit is @1@.++                | Tip+                    {-# UNPACK #-} !Key+                    a++                | Nil -- ^ Invariant: only allowed as the root of the tree.+                  deriving Lift++instance Show a => Show (Patricia a) where+  showsPrec = liftShowsPrec showsPrec showList++instance Show1 Patricia where+  liftShowsPrec showsPrec_ showList_ _ t =+    showListWith (liftShowsPrec showsPrec_ showList_ 0) $+      foldrWithKey (\k a -> (:) (k, a)) [] t++instance Read a => Read (Patricia a) where+  readPrec = liftReadPrec readPrec readListPrec++instance Read1 Patricia where+  liftReadPrec readPrec_ readList_ =+    fmap (Data.Foldable.foldl' (\z (k, a) -> insert k a z) Nil)+      (liftReadListPrec readPrec_ readList_)+++instance Eq a => Eq (Patricia a) where+  (==) = liftEq (==)++instance Eq1 Patricia where+  liftEq eq = go+    where+      go l r =+        case l of+          Bin p xl xr ->+            case r of+              Bin q yl yr -> p == q && go xl yl && go xr yr+              _           -> False++          Tip kA a ->+            case r of+              Tip kB b -> kA == kB && eq a b+              _        -> False++          Nil ->+            case r of+              Nil -> True+              _   -> False+++instance Functor Patricia where+  fmap = Data.Patricia.Word.Lazy.Internal.map++instance Foldable Patricia where+  foldl = Data.Patricia.Word.Lazy.Internal.foldl+  foldr = Data.Patricia.Word.Lazy.Internal.foldr+  foldMap = Data.Patricia.Word.Lazy.Internal.foldMap++  foldl' = Data.Patricia.Word.Lazy.Internal.foldl'+  foldr' = Data.Patricia.Word.Lazy.Internal.foldr'++  null = Data.Patricia.Word.Lazy.Internal.null+  length = fromIntegral . size++instance Traversable Patricia where+  traverse = Data.Patricia.Word.Lazy.Internal.traverse+++instance NFData a => NFData (Patricia a) where+  rnf = liftRnf rnf++instance NFData1 Patricia where+  liftRnf nf = go+    where+      go t =+        case t of+          Bin _ l r -> go l `seq` go r+          Tip _ a   -> nf a+          Nil       -> ()++++{-# INLINE join #-}+-- | Knowing that the prefices of two non-'Nil' trees disagree, construct a 'Bin'.+join :: Prefix -> Patricia a -> Prefix -> Patricia a -> Patricia a+join p0 t0 p1 t1 =+  let m = branchingBit p0 p1++      p = mask p0 m .|. m++  in if zeroBit p0 m+       then Bin p t0 t1+       else Bin p t1 t0++{-# INLINE safeJoin #-}+-- | Knowing that the prefices of two trees disagree, construct a 'Bin'.+safeJoin :: Prefix -> Patricia a -> Prefix -> Patricia a -> Patricia a+safeJoin _  Nil _  t1  = t1+safeJoin _  t0  _  Nil = t0+safeJoin p0 t0  p1 t1  = join p0 t0 p1 t1++{-# INLINE rebin #-}+-- | Reconstruct a 'Bin' knowing that either of the sides may now be a 'Nil'.+rebin :: Prefix -> Patricia a -> Patricia a -> Patricia a+rebin p l r =+  case l of+    Nil -> r+    _   ->+      case r of+        Nil -> l+        _   -> Bin p l r++{-# INLINE rebinL #-}+-- | Reconstruct a 'Bin' knowing that the left side may now be a 'Nil'.+rebinL :: Prefix -> Patricia a -> Patricia a -> Patricia a+rebinL p l r =+  case l of+    Nil -> r+    _   -> Bin p l r+++{-# INLINE rebinR #-}+-- | Reconstruct a 'Bin' knowing that the right side may now be a 'Nil'.+rebinR :: Prefix -> Patricia a -> Patricia a -> Patricia a+rebinR p l r =+  case r of+    Nil -> l+    _   -> Bin p l r+++{-# INLINE retip #-}+-- | Reconstruct a 'Tip' knowing that the value may not be there anymore.+retip :: Key -> Maybe a -> Patricia a+retip w (Just a) = Tip w a+retip _ Nothing  = Nil++++-- | \(\mathcal{O}(1)\).+--   Check if the tree is empty.+null :: Patricia a -> Bool+null Nil = True+null _   = False++-- | \(\mathcal{O}(n)\).+--   Calculate the number of elements stored in the tree.+--   The returned number is guaranteed to be non-negative.+size :: Patricia a -> Int+size t =+  case t of+    Bin _ l r -> let !m = size l+                     !n = size r+                 in m + n++    Tip _ _   -> 1++    Nil       -> 0++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Apply a function to every value in the tree.+map :: (a -> b) -> Patricia a -> Patricia b+map f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) (go r)+        Tip k a   -> Tip k (f a)+        Nil       -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Apply a function to every value in the tree.+mapWithKey :: (Word -> a -> b) -> Patricia a -> Patricia b+mapWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) (go r)+        Tip k a   -> Tip k (f k a)+        Nil       -> Nil++++-- | \(\mathcal{O}(n_R)\).+--   Fold the tree left-to-right.+foldl :: (b -> a -> b) -> b -> Patricia a -> b+foldl f = go+  where+    go z t =+      case t of+        Bin _ l r -> go (go z l) r+        Tip _ a   -> f z a+        Nil       -> z++-- | \(\mathcal{O}(n_R)\).+--   Fold the tree left-to-right.+foldlWithKey :: (b -> Word -> a -> b) -> b -> Patricia a -> b+foldlWithKey f = go+  where+    go z t =+      case t of+        Bin _ l r -> go (go z l) r+        Tip k a   -> f z k a+        Nil       -> z++++-- | \(\mathcal{O}(n)\).+--   Fold the tree left-to-right with a strict accumulator.+foldl' :: (b -> a -> b) -> b -> Patricia a -> b+foldl' f = go+  where+    go !z t =+      case t of+        Bin _ l r -> let !z' = go z l+                     in go z' r+        Tip _ a   -> f z a+        Nil       -> z++-- | \(\mathcal{O}(n)\).+--   Fold the tree left-to-right with a strict accumulator.+foldlWithKey' :: (b -> Word -> a -> b) -> b -> Patricia a -> b+foldlWithKey' f = go+  where+    go !z t =+      case t of+        Bin _ l r -> let !z' = go z l+                     in go z' r+        Tip k a   -> f z k a+        Nil       -> z++++-- | \(\mathcal{O}(n_L)\).+--   Fold the tree right-to-left.+foldr :: (a -> b -> b) -> b -> Patricia a -> b+foldr f = go+  where+    go z t =+      case t of+        Bin _ l r -> go (go z r) l+        Tip _ a   -> f a z+        Nil       -> z++-- | \(\mathcal{O}(n_L)\).+--   Fold the tree right-to-left.+foldrWithKey :: (Word -> a -> b -> b) -> b -> Patricia a -> b+foldrWithKey f = go+  where+    go z t =+      case t of+        Bin _ l r -> go (go z r) l+        Tip k a   -> f k a z+        Nil       -> z++-- | \(\mathcal{O}(n)\).+--   Fold the tree right-to-left with a strict accumulator.+foldr' :: (a -> b -> b) -> b -> Patricia a -> b+foldr' f = go+  where+    go !z t =+      case t of+        Bin _ l r -> let !z' = go z r+                     in go z' l+        Tip _ a   -> f a z+        Nil       -> z++-- | \(\mathcal{O}(n)\).+--   Fold the tree right-to-left with a strict accumulator.+foldrWithKey' :: (Word -> a -> b -> b) -> b -> Patricia a -> b+foldrWithKey' f = go+  where+    go !z t =+      case t of+        Bin _ l r -> let !z' = go z r+                     in go z' l+        Tip k a   -> f k a z+        Nil       -> z++++-- | \(\mathcal{O}(n_M)\).+--   Map each element in the tree to a monoid and combine the results.+foldMap :: Monoid m => (a -> m) -> Patricia a -> m+foldMap f = go+  where+    go t =+      case t of+        Bin _ l r -> go l <> go r+        Tip _ a   -> f a+        Nil       -> mempty++-- | \(\mathcal{O}(n_M)\).+--   Map each element in the tree to a monoid and combine the results.+foldMapWithKey :: Monoid m => (Word -> a -> m) -> Patricia a -> m+foldMapWithKey f = go+  where+    go t =+      case t of+        Bin _ l r -> go l <> go r+        Tip k a   -> f k a+        Nil       -> mempty++++-- | \(\mathcal{O}(n)\).+--   Map each element in the tree to an action, evaluate these actions+--   left-to-right and collect the results.+traverse :: Applicative f => (a -> f b) -> Patricia a -> f (Patricia b)+traverse f = go+  where+    go t =+      case t of+        Bin p l r -> liftA2 (Bin p) (go l) (go r)+        Tip k a   -> Tip k <$> f a+        Nil       -> pure Nil++-- | \(\mathcal{O}(n)\).+--   Map each element in the tree to an action, evaluate these actions+--   left-to-right and collect the results.+traverseWithKey :: Applicative f => (Word -> a -> f b) -> Patricia a -> f (Patricia b)+traverseWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> liftA2 (Bin p) (go l) (go r)+        Tip k a   -> Tip k <$> f k a+        Nil       -> pure Nil++++type UBin a = (# Prefix, Patricia a, Patricia a #)++type UTip a = (# Word, a #)++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Unbiased union of two trees.+union :: Patricia a -> Patricia a -> Patricia a+union = anyAny+  where+    anyAny tA tB =+      case tA of+        Bin pA lA rA -> binAny (# pA, lA, rA #) tA tB++        Tip kA _ -> tipAny kA tA tB++        Nil -> tB++    tipAny kA tA tB =+      case tB of+        Bin pB lB rB -> tipBin kA tA (# pB, lB, rB #) tB++        Tip kB _+          | kA == kB  -> tA+          | otherwise -> join kA tA kB tB++        Nil -> tA++    binAny uA tA tB =+      case tB of+        Bin pB lB rB -> binBin uA tA (# pB, lB, rB #) tB++        Tip kB _ -> tipBin kB tB uA tA++        Nil -> tA++    tipBin kA tA (# pB, lB, rB #) tB+      | beyond pB kA = join kA tA pB tB+      | kA < pB      = Bin pB (tipAny kA tA lB) rB+      | otherwise    = Bin pB lB (tipAny kA tA rB)++    binBin uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      let {-# NOINLINE no #-}+          no = join pA tA pB tB++      in case Prelude.compare pA pB of+           EQ                  -> Bin pA (anyAny lA lB) (anyAny rA rB)++           LT | pB <= upper pA -> Bin pA lA (binAny uB tB rA)+              | pA >= lower pB -> Bin pB (binAny uA tA lB) rB+              | otherwise      -> no++           GT | pA <= upper pB -> Bin pB lB (binAny uA tA rB)+              | pB >= lower pA -> Bin pA (binAny uB tB lA) rA+              | otherwise      -> no++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Left-biased union of two trees.+unionL :: Patricia a -> Patricia a -> Patricia a+unionL =+  union_ $ \s k a b ->+    let !(# c #) = case s of+                     L -> (# a #)+                     R -> (# b #)+    in Tip k c++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Union of two trees with a combining function.+unionWith+  :: (a -> a -> a)+  -> Patricia a+  -> Patricia a+  -> Patricia a+unionWith f =+  union_ $ \s k a b ->+    let !(# c #) = case s of+                     L -> (# f a b #)+                     R -> (# f b a #)+    in Tip k c++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Union of two trees with a combining function.+unionWithKey+  :: (Word -> a -> a -> a)+  -> Patricia a+  -> Patricia a+  -> Patricia a+unionWithKey f =+  union_ $ \s k a b ->+    let !(# c #) = case s of+                     L -> (# f k a b #)+                     R -> (# f k b a #)+    in Tip k c++++{-# INLINE union_ #-}+union_+  :: (forall x y. S x y a a -> Key -> x -> y -> Patricia a)+  -> Patricia a+  -> Patricia a+  -> Patricia a+union_ f = anyAny L+  where+    anyAny s tA tB =+      case tA of+        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB++        Tip kA a -> tipAny s (# kA, a #) tA tB++        Nil -> tB++    tipAny s uA@(# kA, a #) tA tB =+      case tB of+        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #) tB++        Tip kB b+          | kA == kB  -> f s kA a b+          | otherwise -> join kA tA kB tB++        Nil -> tA++    binAny s uA tA tB =+      case tB of+        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB++        Tip kB b ->+          let !(# s' #) = other s+          in tipBin s' (# kB, b #) tB uA tA++        Nil -> tA++    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #) tB+      | beyond pB kA = join kA tA pB tB+      | kA < pB      = Bin pB (tipAny s uA tA lB) rB+      | otherwise    = Bin pB lB (tipAny s uA tA rB)++    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      let {-# NOINLINE no #-}+          no = join pA tA pB tB++      in case Prelude.compare pA pB of+           EQ                  -> Bin pA (anyAny s lA lB) (anyAny s rA rB)++           LT | pB <= upper pA -> let !(# s' #) = other s+                                  in Bin pA lA (binAny s' uB tB rA)+              | pA >= lower pB -> Bin pB (binAny s uA tA lB) rB+              | otherwise      -> no++           GT | pA <= upper pB -> Bin pB lB (binAny s uA tA rB)+              | pB >= lower pA -> let !(# s' #) = other s+                                  in Bin pA (binAny s' uB tB lA) rA+              | otherwise      -> no++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Difference of two trees.+difference :: Patricia a -> Patricia b -> Patricia a+difference =+  difference_ $ \_ _ _ _ ->+    Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Difference of two trees with a combining function.+differenceWith+  :: (a -> b -> Maybe a)+  -> Patricia a+  -> Patricia b+  -> Patricia a+differenceWith f =+  difference_ $ \s k a b ->+    retip k $ case s of+                L -> f a b+                R -> f b a++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Difference of two trees with a combining function.+differenceWithKey+  :: (Word -> a -> b -> Maybe a)+  -> Patricia a+  -> Patricia b+  -> Patricia a+differenceWithKey f =+  difference_ $ \s k a b ->+    retip k $ case s of+                L -> f k a b+                R -> f k b a++++{-# INLINE difference_ #-}+difference_+  :: (forall x y. S x y a b -> Key -> x -> y -> Patricia a)+  -> Patricia a+  -> Patricia b+  -> Patricia a+difference_ (f :: forall n o. S n o x y -> Key -> n -> o -> Patricia x) = anyAny L+  where+    anyAny+      :: forall a b. S a b x y -> Patricia a -> Patricia b -> Patricia x+    anyAny s tA tB =+      case tA of+        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB++        Tip kA a -> tipAny s (# kA, a #) tA tB++        Nil -> case s of+                 L -> tA+                 R -> tB++    tipAny+      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> Patricia x+    tipAny s uA@(# kA, a #) tA tB =+      case tB of+        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #) tB++        Tip kB b+          | kA == kB  -> f s kA a b+          | otherwise -> case s of+                           L -> tA+                           R -> tB++        Nil -> case s of+                 L -> tA+                 R -> tB++    binAny+      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> Patricia x+    binAny s uA tA tB =+      case tB of+        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB++        Tip kB b -> let !(# s' #) = other s+                    in tipBin s' (# kB, b #) tB uA tA++        Nil -> case s of+                 L -> tA+                 R -> tB++    tipBin+      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> Patricia b -> Patricia x+    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #) tB+      | beyond pB kA = case s of+                         L -> tA+                         R -> tB++      | kA < pB      = case s of+                         L -> tipAny s uA tA lB+                         R -> rebinL pB (tipAny s uA tA lB) rB++      | otherwise    = case s of+                         L -> tipAny s uA tA rB+                         R -> rebinR pB lB (tipAny s uA tA rB)++    binBin+      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> Patricia x+    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      let {-# NOINLINE no #-}+          no = case s of+                 L -> tA+                 R -> tB++      in case Prelude.compare pA pB of+           EQ                  -> rebin pA (anyAny s lA lB) (anyAny s rA rB)++           LT | pB <= upper pA -> case s of+                                    L -> rebinR pA lA (binAny R uB tB rA)+                                    R -> binAny L uB tB rA++              | pA >= lower pB -> case s of+                                    L -> binAny s uA tA lB+                                    R -> rebinL pB (binAny s uA tA lB) rB++              | otherwise      -> no++           GT | pA <= upper pB -> case s of+                                    L -> binAny s uA tA rB+                                    R -> rebinR pB lB (binAny s uA tA rB)++              | pB >= lower pA -> case s of+                                    L -> rebinL pA (binAny R uB tB lA) rA+                                    R -> binAny L uB tB lA++              | otherwise      -> no++++-- | \(\mathcal{O}(n_A + n_B)\).+--   Compare two trees with respect to set inclusion,+--   using the given equality function for intersecting keys.+--   If any intersecting keys hold unequal values, the trees are 'Incomparable'.+compare :: (a -> b -> Bool) -> Patricia a -> Patricia b -> PartialOrdering+compare (f :: x -> y -> Bool) = anyAny L+  where+    anyAny+      :: forall a b. S a b x y -> Patricia a -> Patricia b -> PartialOrdering+    anyAny s tA tB =+      case tA of+        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB++        Tip kA a -> tipAny s (# kA, a #) tA tB++        Nil -> case tB of+                 Nil -> Equal+                 _   -> Subset++    tipAny+      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> PartialOrdering+    tipAny s uA@(# kA, a #) tA tB =+      case tB of+        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #)++        Tip kB b+          | kA == kB  -> let eq = case s of+                                    L -> f a b+                                    R -> f b a+                         in if eq+                              then Equal+                              else Incomparable++          | otherwise -> Incomparable++        Nil -> Superset++    binAny+      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> PartialOrdering+    binAny s uA tA tB =+      case tB of+        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB++        Tip kB b -> let !(# s' #) = other s+                    in tipBin s' (# kB, b #) tB uA++        Nil -> Superset++    tipBin+      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> PartialOrdering+    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #) =+      if beyond pB kA+        then Incomparable+        else limit s . tipAny s uA tA $ if kA < pB+                                           then lB+                                           else rB++    binBin+      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> PartialOrdering+    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      case Prelude.compare pA pB of+        EQ                  -> order (anyAny s lA lB) (anyAny s rA rB)++        LT | pB <= upper pA -> let !(# s' #) = other s+                               in limit s' $ binAny s' uB tB rA++           | pA >= lower pB -> limit s $ binAny s uA tA lB++           | otherwise      -> Incomparable++        GT | pA <= upper pB -> limit s $ binAny s uA tA rB++           | pB >= lower pA -> let !(# s' #) = other s++                               in limit s' $ binAny s' uB tB lA++           | otherwise      -> Incomparable++++-- | \(\mathcal{O}(n_A + n_B)\).+--   Determine whether two trees' key sets are disjoint.+disjoint :: Patricia a -> Patricia b -> Bool+disjoint = anyAny+  where+    anyAny tA tB =+      case tA of+        Bin pA lA rA -> binAny (# pA, lA, rA #) tA tB++        Tip kA _ -> tipAny kA tA tB++        Nil -> True++    tipAny kA tA tB =+      case tB of+        Bin pB lB rB -> tipBin kA tA (# pB, lB, rB #)++        Tip kB _ -> kA /= kB++        Nil -> True++    binAny :: forall a b. UBin a -> Patricia a -> Patricia b -> Bool+    binAny uA tA tB =+      case tB of+        Bin pB lB rB -> binBin uA tA (# pB, lB, rB #) tB++        Tip kB _ -> tipBin kB tB uA++        Nil -> True++    tipBin kA tA (# pB, lB, rB #)+      | beyond pB kA = True+      | otherwise    = tipAny kA tA $ if kA < pB+                                        then lB+                                        else rB++    binBin uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      case Prelude.compare pA pB of+        EQ                  -> anyAny lA lB && anyAny rA rB++        LT | pB <= upper pA -> binAny uB tB rA+           | pA >= lower pB -> binAny uA tA lB+           | otherwise      -> True++        GT | pA <= upper pB -> binAny uA tA rB+           | pB >= lower pA -> binAny uB tB lA+           | otherwise      -> True++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Unbiased intersection of two trees.+intersection :: Patricia a -> Patricia a -> Patricia a+intersection = anyAny+  where+    anyAny tA tB =+      case tA of+        Bin pA lA rA -> binAny (# pA, lA, rA #) tA tB++        Tip kA _ -> tipAny kA tA tB++        Nil -> Nil++    tipAny kA tA tB =+      case tB of+        Bin pB lB rB -> tipBin kA tA (# pB, lB, rB #)++        Tip kB _+          | kA == kB  -> tA+          | otherwise -> Nil++        Nil -> Nil++    binAny uA tA tB =+      case tB of+        Bin pB lB rB -> binBin uA tA (# pB, lB, rB #) tB++        Tip kB _ -> tipBin kB tB uA++        Nil -> Nil++    tipBin kA tA (# pB, lB, rB #)+      | beyond pB kA = Nil+      | otherwise    = tipAny kA tA $ if kA < pB+                                        then lB+                                        else rB++    binBin uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      case Prelude.compare pA pB of+        EQ                  -> rebin pA (anyAny lA lB) (anyAny rA rB)++        LT | pB <= upper pA -> binAny uB tB rA+           | pA >= lower pB -> binAny uA tA lB+           | otherwise      -> Nil++        GT | pA <= upper pB -> binAny uA tA rB+           | pB >= lower pA -> binAny uB tB lA+           | otherwise      -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Left-biased intersection of two trees.+intersectionL :: Patricia a -> Patricia b -> Patricia a+intersectionL =+  intersection_ $ \s k a b ->+    let !(# c #) = case s of+                     L -> (# a #)+                     R -> (# b #)+    in Tip k c++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Intersection of two trees with a combining function.+intersectionWith+  :: (a -> b -> c)+  -> Patricia a+  -> Patricia b+  -> Patricia c+intersectionWith f =+  intersection_ $ \s k a b ->+    let !(# c #) = case s of+                     L -> (# f a b #)+                     R -> (# f b a #)+    in Tip k c++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   Intersection of two trees with a combining function.+intersectionWithKey+  :: (Word -> a -> b -> c)+  -> Patricia a+  -> Patricia b+  -> Patricia c+intersectionWithKey f =+  intersection_ $ \s k a b ->+    let !(# c #) = case s of+                     L -> (# f k a b #)+                     R -> (# f k b a #)+    in Tip k c++++{-# INLINE intersection_ #-}+intersection_+  :: (forall x y. S x y a b -> Key -> x -> y -> Patricia c)+  -> Patricia a+  -> Patricia b+  -> Patricia c+intersection_ (f :: forall n o. S n o x y -> Word -> n -> o -> Patricia c) =+  anyAny L+  where+    anyAny+      :: forall a b. S a b x y -> Patricia a -> Patricia b -> Patricia c+    anyAny s tA tB =+      case tA of+        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB++        Tip kA a -> tipAny s (# kA, a #) tA tB++        Nil -> Nil++    tipAny+      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> Patricia c+    tipAny s uA@(# kA, a #) tA tB =+      case tB of+        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #)++        Tip kB b+          | kA == kB  -> f s kA a b+          | otherwise -> Nil++        Nil -> Nil++    binAny+      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> Patricia c+    binAny s uA tA tB =+      case tB of+        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB++        Tip kB b -> let !(# s' #) = other s+                    in tipBin s' (# kB, b #) tB uA++        Nil -> Nil++    tipBin+      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> Patricia c+    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #)+      | beyond pB kA = Nil+      | otherwise    = tipAny s uA tA $ if kA < pB+                                          then lB+                                          else rB++    binBin+      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> Patricia c+    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      case Prelude.compare pA pB of+        EQ                  -> rebin pA (anyAny s lA lB) (anyAny s rA rB)++        LT | pB <= upper pA -> let !(# s' #) = other s+                               in binAny s' uB tB rA+           | pA >= lower pB -> binAny s uA tA lB+           | otherwise      -> Nil++        GT | pA <= upper pB -> binAny s uA tA rB+           | pB >= lower pA -> let !(# s' #) = other s+                               in binAny s' uB tB lA+           | otherwise      -> Nil++++{-# INLINE merge #-}+-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n_A + n_B)\).+--   General merge of two trees.+--+--   Collision and single value functions __must__ return either+--   'Tip' with the respective key, or 'Nil'.+--+--   Subtree argument functions may return any tree, however the shape of said tree+--   __must__ be compatible with the prefix passed to the function.+--+--   This functions inlines when all argument functions are provided.+merge+  :: (Key -> a -> b -> Patricia c)                      -- ^ Collision+  -> (Key -> a -> Patricia c)                           -- ^ Single left value+  -> (Prefix -> Patricia a -> Patricia a -> Patricia c) -- ^ Left subtree+  -> (Key -> b -> Patricia c)                           -- ^ Single right value+  -> (Prefix -> Patricia b -> Patricia b -> Patricia c) -- ^ Right subtree+  -> Patricia a+  -> Patricia b+  -> Patricia c+merge (f :: Key -> x -> y -> Patricia c) oneX treeX oneY treeY = anyAny L+  where+    {-# INLINE side #-}+    side one tree t =+      case t of+        Bin p l r -> tree p l r+        Tip k a   -> one k a+        Nil       -> Nil++    sideX = side oneX treeX++    sideY = side oneY treeY++    sideA :: forall a b. S a b x y -> Patricia a -> Patricia c+    sideA s tA = case s of+                   L -> sideX tA+                   R -> sideY tA++    sideB :: forall a b. S a b x y -> Patricia b -> Patricia c+    sideB s tB = case s of+                   L -> sideY tB+                   R -> sideX tB++    anyAny+      :: forall a b. S a b x y -> Patricia a -> Patricia b -> Patricia c+    anyAny s tA tB =+      case tA of+        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB++        Tip kA a     -> tipAny s (# kA, a #) tA tB++        Nil          -> sideB s tB++    tipAny+      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> Patricia c+    tipAny s uA@(# kA, a #) tA tB =+      case tB of+        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #)++        Tip kB b+          | kA == kB  -> case s of+                           L -> f kA a b+                           R -> f kA b a++          | otherwise -> case s of+                           L -> safeJoin kA (oneX kA a) kB (sideY tB)+                           R -> safeJoin kA (oneY kA a) kB (sideX tB)++        Nil          -> sideA s tA++    binAny+      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> Patricia c+    binAny s uA tA tB =+      case tB of+        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB++        Tip kB b     -> let !(# s' #) = other s+                        in tipBin s' (# kB, b #) tB uA++        Nil          -> sideA s tA++    tipBin+      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> Patricia c+    tipBin s uA@(# kA, a #) tA (# pB, lB, rB #)+      | beyond pB kA = case s of+                         L -> safeJoin kA (oneX kA a) pB (treeY pB lB rB)+                         R -> safeJoin kA (oneY kA a) pB (treeX pB lB rB)++      | kA < pB      = rebin pB (tipAny s uA tA lB) (sideB s rB)++      | otherwise    = rebin pB (sideB s lB) (tipAny s uA tA rB)++    binBin+      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> Patricia c+    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      let {-# NOINLINE no #-}+          no = case s of+                 L -> safeJoin pA (treeX pA lA rA) pB (treeY pB lB rB)+                 R -> safeJoin pA (treeY pA lA rA) pB (treeX pB lB rB)++      in case Prelude.compare pA pB of+           EQ                  -> rebin pA (anyAny s lA lB) (anyAny s rA rB)++           LT | pB <= upper pA -> let !(# s' #) = other s++                                  in rebin pA (sideA s lA) (binAny s' uB tB rA)++              | pA >= lower pB -> rebin pB (binAny s uA tA lB) (sideB s rB)++              | otherwise      -> no++           GT | pA <= upper pB -> rebin pB (sideB s lB) (binAny s uA tA rB)++              | pB >= lower pA -> let !(# s' #) = other s++                                  in rebin pA (binAny s' uB tB lA) (sideA s rA)++              | otherwise      -> no++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the value at a key in the tree.+lookup :: Word -> Patricia a -> Maybe a+lookup !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> Nothing+          | w < p      -> go l+          | otherwise  -> go r++        Tip k a+          | k == w    -> Just a+          | otherwise -> Nothing++        Nil -> Nothing++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the value at a key in the tree, falling back to the given default value+--   if it does not exist.+find :: a -> Word -> Patricia a -> a+find d !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> d+          | w < p      -> go l+          | otherwise  -> go r++        Tip k a+          | k == w    -> a+          | otherwise -> d++        Nil -> d++-- | \(\mathcal{O}(\min(n,W))\).+--   Check whether the value exists at a key in the tree.+member :: Word -> Patricia a -> Bool+member !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> False+          | w < p      -> go l+          | otherwise  -> go r++        Tip k _ -> k == w++        Nil -> False++-- 'lookup' that doesn't allocate a 'Maybe'.+takeOne :: Word -> Patricia a -> Patricia a+takeOne !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> Nil+          | w < p      -> go l+          | otherwise  -> go r++        Tip k _+          | k == w    -> t+          | otherwise -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Insert a new value in the tree at the given key.+--   If a value already exists at that key, it is replaced.+insert :: Word -> a -> Patricia a -> Patricia a+insert !w a = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> join w (Tip w a) p t+          | w < p      -> Bin p (go l) r+          | otherwise  -> Bin p l (go r)++        Tip k _+          | k == w    -> Tip k a+          | otherwise -> join w (Tip w a) k t++        Nil -> Tip w a++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Insert a new value in the tree at the given key.+--   If a value already exists at that key, the function is used instead.+insertWith :: (a -> a) -> Word -> a -> Patricia a -> Patricia a+insertWith f !w b = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> join w (Tip w b) p t+          | w < p      -> Bin p (go l) r+          | otherwise  -> Bin p l (go r)++        Tip k a+          | k == w    -> Tip k (f a)+          | otherwise -> join w (Tip w b) k t++        Nil -> Tip w b++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Apply a function to a value in the tree at the given key.+adjust :: (a -> a) -> Word -> Patricia a -> Patricia a+adjust f !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> t+          | w < p      -> Bin p (go l) r+          | otherwise  -> Bin p l (go r)++        Tip k a+          | k == w    -> Tip k (f a)+          | otherwise -> t++        Nil -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Delete a value in the tree at the given key.+delete :: Word -> Patricia a -> Patricia a+delete !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> t+          | w < p      -> rebinL p (go l) r+          | otherwise  -> rebinR p l (go r)++        Tip k _+          | k == w    -> Nil+          | otherwise -> t++        Nil -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Update or delete a value in the tree at the given key.+update :: (a -> Maybe a) -> Word -> Patricia a -> Patricia a+update f !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> t+          | w < p      -> rebinL p (go l) r+          | otherwise  -> rebinR p l (go r)++        Tip k a+          | k == w    -> retip k (f a)+          | otherwise -> t++        Nil -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Insert, update or delete a value in the tree at the given key.+alter :: (Maybe a -> Maybe a) -> Word -> Patricia a -> Patricia a+alter f !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> case f Nothing of+                            Just b  -> join p t w (Tip w b)+                            Nothing -> t++          | w < p      -> rebinL p (go l) r+          | otherwise  -> rebinR p l (go r)++        Tip k a+          | k == w    -> case f (Just a) of+                           Just b  -> Tip k b+                           Nothing -> Nil++          | otherwise -> case f Nothing of+                           Just b  -> join k t w (Tip w b)+                           Nothing -> t++        Nil -> case f Nothing of+                 Just b  -> Tip w b+                 Nothing -> Nil++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at a largest key smaller than or equal to the given key.+lookupL :: Word -> Patricia a -> Maybe (Lookup a)+lookupL !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then go l+                   else Nothing++            else Just $! if w <= upper p+                           then case go r of+                                  Just x  -> x+                                  Nothing -> unsafeLookupMaxWithKey l++                           else unsafeLookupMaxWithKey r++        Tip k a+          | k <= w    -> Just $! Lookup k a+          | otherwise -> Nothing++        Nil -> Nothing++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at a smallest key greater than or equal to the given key.+lookupR :: Word -> Patricia a -> Maybe (Lookup a)+lookupR !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then Just $! if w >= lower p+                           then case go l of+                                  Just x  -> x+                                  Nothing -> unsafeLookupMinWithKey r++                           else unsafeLookupMinWithKey l++            else if w <= upper p+                   then go r+                   else Nothing++        Tip k a+          | k >= w    -> Just $! Lookup k a+          | otherwise -> Nothing++        Nil -> Nothing++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_L)\).+--   Apply a function to every value for which the key is smaller than+--   or equal to the given one.+adjustL :: (a -> a) -> Word -> Patricia a -> Patricia a+adjustL f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then Bin p (go l) r+                   else t++            else Bin p (Data.Patricia.Word.Lazy.Internal.map f l) $+                   if w <= upper p+                     then go r+                     else Data.Patricia.Word.Lazy.Internal.map f r++        Tip k a+          | k <= w    -> Tip k (f a)+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_L)\).+--   Apply a function to every value for which the key is smaller than+--   or equal to the given one.+adjustLWithKey :: (Word -> a -> a) -> Word -> Patricia a -> Patricia a+adjustLWithKey f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then Bin p (go l) r+                   else t++            else Bin p (mapWithKey f l) $+                   if w <= upper p+                     then go r+                     else mapWithKey f r++        Tip k a+          | k <= w    -> Tip k (f k a)+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Delete values for which keys are smaller than or equal to the given one.+deleteL :: Word -> Patricia a -> Patricia a+deleteL !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then rebinL p (go l) r+                   else t++            else if w <= upper p+                   then go r+                   else Nil++        Tip k _+          | k <= w    -> Nil+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_L)\).+--   Update every value for which the key is smaller than or equal to the given one.+updateL :: (a -> Maybe a) -> Word -> Patricia a -> Patricia a+updateL f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then rebinL p (go l) r+                   else t++            else rebin p (mapMaybe f l) $+                   if w <= upper p+                     then go r+                     else mapMaybe f r++        Tip k a+          | k <= w    -> retip k (f a)+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_L)\).+--   Update every value for which the key is smaller than or equal to the given one.+updateLWithKey :: (Word -> a -> Maybe a) -> Word -> Patricia a -> Patricia a+updateLWithKey f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then rebinL p (go l) r+                   else t++            else rebin p (mapMaybeWithKey f l) $+                   if w <= upper p+                     then go r+                     else mapMaybeWithKey f r++        Tip k a+          | k <= w    -> retip k (f k a)+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Take values for which keys are smaller than or equal to the given one.+takeL :: Word -> Patricia a -> Patricia a+takeL !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then go l+                   else Nil++            else if w <= upper p+                   then rebinR p l (go r)+                   else t++        Tip k _+          | k <= w    -> t+          | otherwise -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_R)\).+--   Apply a function to every value for which the key is greater than+--   or equal to the given one.+adjustR :: (a -> a) -> Word -> Patricia a -> Patricia a+adjustR f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then let l' = if w >= lower p+                            then go l+                            else Data.Patricia.Word.Lazy.Internal.map f l++                 in Bin p l' (Data.Patricia.Word.Lazy.Internal.map f r)++            else if w <= upper p+                   then Bin p l (go r)+                   else t++        Tip k a+          | k >= w    -> Tip k (f a)+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_R)\).+--   Apply a function to every value for which the key is greater than+--   or equal to the given one.+adjustRWithKey :: (Word -> a -> a) -> Word -> Patricia a -> Patricia a+adjustRWithKey f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then let l' = if w >= lower p+                            then go l+                            else mapWithKey f l++                 in Bin p l' (mapWithKey f r)++            else if w <= upper p+                   then Bin p l (go r)+                   else t++        Tip k a+          | k >= w    -> Tip k (f k a)+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Delete values for which keys are greater than or equal to the given one.+deleteR :: Word -> Patricia a -> Patricia a+deleteR !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then go l+                   else Nil++            else if w <= upper p+                   then rebinR p l (go r)+                   else t++        Tip k _+          | k >= w    -> Nil+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_R)\).+--   Update every value for which the key is greater than or equal to the given one.+updateR :: (a -> Maybe a) -> Word -> Patricia a -> Patricia a+updateR f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then let l' = if w >= lower p+                            then go l+                            else mapMaybe f l++                 in rebin p l' (mapMaybe f r)++            else if w <= upper p+                   then rebinR p l (go r)+                   else t++        Tip k a+          | k >= w    -> retip k (f a)+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_R)\).+--   Update every value for which the key is greater than or equal to the given one.+updateRWithKey :: (Word -> a -> Maybe a) -> Word -> Patricia a -> Patricia a+updateRWithKey f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then let l' = if w >= lower p+                            then go l+                            else mapMaybeWithKey f l++                 in rebin p l' (mapMaybeWithKey f r)++            else if w <= upper p+                   then rebinR p l (go r)+                   else t++        Tip k a+          | k >= w    -> retip k (f k a)+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Take values for which keys are greater than or equal to the given one.+takeR :: Word -> Patricia a -> Patricia a+takeR !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then rebinL p (go l) r+                   else t++            else if w <= upper p+                   then go r+                   else Nil++        Tip k _+          | k >= w    -> t+          | otherwise -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+adjustRange :: (a -> a) -> Range -> Patricia a -> Patricia a+adjustRange f (UnsafeRange kL kR)+  | kL == kR  = adjust f kL+  | otherwise = unsafeAdjustRange f kL kR++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeAdjustRange+  :: (a -> a)+  -> Word     -- ^ \(k_L\)+  -> Word     -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeAdjustRange f !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> Bin p (adjustR f wL l) (adjustL f wR r)++            LT | pM <= upper p -> Bin p l (go r)+               | p >= lower pM -> if wL < p+                                    then Bin p+                                           (adjustR f wL l)+                                           (Data.Patricia.Word.Lazy.Internal.map f r)++                                    else Bin p l (adjustR f wL r)++               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then Bin p+                                           (Data.Patricia.Word.Lazy.Internal.map f l)+                                           (adjustL f wR r)++                                    else Bin p (adjustL f wR l) r++               | pM >= lower p -> Bin p (go l) r+               | otherwise     -> t++        Tip k a+          | k >= wL && k <= wR -> Tip k (f a)+          | otherwise          -> t++        Nil -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+adjustRangeWithKey :: (Word -> a -> a) -> Range -> Patricia a -> Patricia a+adjustRangeWithKey f (UnsafeRange kL kR)+  | kL == kR  = adjust (f kL) kL+  | otherwise = unsafeAdjustRangeWithKey f kL kR++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeAdjustRangeWithKey+  :: (Word -> a -> a)+  -> Word             -- ^ \(k_L\)+  -> Word             -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeAdjustRangeWithKey f !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> Bin p (adjustRWithKey f wL l) (adjustLWithKey f wR r)++            LT | pM <= upper p -> Bin p l (go r)+               | p >= lower pM -> if wL < p+                                    then Bin p (adjustRWithKey f wL l) (mapWithKey f r)+                                    else Bin p l (adjustRWithKey f wL r)++               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then Bin p (mapWithKey f l) (adjustLWithKey f wR r)+                                    else Bin p (adjustLWithKey f wR l) r++               | pM >= lower p -> Bin p (go l) r+               | otherwise     -> t++        Tip k a+          | k >= wL && k <= wR -> Tip k (f k a)+          | otherwise          -> t++        Nil -> Nil+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Delete values for which keys are in the given range.+deleteRange :: Range -> Patricia a -> Patricia a+deleteRange (UnsafeRange kL kR)+  | kL == kR  = delete kL+  | otherwise = unsafeDeleteRange kL kR++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Delete values for which keys are in the given range.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeDeleteRange+  :: Word         -- ^ \(k_L\)+  -> Word         -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeDeleteRange !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> rebin p (deleteR wL l) (deleteL wR r)++            LT | pM <= upper p -> rebinR p l (go r)+               | p >= lower pM -> if wL < p+                                    then deleteR wL l+                                    else rebinR p l (deleteR wL r)+               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then deleteL wR r+                                    else rebinL p (deleteL wR l) r++               | pM >= lower p -> rebinL p (go l) r+               | otherwise     -> t++        Tip k _+          | k >= wL && k <= wR -> Nil+          | otherwise          -> t++        Nil -> Nil+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_I)\).+--   Update every value for which the key is in the given range.+updateRange :: (a -> Maybe a) -> Range -> Patricia a -> Patricia a+updateRange f (UnsafeRange kL kR)+  | kL == kR  = update f kL+  | otherwise = unsafeUpdateRange f kL kR++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_I)\).+--   Update every value for which the key is in the given range.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeUpdateRange+  :: (a -> Maybe a)+  -> Word           -- ^ \(k_L\)+  -> Word           -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeUpdateRange f !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> rebin p (updateR f wL l) (updateL f wR r)++            LT | pM <= upper p -> rebinR p l (go r)+               | p >= lower pM -> if wL < p+                                    then rebinL p (updateR f wL l) (mapMaybe f r)+                                    else rebinR p l (updateR f wL r)+               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then rebinR p (mapMaybe f l) (updateL f wR r)+                                    else rebinL p (updateL f wR l) r++               | pM >= lower p -> rebinL p (go l) r+               | otherwise     -> t++        Tip k a+          | k >= wL && k <= wR -> retip k (f a)+          | otherwise          -> t++        Nil -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_I)\).+--   Update every value for which the key is in the given range.+updateRangeWithKey :: (Word -> a -> Maybe a) -> Range -> Patricia a -> Patricia a+updateRangeWithKey f (UnsafeRange kL kR)+  | kL == kR  = update (f kL) kL+  | otherwise = unsafeUpdateRangeWithKey f kL kR++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W) + n_I)\).+--   Update every value for which the key is in the given range.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeUpdateRangeWithKey+  :: (Word -> a -> Maybe a)+  -> Word                   -- ^ \(k_L\)+  -> Word                   -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeUpdateRangeWithKey f !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> rebin p (updateRWithKey f wL l) (updateLWithKey f wR r)++            LT | pM <= upper p -> rebinR p l (go r)+               | p >= lower pM -> if wL < p+                                    then rebinL p (updateRWithKey f wL l)+                                                  (mapMaybeWithKey f r)++                                    else rebinR p l (updateRWithKey f wL r)+               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then rebinR p (mapMaybeWithKey f l)+                                                  (updateLWithKey f wR r)++                                    else rebinL p (updateLWithKey f wR l) r++               | pM >= lower p -> rebinL p (go l) r+               | otherwise     -> t++        Tip k a+          | k >= wL && k <= wR -> retip k (f k a)+          | otherwise          -> t++        Nil -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Take values for which keys are in the given range.+takeRange :: Range -> Patricia a -> Patricia a+takeRange (UnsafeRange kL kR)+  | kL == kR  = takeOne kL+  | otherwise = unsafeTakeRange kL kR++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Take values for which keys are in the given range.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeTakeRange+  :: Word       -- ^ \(k_L\)+  -> Word       -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeTakeRange !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> rebin p (takeR wL l) (takeL wR r)++            LT | pM <= upper p -> go r+               | p >= lower pM -> if wL < p+                                    then rebinL p (takeR wL l) r+                                    else takeR wL r++               | otherwise     -> Nil++            GT | p <= upper pM -> if wR >= p+                                    then rebinR p l (takeL wR r)+                                    else takeL wR l++               | pM >= lower p -> go l+               | otherwise     -> Nil++        Tip k _+          | k >= wL && k <= wR -> t+          | otherwise          -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Split the tree into two, such that+--   values with keys smaller than or equal to the given one are on the left,+--   and values with keys greater than the given one are on the right.+splitL :: Word -> Patricia a -> (Patricia a, Patricia a)+splitL !w = \t ->+  case go t of+    (# l, r #) -> (l, r)+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then let !(# ll, lr #) = go l+                        in (# ll, rebinL p lr r #)++                   else (# Nil, t #)++            else if w <= upper p+                   then let !(# rl, rr #) = go r+                        in (# rebinR p l rl, rr #)++                   else (# t, Nil #)++        Tip k _+          | w >= k    -> (# t, Nil #)+          | otherwise -> (# Nil, t #)++        Nil -> (# Nil, Nil #)++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Split the tree into two, such that+--   values with keys smaller than the given one are on the left,+--   and values with keys greater than or equal to the given one are on the right.+splitR :: Word -> Patricia a -> (Patricia a, Patricia a)+splitR !w = \t ->+  case go t of+    (# l, r #) -> (l, r)+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then let (# ll, lr #) = go l+                        in (# ll, rebinL p lr r #)++                   else (# Nil, t #)++            else if w <= upper p+                   then let (# rl, rr #) = go r+                        in (# rebinR p l rl, rr #)++                   else (# t, Nil #)++        Tip k _+          | w > k     -> (# t, Nil #)+          | otherwise -> (# Nil, t #)++        Nil -> (# Nil, Nil #)++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Split the tree into two, such that+--   values with keys smaller than the given one are on the left,+--   values with keys greater than the given one are on the right,+--   and the value at the given key is returned separately.+splitLookup :: Word -> Patricia a -> (Patricia a, Maybe a, Patricia a)+splitLookup !w = \t ->+  case go t of+    (# l, mx, r #) -> (l, mx, r)+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then let !(# ll, mx, lr #) = go l+                        in (# ll, mx, rebinL p lr r #)++                   else (# Nil, Nothing, t #)++            else if w <= upper p+                   then let !(# rl, mx, rr #) = go r+                        in (# rebinR p l rl, mx, rr #)++                   else (# t, Nothing, Nil #)++        Tip k a ->+          case w `Prelude.compare` k of+            EQ -> (# Nil, Just a , Nil #)+            GT -> (# t  , Nothing, Nil #)+            LT -> (# Nil, Nothing, t   #)++        Nil -> (# Nil, Nothing, Nil #)++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Filter values that satisfy the value predicate.+filter :: (a -> Bool) -> Patricia a -> Patricia a+filter f = go+  where+    go t =+      case t of+        Bin p l r -> rebin p (go l) (go r)++        Tip _ a+          | f a       -> t+          | otherwise -> Nil++        Nil -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Filter values that satisfy the value predicate.+filterWithKey :: (Word -> a -> Bool) -> Patricia a -> Patricia a+filterWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> rebin p (go l) (go r)++        Tip k a+          | f k a     -> t+          | otherwise -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Apply a function to every value in the tree and create one out of 'Just' values.+mapMaybe :: (a -> Maybe b) -> Patricia a -> Patricia b+mapMaybe f = go+  where+    go t =+      case t of+        Bin p l r -> rebin p (go l) (go r)++        Tip k a ->+          case f a of+            Just b  -> Tip k b+            Nothing -> Nil++        Nil -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Apply a function to every value in the tree+--   and create a tree out of 'Just' results.+mapMaybeWithKey :: (Word -> a -> Maybe b) -> Patricia a -> Patricia b+mapMaybeWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> rebin p (go l) (go r)++        Tip k a ->+          case f k a of+            Just b  -> Tip k b+            Nothing -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Split the tree into two, such that values that satisfy the predicate+--   are on the left and values that do not are on the right.+partition :: (a -> Bool) -> Patricia a -> (Patricia a, Patricia a)+partition f = \t ->+  case go t of+    (# l, r #) -> (l, r)+  where+    go t =+      case t of+        Bin p l r ->+          let !(# ll, lr #) = go l+              !(# rl, rr #) = go r++          in (# rebin p ll rl, rebin p lr rr #)++        Tip _ a+          | f a       -> (# t, Nil #)+          | otherwise -> (# Nil, t #)++        Nil -> (# Nil, Nil #)++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Split the tree into two, such that values that satisfy the predicate+--   are on the left and values that do not are on the right.+partitionWithKey :: (Word -> a -> Bool) -> Patricia a -> (Patricia a, Patricia a)+partitionWithKey f = \t ->+  case go t of+    (# l, r #) -> (l, r)+  where+    go t =+      case t of+        Bin p l r ->+          let !(# ll, lr #) = go l+              !(# rl, rr #) = go r++          in (# rebin p ll rl, rebin p lr rr #)++        Tip k a+          | f k a     -> (# t, Nil #)+          | otherwise -> (# Nil, t #)++        Nil -> (# Nil, Nil #)+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Apply a function to every value in the tree and create two trees,+--   one out of 'Left' results and one out of 'Right' ones.+mapEither :: (a -> Either b c) -> Patricia a -> (Patricia b, Patricia c)+mapEither f = \t ->+  case go t of+    (# l, r #) -> (l, r)+  where+    go t =+      case t of+        Bin p l r ->+          let !(# ll, lr #) = go l+              !(# rl, rr #) = go r++          in (# rebin p ll rl, rebin p lr rr #)++        Tip k a ->+          case f a of+            Left b  -> (# Tip k b, Nil #)+            Right c -> (# Nil, Tip k c #)++        Nil -> (# Nil, Nil #)++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(n)\).+--   Apply a function to every value in the tree and create two trees,+--   one out of 'Left' results and one out of 'Right' ones.+mapEitherWithKey :: (Word -> a -> Either b c) -> Patricia a -> (Patricia b, Patricia c)+mapEitherWithKey f = \t ->+  case go t of+    (# l, r #) -> (l, r)+  where+    go t =+      case t of+        Bin p l r ->+          let !(# ll, lr #) = go l+              !(# rl, rr #) = go r++          in (# rebin p ll rl, rebin p lr rr #)++        Tip k a ->+          case f k a of+            Left b  -> (# Tip k b, Nil #)+            Right c -> (# Nil, Tip k c #)++        Nil -> (# Nil, Nil #)++++moduleLoc :: String+moduleLoc = "Patricia.Word.Lazy"++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the leftmost key in the tree.+lookupMin :: Patricia a -> Maybe a+lookupMin Nil = Nothing+lookupMin t   = let !(# a #) = unsafeLookupMin t+                in Just a++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the leftmost key in the tree.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeLookupMin :: Patricia a -> (# a #)+unsafeLookupMin t =+  case t of+    Bin _ l _ -> unsafeLookupMin l+    Tip _ a   -> (# a #)+    Nil       -> throw $ MalformedTree moduleLoc "lookupMin"+++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the leftmost key in the tree.+lookupMinWithKey :: Patricia a -> Maybe (Lookup a)+lookupMinWithKey Nil = Nothing+lookupMinWithKey t   = Just $! unsafeLookupMinWithKey t++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the leftmost key in the tree.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeLookupMinWithKey :: Patricia a -> Lookup a+unsafeLookupMinWithKey t =+  case t of+    Bin _ l _ -> unsafeLookupMinWithKey l+    Tip k a   -> Lookup k a+    Nil       -> throw $ MalformedTree moduleLoc "lookupMinWithKey"++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the rightmost key in the tree.+lookupMax :: Patricia a -> Maybe a+lookupMax Nil = Nothing+lookupMax t   = let !(# a #) = unsafeLookupMax t+                in Just a++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the rightmost key in the tree.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeLookupMax :: Patricia a -> (# a #)+unsafeLookupMax t =+  case t of+    Bin _ _ r -> unsafeLookupMax r+    Tip _ a   -> (# a #)+    Nil       -> throw $ MalformedTree moduleLoc "lookupMax"+++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the rightmost key in the tree.+lookupMaxWithKey :: Patricia a -> Maybe (Lookup a)+lookupMaxWithKey Nil = Nothing+lookupMaxWithKey t   = Just $! unsafeLookupMaxWithKey t++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the rightmost key in the tree.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeLookupMaxWithKey :: Patricia a -> Lookup a+unsafeLookupMaxWithKey t =+  case t of+    Bin _ _ r -> unsafeLookupMaxWithKey r+    Tip k a   -> Lookup k a+    Nil       -> throw $ MalformedTree moduleLoc "lookupMaxWithKey"++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Delete a value at the leftmost key in the tree.+deleteMin :: Patricia a -> Patricia a+deleteMin = go+  where+    go t =+      case t of+        Bin p l r -> rebinL p (go l) r+        _         -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Delete a value at the rightmost key in the tree.+deleteMax :: Patricia a -> Patricia a+deleteMax = go+  where+    go t =+      case t of+        Bin p l r -> rebinR p l (go r)+        _         -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Update a value at the leftmost key in the tree.+adjustMin :: (a -> a) -> Patricia a -> Patricia a+adjustMin f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) r+        Tip k a   -> Tip k (f a)+        Nil       -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Update a value at the leftmost key in the tree.+adjustMinWithKey :: (Word -> a -> a) -> Patricia a -> Patricia a+adjustMinWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) r+        Tip k a   -> Tip k (f k a)+        Nil       -> Nil+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Update a value at the rightmost key in the tree.+adjustMax :: (a -> a) -> Patricia a -> Patricia a+adjustMax f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p l (go r)+        Tip k a   -> Tip k (f a)+        Nil       -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Update a value at the rightmost key in the tree.+adjustMaxWithKey :: (Word -> a -> a) -> Patricia a -> Patricia a+adjustMaxWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p l (go r)+        Tip k a   -> Tip k (f k a)+        Nil       -> Nil++++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Update or delete a value at the leftmost key in the tree.+updateMin :: (a -> Maybe a) -> Patricia a -> Patricia a+updateMin f = go+  where+    go t =+      case t of+        Bin p l r -> rebinL p (go l) r+        Tip k a   -> retip k (f a)+        Nil       -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Update or delete a value at the leftmost key in the tree.+updateMinWithKey :: (Word -> a -> Maybe a) -> Patricia a -> Patricia a+updateMinWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> rebinL p (go l) r+        Tip k a   -> retip k (f k a)+        Nil       -> Nil+++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Update or delete a value at the rightmost key in the tree.+updateMax :: (a -> Maybe a) -> Patricia a -> Patricia a+updateMax f = go+  where+    go t =+      case t of+        Bin p l r -> rebinR p l (go r)+        Tip k a   -> retip k (f a)+        Nil       -> Nil++-- | \(\mathcal{O}(1)\texttt{+}, \mathcal{O}(\min(n,W))\).+--   Update or delete a value at the rightmost key in the tree.+updateMaxWithKey :: (Word -> a -> Maybe a) -> Patricia a -> Patricia a+updateMaxWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> rebinR p l (go r)+        Tip k a   -> retip k (f k a)+        Nil       -> Nil++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the leftmost value and return it alongside the tree without it.+minView :: Patricia a -> Maybe (ViewL a)+minView Nil = Nothing+minView t   = Just $! unsafeMinView t++-- | The leftmost value with its key and the rest of the tree.+data ViewL a = ViewL {-# UNPACK #-} !(Lookup a) !(Patricia a)+               deriving Show++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the leftmost value and return it alongside the tree without it.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeMinView :: Patricia a -> ViewL a+unsafeMinView t =+  case t of+    Bin p l r ->+      let !(ViewL a l0) = unsafeMinView l+      in ViewL a (rebinL p l0 r)++    Tip k a -> ViewL (Lookup k a) Nil++    Nil -> throw $ MalformedTree moduleLoc "minView"++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the rightmost value and return it alongside the tree without it.+maxView :: Patricia a -> Maybe (ViewR a)+maxView Nil = Nothing+maxView t   = Just $! unsafeMaxView t++-- | The rightmost value with its key and the rest of the tree.+data ViewR a = ViewR !(Patricia a) {-# UNPACK #-} !(Lookup a)+               deriving Show++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the rightmost value and return it alongside the tree without it.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeMaxView :: Patricia a -> ViewR a+unsafeMaxView t =+  case t of+    Bin p l r ->+      let !(ViewR r0 a) = unsafeMaxView r+      in ViewR (rebinR p l r0) a++    Tip k a -> ViewR Nil (Lookup k a)++    Nil -> throw $ MalformedTree moduleLoc "maxView"

@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskellQuotes #-}++{-|+    Template Haskell helper functions.+ -}++module Data.Patricia.Word.Lazy.TH where++import           Data.Patricia.Word.Lazy.Internal++import           Language.Haskell.TH.Syntax++++-- | \(\mathcal{O}(n)\).+--   Evaluate a tree of typed expressions.+sequenceCode :: Quote m => Patricia (Code m a) -> Code m (Patricia a)+sequenceCode t =+  case t of+    Bin p l r ->+      [|| Bin+            p+            $$(sequenceCode l)+            $$(sequenceCode r)+       ||]++    Tip k a     -> [|| Tip k $$(a) ||]+    Nil         -> [|| Nil ||]

@@ -0,0 +1,75 @@+{-# OPTIONS_HADDOCK not-home #-}++{-|+    Data structure internals, helper operations and unsafe functions.+ -}++module Data.Patricia.Word.Lazy.Unsafe+  ( Patricia (..)++    -- ** Bit operations+  , Prefix+  , Key++    -- | === Compare+  , beyond+  , upper+  , lower++    -- | === Create+  , Mask+  , zeroBit+  , mask+  , branchingBit++    -- * Exceptions+  , MalformedTree (..)++    -- * Range #range#+  , Range (..)++    -- ** Map+  , unsafeAdjustRange+  , unsafeAdjustRangeWithKey++    -- ** Delete+  , unsafeDeleteRange++    -- ** Update+  , unsafeUpdateRange+  , unsafeUpdateRangeWithKey++    -- ** Take+  , unsafeTakeRange++    -- * Edges+    -- ** Lookup+  , Lookup (..)++    -- | === Min+  , unsafeLookupMin+  , unsafeLookupMinWithKey++    -- | === Max+  , unsafeLookupMax+  , unsafeLookupMaxWithKey++    -- ** View+    -- | === Min+  , ViewL (..)+  , unsafeMinView++    -- | === Max+  , ViewR (..)+  , unsafeMaxView++    -- * Full-tree+    -- ** Merge+  , merge+  ) where++import           Data.Patricia.Word.Common+import           Data.Patricia.Word.Lazy.Internal+import           Radix.Exception+import           Radix.Word.Common+import           Radix.Word.Foundation

@@ -0,0 +1,278 @@+{-|+    @'StrictPatricia' a@ is a spine-strict big-endian PATRICIA tree, a compressed+    binary trie, using 'Word's as keys.++    == Laziness++    Evaluating the root of the tree (i.e. @(_ :: 'StrictPatricia' a)@) to+    weak head normal form evaluates the entire spine of the tree to normal form.++    Functions do not perform any additional evaluations unless+    their documentation directly specifies so.++    == Performance++    Each function's time complexity is provided in the documentation.++    \(n\) refers to the total number of entries in the tree.+    Parts of the tree are denoted using subscripts: \(n_L\) refers to the left side,+    \(n_R\) to the right side, \(n_I\) to a range (interval), and+    \(n_M\) to entries collected with the use of a 'Monoid'.++    \(W\) is the size of 'Word' in bits, i.e. @'Data.Bits.finiteBitSize' (0 :: 'Word')@.++    == Implementation++    Description of the PATRICIA tree and some of the algorithms implemented can be found+    within the following paper:++      * Chris Okasaki and Andy Gill, "/Fast Mergeable Integer Maps/",+        Workshop on ML, September 1998, pages 77-86,+        <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.37.5452>+ -}++module Data.Patricia.Word.Strict+  ( StrictPatricia+  , Patricia++    -- * Construct+  , empty+  , singleton++    -- ** Convert+  , toLazy++    -- * Single-key+    -- ** Lookup+  , Data.Patricia.Word.Strict.Internal.lookup+  , Data.Patricia.Word.Strict.Internal.find+  , member++    -- *** Dirty+    --+    -- | Dirty lookups omit intermediate checks and are thus faster for keys+    --   that are in the tree, at the cost of being slower for keys not in the tree.+  , dirtyLookup+  , dirtyFind+  , dirtyMember++    -- ** Insert+  , insert+  , insertWith+  , insertWith'++    -- ** Map+  , adjust+  , adjust'++    -- ** Delete+  , delete++    -- ** Update+  , update++  , alter++    -- ** Take+  , SplitLookup (..)+  , splitLookup++    -- * Directional+    -- ** Lookup+  , Lookup (..)+  , lookupL+  , lookupR++    -- ** Map+    -- | === Left+  , adjustL+  , adjustL'+  , adjustLWithKey+  , adjustLWithKey'++    -- | === Right+  , adjustR+  , adjustR'+  , adjustRWithKey+  , adjustRWithKey'++    -- ** Delete+  , deleteL+  , deleteR++    -- ** Update+    -- | === Left+  , updateL+  , updateLWithKey++    -- | === Right+  , updateR+  , updateRWithKey++    -- ** Take+  , Split (..)++    -- | === Left+  , takeL+  , splitL++    -- | === Right+  , takeR+  , splitR++    -- * Range+  , Range (Range)++    -- ** Map+  , adjustRange+  , adjustRange'++  , adjustRangeWithKey+  , adjustRangeWithKey'++    -- ** Delete+  , deleteRange++    -- ** Update+  , updateRange+  , updateRangeWithKey++    -- ** Take+  , takeRange++    -- * Edges++    -- ** Lookup+    -- | === Min+  , lookupMin+  , lookupMinWithKey++    -- | === Max+  , lookupMax+  , lookupMaxWithKey++    -- ** Map+    -- | === Min+  , adjustMin+  , adjustMin'+  , adjustMinWithKey+  , adjustMinWithKey'++    -- | === Max+  , adjustMax+  , adjustMax'+  , adjustMaxWithKey+  , adjustMaxWithKey'++    -- ** Delete+  , deleteMin+  , deleteMax++    -- ** Update+    -- | === Min+  , updateMin+  , updateMinWithKey++    -- | === Max+  , updateMax+  , updateMaxWithKey++    -- ** View+    -- | === Min+  , ViewL (..)+  , minView++    -- | === Max+  , ViewR (..)+  , maxView++    -- * Full tree+    -- ** Size+  , Data.Patricia.Word.Strict.Internal.null+  , size++    -- ** Map+  , Data.Patricia.Word.Strict.Internal.map+  , map'+  , mapWithKey+  , mapWithKey'++    -- ** Fold+    -- | === Left-to-right+  , Data.Patricia.Word.Strict.Internal.foldl+  , Data.Patricia.Word.Strict.Internal.foldl'+  , foldlWithKey+  , foldlWithKey'++    -- | === Right-to-left+  , Data.Patricia.Word.Strict.Internal.foldr+  , Data.Patricia.Word.Strict.Internal.foldr'+  , foldrWithKey+  , foldrWithKey'++    -- | === Monoid+  , Data.Patricia.Word.Strict.Internal.foldMap+  , foldMapWithKey++    -- ** Traverse+  , Data.Patricia.Word.Strict.Internal.traverse+  , traverseWithKey++    -- ** Filter+    -- | === One side+  , Data.Patricia.Word.Strict.Internal.filter+  , filterWithKey++  , mapMaybe+  , mapMaybeWithKey++    -- | === Both sides+  , partition+  , partitionWithKey++  , mapEither+  , mapEitherWithKey++    -- ** Comparison+  , PartialOrdering (..)+  , Data.Patricia.Word.Strict.Internal.compare++    -- ** Union+  , union+  , unionL+  , unionWith'+  , unionWithKey'++    -- ** Difference+  , difference+  , differenceWith+  , differenceWithKey++    -- ** Intersection+  , disjoint+  , intersection+  , intersectionL+  , intersectionWith'+  , intersectionWithKey'++    -- ** Merge+    -- | See 'Data.Patricia.Word.Strict.Unsafe.merge'.+  ) where++import           Data.Patricia.Word.Common+import           Data.Patricia.Word.Conversion+import           Data.Patricia.Word.Strict.Internal+import           Radix.Common+import           Radix.Word.Common++++-- | \(\mathcal{O}(1)\).+--   Empty tree.+empty :: Patricia a+empty = Nil++-- | \(\mathcal{O}(1)\).+--   Tree with a single entry.+singleton :: Word -> a -> Patricia a+singleton = Tip

@@ -0,0 +1,72 @@+{-|+    Safe functions for datatype introspection.+ -}++module Data.Patricia.Word.Strict.Debug+  ( -- * Show+    showsTree++    -- * Validate+  , Validity (..)+  , Reason (..)+  , validate+  ) where++import           Data.Patricia.Word.Debug+import           Data.Patricia.Word.Strict.Internal+import           Numeric.Long+import           Radix.Word.Debug++++-- | \(\mathcal{O}(n)\).+--   Shows the internal structure of the tree.+showsTree :: (a -> ShowS) -> Patricia a -> ShowS+showsTree f = go 0+  where+    go i t =+      mappend (replicate i ' ') .+        case t of+          Bin p l r ->+            showString "Bin " . showPrefix p . showChar '\n'+                              . go (i + 2) l . showChar '\n'+                              . go (i + 2) r++          Tip k a   ->+            showString "Tip " . showLongBin k . showString " => " . f a++          Nil       -> showString "Nil"++++-- | \(\mathcal{O}(n)\).+--   Checks whether the tree is well-formed.+validate :: Patricia a -> Validity+validate t =+  case t of+    Bin p l r+      | p == 0    -> Invalid ZeroPrefix+      | otherwise ->+          case go L p l of+            Valid -> go R p r+            err   -> err++    Tip _ _ -> Valid++    Nil -> Valid+  where+    go s q x =+      case x of+        Bin p l r+          | p == 0                 -> Invalid ZeroPrefix+          | not $ validBelow q s p -> Invalid $ PrefixBelow q p+          | otherwise              ->+              case go L p l of+                Valid -> go R p r+                err   -> err++        Tip k _+          | not $ validBelow q s k -> Invalid $ KeyBelow q k+          | otherwise              -> Valid++        Nil -> Invalid $ MalformedBin q

@@ -0,0 +1,3051 @@+{-# LANGUAGE BangPatterns+           , DeriveLift+           , GADTs+           , RankNTypes+           , ScopedTypeVariables+           , UnboxedTuples #-}++module Data.Patricia.Word.Strict.Internal+  ( StrictPatricia+  , Patricia (..)++  , Data.Patricia.Word.Strict.Internal.null+  , size++  , Data.Patricia.Word.Strict.Internal.map+  , map'+  , mapWithKey+  , mapWithKey'++  , Data.Patricia.Word.Strict.Internal.foldl+  , Data.Patricia.Word.Strict.Internal.foldl'+  , foldlWithKey+  , foldlWithKey'++  , Data.Patricia.Word.Strict.Internal.foldr+  , Data.Patricia.Word.Strict.Internal.foldr'+  , foldrWithKey+  , foldrWithKey'++  , Data.Patricia.Word.Strict.Internal.foldMap+  , foldMapWithKey++  , Data.Patricia.Word.Strict.Internal.traverse+  , traverseWithKey++  , union+  , unionL+  , unionWith'+  , unionWithKey'++  , difference+  , differenceWith+  , differenceWithKey++  , Data.Patricia.Word.Strict.Internal.compare++  , disjoint+  , intersection+  , intersectionL+  , intersectionWith'+  , intersectionWithKey'++  , merge++  , Data.Patricia.Word.Strict.Internal.lookup+  , Data.Patricia.Word.Strict.Internal.find+  , member+  , takeOne++  , dirtyLookup+  , dirtyFind+  , dirtyMember++  , insert+  , insertWith+  , insertWith'++  , adjust+  , adjust'++  , delete++  , update++  , alter++  , lookupL+  , lookupR++  , adjustL+  , adjustL'+  , adjustLWithKey+  , adjustLWithKey'++  , adjustR+  , adjustR'+  , adjustRWithKey+  , adjustRWithKey'++  , deleteL+  , deleteR++  , updateL+  , updateR+  , updateLWithKey+  , updateRWithKey++  , adjustRange+  , unsafeAdjustRange++  , adjustRange'+  , unsafeAdjustRange'++  , adjustRangeWithKey+  , unsafeAdjustRangeWithKey++  , adjustRangeWithKey'+  , unsafeAdjustRangeWithKey'++  , deleteRange+  , unsafeDeleteRange++  , updateRange+  , unsafeUpdateRange++  , updateRangeWithKey+  , unsafeUpdateRangeWithKey++  , takeRange+  , unsafeTakeRange++  , takeL+  , takeR++  , Split (..)+  , splitL+  , splitR++  , SplitLookup (..)+  , splitLookup++  , Data.Patricia.Word.Strict.Internal.filter+  , filterWithKey++  , mapMaybe+  , mapMaybeWithKey++  , partition+  , partitionWithKey++  , mapEither+  , mapEitherWithKey++  , lookupMin+  , lookupMinWithKey+  , lookupMax+  , lookupMaxWithKey++  , unsafeLookupMin+  , unsafeLookupMinWithKey+  , unsafeLookupMax+  , unsafeLookupMaxWithKey++  , deleteMin+  , deleteMax++  , adjustMin+  , adjustMin'+  , adjustMinWithKey+  , adjustMinWithKey'+  , adjustMax+  , adjustMax'+  , adjustMaxWithKey+  , adjustMaxWithKey'++  , updateMin+  , updateMinWithKey+  , updateMax+  , updateMaxWithKey++  , ViewL (..)+  , minView+  , unsafeMinView++  , ViewR (..)+  , maxView+  , unsafeMaxView+  ) where++import           Data.Patricia.Word.Common+import           Radix.Common+import           Radix.Exception+import           Radix.Word.Common+import           Radix.Word.Foundation++import           Control.Applicative+import           Control.DeepSeq+import           Control.Exception (throw)+import           Data.Bits+import           Data.Foldable+import           Data.Functor.Classes+import           Language.Haskell.TH.Syntax (Lift)+import           Text.Read+import           Text.Show++++-- | Convenience synonym.+type StrictPatricia = Patricia++-- | Spine-strict PATRICIA tree.+data Patricia a = Bin+                    {-# UNPACK #-} !Prefix+                    !(Patricia a)          -- ^ Masked bit is @0@.+                    !(Patricia a)          -- ^ Masked bit is @1@.++                | Tip+                    {-# UNPACK #-} !Key+                    a++                | Nil -- ^ Invariant: only allowed as the root of the tree.+                  deriving Lift++instance Show a => Show (Patricia a) where+  showsPrec = liftShowsPrec showsPrec showList++instance Show1 Patricia where+  liftShowsPrec showsPrec_ showList_ _ t =+    showListWith (liftShowsPrec showsPrec_ showList_ 0) $+      foldrWithKey (\k a -> (:) (k, a)) [] t++instance Read a => Read (Patricia a) where+  readPrec = liftReadPrec readPrec readListPrec++instance Read1 Patricia where+  liftReadPrec readPrec_ readList_ =+    fmap (Data.Foldable.foldl' (\z (k, a) -> insert k a z) Nil)+      (liftReadListPrec readPrec_ readList_)+++instance Eq a => Eq (Patricia a) where+  (==) = liftEq (==)++instance Eq1 Patricia where+  liftEq eq = go+    where+      go l r =+        case l of+          Bin p xl xr ->+            case r of+              Bin q yl yr -> p == q && go xl yl && go xr yr+              _           -> False++          Tip kA a ->+            case r of+              Tip kB b -> kA == kB && eq a b+              _        -> False++          Nil ->+            case r of+              Nil -> True+              _   -> False+++-- | Uses 'Data.Patricia.Word.Strict.map'.+instance Functor Patricia where+  fmap = Data.Patricia.Word.Strict.Internal.map++instance Foldable Patricia where+  foldl = Data.Patricia.Word.Strict.Internal.foldl+  foldr = Data.Patricia.Word.Strict.Internal.foldr+  foldMap = Data.Patricia.Word.Strict.Internal.foldMap++  foldl' = Data.Patricia.Word.Strict.Internal.foldl'+  foldr' = Data.Patricia.Word.Strict.Internal.foldr'++  null = Data.Patricia.Word.Strict.Internal.null+  length = fromIntegral . size++instance Traversable Patricia where+  traverse = Data.Patricia.Word.Strict.Internal.traverse+++instance NFData a => NFData (Patricia a) where+  rnf = liftRnf rnf++instance NFData1 Patricia where+  liftRnf nf = go+    where+      go t =+        case t of+          Bin _ l r -> go l `seq` go r+          Tip _ a   -> nf a+          Nil       -> ()++++{-# INLINE join #-}+-- | Knowing that the prefices of two non-'Nil' trees disagree, construct a 'Bin'.+join :: Prefix -> Patricia a -> Prefix -> Patricia a -> Patricia a+join p0 t0 p1 t1 =+  let m = branchingBit p0 p1++      p = mask p0 m .|. m++  in if zeroBit p0 m+       then Bin p t0 t1+       else Bin p t1 t0++{-# INLINE safeJoin #-}+-- | Knowing that the prefices of two trees disagree, construct a 'Bin'.+safeJoin :: Prefix -> Patricia a -> Prefix -> Patricia a -> Patricia a+safeJoin _  Nil _  t1  = t1+safeJoin _  t0  _  Nil = t0+safeJoin p0 t0  p1 t1  = join p0 t0 p1 t1++{-# INLINE rebin #-}+-- | Reconstruct a 'Bin' knowing that either of the sides may now be a 'Nil'.+rebin :: Prefix -> Patricia a -> Patricia a -> Patricia a+rebin p l r =+  case l of+    Nil -> r+    _   ->+      case r of+        Nil -> l+        _   -> Bin p l r++{-# INLINE rebinL #-}+-- | Reconstruct a 'Bin' knowing that the left side may now be a 'Nil'.+rebinL :: Prefix -> Patricia a -> Patricia a -> Patricia a+rebinL p l r =+  case l of+    Nil -> r+    _   -> Bin p l r+++{-# INLINE rebinR #-}+-- | Reconstruct a 'Bin' knowing that the right side may now be a 'Nil'.+rebinR :: Prefix -> Patricia a -> Patricia a -> Patricia a+rebinR p l r =+  case r of+    Nil -> l+    _   -> Bin p l r+++{-# INLINE retip #-}+-- | Reconstruct a 'Tip' knowing that the value may not be there anymore.+retip :: Key -> Maybe a -> Patricia a+retip w (Just a) = Tip w a+retip _ Nothing  = Nil++++-- | \(\mathcal{O}(1)\).+--   Check if the tree is empty.+null :: Patricia a -> Bool+null Nil = True+null _   = False++-- | \(\mathcal{O}(n)\).+--   Calculate the number of elements stored in the tree.+--   The returned number is guaranteed to be non-negative.+size :: Patricia a -> Int+size t =+  case t of+    Bin _ l r -> let !m = size l+                     !n = size r+                 in m + n++    Tip _ _   -> 1++    Nil       -> 0++++-- | \(\mathcal{O}(n)\).+--   Apply a function to every value in the tree.+map :: (a -> b) -> Patricia a -> Patricia b+map f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) (go r)+        Tip k a   -> Tip k (f a)+        Nil       -> Nil++-- | \(\mathcal{O}(n)\).+--   Apply a function to every value in the tree.+--+--   New values are evaluated to WHNF.+map' :: (a -> b) -> Patricia a -> Patricia b+map' f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) (go r)+        Tip k a   -> Tip k $! f a+        Nil       -> Nil++-- | \(\mathcal{O}(n)\).+--   Apply a function to every value in the tree.+mapWithKey :: (Word -> a -> b) -> Patricia a -> Patricia b+mapWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) (go r)+        Tip k a   -> Tip k (f k a)+        Nil       -> Nil++-- | \(\mathcal{O}(n)\).+--   Apply a function to every value in the tree.+--+--   New values are evaluated to WHNF.+mapWithKey' :: (Word -> a -> b) -> Patricia a -> Patricia b+mapWithKey' f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) (go r)+        Tip k a   -> Tip k $! f k a+        Nil       -> Nil++++-- | \(\mathcal{O}(n_R)\).+--   Fold the tree left-to-right.+foldl :: (b -> a -> b) -> b -> Patricia a -> b+foldl f = go+  where+    go z t =+      case t of+        Bin _ l r -> go (go z l) r+        Tip _ a   -> f z a+        Nil       -> z++-- | \(\mathcal{O}(n_R)\).+--   Fold the tree left-to-right.+foldlWithKey :: (b -> Word -> a -> b) -> b -> Patricia a -> b+foldlWithKey f = go+  where+    go z t =+      case t of+        Bin _ l r -> go (go z l) r+        Tip k a   -> f z k a+        Nil       -> z++++-- | \(\mathcal{O}(n)\).+--   Fold the tree left-to-right with a strict accumulator.+foldl' :: (b -> a -> b) -> b -> Patricia a -> b+foldl' f = go+  where+    go !z t =+      case t of+        Bin _ l r -> let !z' = go z l+                     in go z' r+        Tip _ a   -> f z a+        Nil       -> z++-- | \(\mathcal{O}(n)\).+--   Fold the tree left-to-right with a strict accumulator.+foldlWithKey' :: (b -> Word -> a -> b) -> b -> Patricia a -> b+foldlWithKey' f = go+  where+    go !z t =+      case t of+        Bin _ l r -> let !z' = go z l+                     in go z' r+        Tip k a   -> f z k a+        Nil       -> z++++-- | \(\mathcal{O}(n_L)\).+--   Fold the tree right-to-left.+foldr :: (a -> b -> b) -> b -> Patricia a -> b+foldr f = go+  where+    go z t =+      case t of+        Bin _ l r -> go (go z r) l+        Tip _ a   -> f a z+        Nil       -> z++-- | \(\mathcal{O}(n_L)\).+--   Fold the tree right-to-left.+foldrWithKey :: (Word -> a -> b -> b) -> b -> Patricia a -> b+foldrWithKey f = go+  where+    go z t =+      case t of+        Bin _ l r -> go (go z r) l+        Tip k a   -> f k a z+        Nil       -> z++-- | \(\mathcal{O}(n)\).+--   Fold the tree right-to-left with a strict accumulator.+foldr' :: (a -> b -> b) -> b -> Patricia a -> b+foldr' f = go+  where+    go !z t =+      case t of+        Bin _ l r -> let !z' = go z r+                     in go z' l+        Tip _ a   -> f a z+        Nil       -> z++-- | \(\mathcal{O}(n)\).+--   Fold the tree right-to-left with a strict accumulator.+foldrWithKey' :: (Word -> a -> b -> b) -> b -> Patricia a -> b+foldrWithKey' f = go+  where+    go !z t =+      case t of+        Bin _ l r -> let !z' = go z r+                     in go z' l+        Tip k a   -> f k a z+        Nil       -> z++++-- | \(\mathcal{O}(n_M)\).+--   Map each element in the tree to a monoid and combine the results.+foldMap :: Monoid m => (a -> m) -> Patricia a -> m+foldMap f = go+  where+    go t =+      case t of+        Bin _ l r -> go l <> go r+        Tip _ a   -> f a+        Nil       -> mempty++-- | \(\mathcal{O}(n_M)\).+--   Map each element in the tree to a monoid and combine the results.+foldMapWithKey :: Monoid m => (Word -> a -> m) -> Patricia a -> m+foldMapWithKey f = go+  where+    go t =+      case t of+        Bin _ l r -> go l <> go r+        Tip k a   -> f k a+        Nil       -> mempty++++-- | \(\mathcal{O}(n)\).+--   Map each element in the tree to an action, evaluate these actions+--   left-to-right and collect the results.+traverse :: Applicative f => (a -> f b) -> Patricia a -> f (Patricia b)+traverse f = go+  where+    go t =+      case t of+        Bin p l r -> liftA2 (Bin p) (go l) (go r)+        Tip k a   -> Tip k <$> f a+        Nil       -> pure Nil++-- | \(\mathcal{O}(n)\).+--   Map each element in the tree to an action, evaluate these actions+--   left-to-right and collect the results.+traverseWithKey :: Applicative f => (Word -> a -> f b) -> Patricia a -> f (Patricia b)+traverseWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> liftA2 (Bin p) (go l) (go r)+        Tip k a   -> Tip k <$> f k a+        Nil       -> pure Nil++++type UBin a = (# Prefix, Patricia a, Patricia a #)++type UTip a = (# Word, a #)++++-- | \(\mathcal{O}(n_A + n_B)\).+--   Unbiased union of two trees.+union :: Patricia a -> Patricia a -> Patricia a+union = anyAny+  where+    anyAny tA tB =+      case tA of+        Bin pA lA rA -> binAny (# pA, lA, rA #) tA tB++        Tip kA _ -> tipAny kA tA tB++        Nil -> tB++    tipAny kA tA tB =+      case tB of+        Bin pB lB rB -> tipBin kA tA (# pB, lB, rB #) tB++        Tip kB _+          | kA == kB  -> tA+          | otherwise -> join kA tA kB tB++        Nil -> tA++    binAny uA tA tB =+      case tB of+        Bin pB lB rB -> binBin uA tA (# pB, lB, rB #) tB++        Tip kB _ -> tipBin kB tB uA tA++        Nil -> tA++    tipBin kA tA (# pB, lB, rB #) tB+      | beyond pB kA = join kA tA pB tB+      | kA < pB      = Bin pB (tipAny kA tA lB) rB+      | otherwise    = Bin pB lB (tipAny kA tA rB)++    binBin uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      let {-# NOINLINE no #-}+          no = join pA tA pB tB++      in case Prelude.compare pA pB of+           EQ                  -> Bin pA (anyAny lA lB) (anyAny rA rB)++           LT | pB <= upper pA -> Bin pA lA (binAny uB tB rA)+              | pA >= lower pB -> Bin pB (binAny uA tA lB) rB+              | otherwise      -> no++           GT | pA <= upper pB -> Bin pB lB (binAny uA tA rB)+              | pB >= lower pA -> Bin pA (binAny uB tB lA) rA+              | otherwise      -> no++++-- | \(\mathcal{O}(n_A + n_B)\).+--   Left-biased union of two trees.+unionL :: Patricia a -> Patricia a -> Patricia a+unionL =+  union_ $ \s k a b ->+    let !(# c #) = case s of+                     L -> (# a #)+                     R -> (# b #)+    in Tip k c++-- | \(\mathcal{O}(n_A + n_B)\).+--   Union of two trees with a combining function.+--+--   New values are evaluated to WHNF.+unionWith'+  :: (a -> a -> a)+  -> Patricia a+  -> Patricia a+  -> Patricia a+unionWith' f =+  union_ $ \s k a b ->+    Tip k $! case s of+               L -> f a b+               R -> f b a++-- | \(\mathcal{O}(n_A + n_B)\).+--   Union of two trees with a combining function.+--+--   New values are evaluated to WHNF.+unionWithKey'+  :: (Word -> a -> a -> a)+  -> Patricia a+  -> Patricia a+  -> Patricia a+unionWithKey' f =+  union_ $ \s k a b ->+    Tip k $! case s of+               L -> f k a b+               R -> f k b a++++{-# INLINE union_ #-}+union_+  :: (forall x y. S x y a a -> Key -> x -> y -> Patricia a)+  -> Patricia a+  -> Patricia a+  -> Patricia a+union_ f = anyAny L+  where+    anyAny s tA tB =+      case tA of+        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB++        Tip kA a -> tipAny s (# kA, a #) tA tB++        Nil -> tB++    tipAny s uA@(# kA, a #) tA tB =+      case tB of+        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #) tB++        Tip kB b+          | kA == kB  -> f s kA a b+          | otherwise -> join kA tA kB tB++        Nil -> tA++    binAny s uA tA tB =+      case tB of+        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB++        Tip kB b ->+          let !(# s' #) = other s+          in tipBin s' (# kB, b #) tB uA tA++        Nil -> tA++    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #) tB+      | beyond pB kA = join kA tA pB tB+      | kA < pB      = Bin pB (tipAny s uA tA lB) rB+      | otherwise    = Bin pB lB (tipAny s uA tA rB)++    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      let {-# NOINLINE no #-}+          no = join pA tA pB tB++      in case Prelude.compare pA pB of+           EQ                  -> Bin pA (anyAny s lA lB) (anyAny s rA rB)++           LT | pB <= upper pA -> let !(# s' #) = other s+                                  in Bin pA lA (binAny s' uB tB rA)+              | pA >= lower pB -> Bin pB (binAny s uA tA lB) rB+              | otherwise      -> no++           GT | pA <= upper pB -> Bin pB lB (binAny s uA tA rB)+              | pB >= lower pA -> let !(# s' #) = other s+                                  in Bin pA (binAny s' uB tB lA) rA+              | otherwise      -> no++++-- | \(\mathcal{O}(n_A + n_B)\).+--   Difference of two trees.+difference :: Patricia a -> Patricia b -> Patricia a+difference =+  difference_ $ \_ _ _ _ ->+    Nil++-- | \(\mathcal{O}(n_A + n_B)\).+--   Difference of two trees with a combining function.+--+--   The 'Maybe' is evaluated to WHNF.+differenceWith+  :: (a -> b -> Maybe a)+  -> Patricia a+  -> Patricia b+  -> Patricia a+differenceWith f =+  difference_ $ \s k a b ->+    retip k $ case s of+                L -> f a b+                R -> f b a++-- | \(\mathcal{O}(n_A + n_B)\).+--   Difference of two trees with a combining function.+--+--   The 'Maybe' is evaluated to WHNF.+differenceWithKey+  :: (Word -> a -> b -> Maybe a)+  -> Patricia a+  -> Patricia b+  -> Patricia a+differenceWithKey f =+  difference_ $ \s k a b ->+    retip k $ case s of+                L -> f k a b+                R -> f k b a++++{-# INLINE difference_ #-}+difference_+  :: (forall x y. S x y a b -> Key -> x -> y -> Patricia a)+  -> Patricia a+  -> Patricia b+  -> Patricia a+difference_ (f :: forall n o. S n o x y -> Key -> n -> o -> Patricia x) = anyAny L+  where+    anyAny+      :: forall a b. S a b x y -> Patricia a -> Patricia b -> Patricia x+    anyAny s tA tB =+      case tA of+        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB++        Tip kA a -> tipAny s (# kA, a #) tA tB++        Nil -> case s of+                 L -> tA+                 R -> tB++    tipAny+      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> Patricia x+    tipAny s uA@(# kA, a #) tA tB =+      case tB of+        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #) tB++        Tip kB b+          | kA == kB  -> f s kA a b+          | otherwise -> case s of+                           L -> tA+                           R -> tB++        Nil -> case s of+                 L -> tA+                 R -> tB++    binAny+      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> Patricia x+    binAny s uA tA tB =+      case tB of+        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB++        Tip kB b -> let !(# s' #) = other s+                    in tipBin s' (# kB, b #) tB uA tA++        Nil -> case s of+                 L -> tA+                 R -> tB++    tipBin+      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> Patricia b -> Patricia x+    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #) tB+      | beyond pB kA = case s of+                         L -> tA+                         R -> tB++      | kA < pB      = case s of+                         L -> tipAny s uA tA lB+                         R -> rebinL pB (tipAny s uA tA lB) rB++      | otherwise    = case s of+                         L -> tipAny s uA tA rB+                         R -> rebinR pB lB (tipAny s uA tA rB)++    binBin+      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> Patricia x+    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      let {-# NOINLINE no #-}+          no = case s of+                 L -> tA+                 R -> tB++      in case Prelude.compare pA pB of+           EQ                  -> rebin pA (anyAny s lA lB) (anyAny s rA rB)++           LT | pB <= upper pA -> case s of+                                    L -> rebinR pA lA (binAny R uB tB rA)+                                    R -> binAny L uB tB rA++              | pA >= lower pB -> case s of+                                    L -> binAny s uA tA lB+                                    R -> rebinL pB (binAny s uA tA lB) rB++              | otherwise      -> no++           GT | pA <= upper pB -> case s of+                                    L -> binAny s uA tA rB+                                    R -> rebinR pB lB (binAny s uA tA rB)++              | pB >= lower pA -> case s of+                                    L -> rebinL pA (binAny R uB tB lA) rA+                                    R -> binAny L uB tB lA++              | otherwise      -> no++++-- | \(\mathcal{O}(n_A + n_B)\).+--   Compare two trees with respect to set inclusion,+--   using the given equality function for intersecting keys.+--   If any intersecting keys hold unequal values, the trees are 'Incomparable'.+compare :: (a -> b -> Bool) -> Patricia a -> Patricia b -> PartialOrdering+compare (f :: x -> y -> Bool) = anyAny L+  where+    anyAny+      :: forall a b. S a b x y -> Patricia a -> Patricia b -> PartialOrdering+    anyAny s tA tB =+      case tA of+        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB++        Tip kA a -> tipAny s (# kA, a #) tA tB++        Nil -> case tB of+                 Nil -> Equal+                 _   -> Subset++    tipAny+      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> PartialOrdering+    tipAny s uA@(# kA, a #) tA tB =+      case tB of+        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #)++        Tip kB b+          | kA == kB  -> let eq = case s of+                                    L -> f a b+                                    R -> f b a+                         in if eq+                              then Equal+                              else Incomparable++          | otherwise -> Incomparable++        Nil -> Superset++    binAny+      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> PartialOrdering+    binAny s uA tA tB =+      case tB of+        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB++        Tip kB b -> let !(# s' #) = other s+                    in tipBin s' (# kB, b #) tB uA++        Nil -> Superset++    tipBin+      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> PartialOrdering+    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #) =+      if beyond pB kA+        then Incomparable+        else limit s . tipAny s uA tA $ if kA < pB+                                           then lB+                                           else rB++    binBin+      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> PartialOrdering+    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      case Prelude.compare pA pB of+        EQ                  -> order (anyAny s lA lB) (anyAny s rA rB)++        LT | pB <= upper pA -> let !(# s' #) = other s+                               in limit s' $ binAny s' uB tB rA++           | pA >= lower pB -> limit s $ binAny s uA tA lB++           | otherwise      -> Incomparable++        GT | pA <= upper pB -> limit s $ binAny s uA tA rB++           | pB >= lower pA -> let !(# s' #) = other s++                               in limit s' $ binAny s' uB tB lA++           | otherwise      -> Incomparable++++-- | \(\mathcal{O}(n_A + n_B)\).+--   Determine whether two trees' key sets are disjoint.+disjoint :: Patricia a -> Patricia b -> Bool+disjoint = anyAny+  where+    anyAny tA tB =+      case tA of+        Bin pA lA rA -> binAny (# pA, lA, rA #) tA tB++        Tip kA _ -> tipAny kA tA tB++        Nil -> True++    tipAny kA tA tB =+      case tB of+        Bin pB lB rB -> tipBin kA tA (# pB, lB, rB #)++        Tip kB _ -> kA /= kB++        Nil -> True++    binAny :: forall a b. UBin a -> Patricia a -> Patricia b -> Bool+    binAny uA tA tB =+      case tB of+        Bin pB lB rB -> binBin uA tA (# pB, lB, rB #) tB++        Tip kB _ -> tipBin kB tB uA++        Nil -> True++    tipBin kA tA (# pB, lB, rB #)+      | beyond pB kA = True+      | otherwise    = tipAny kA tA $ if kA < pB+                                        then lB+                                        else rB++    binBin uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      case Prelude.compare pA pB of+        EQ                  -> anyAny lA lB && anyAny rA rB++        LT | pB <= upper pA -> binAny uB tB rA+           | pA >= lower pB -> binAny uA tA lB+           | otherwise      -> True++        GT | pA <= upper pB -> binAny uA tA rB+           | pB >= lower pA -> binAny uB tB lA+           | otherwise      -> True++++-- | \(\mathcal{O}(n_A + n_B)\).+--   Unbiased intersection of two trees.+intersection :: Patricia a -> Patricia a -> Patricia a+intersection = anyAny+  where+    anyAny tA tB =+      case tA of+        Bin pA lA rA -> binAny (# pA, lA, rA #) tA tB++        Tip kA _ -> tipAny kA tA tB++        Nil -> Nil++    tipAny kA tA tB =+      case tB of+        Bin pB lB rB -> tipBin kA tA (# pB, lB, rB #)++        Tip kB _+          | kA == kB  -> tA+          | otherwise -> Nil++        Nil -> Nil++    binAny uA tA tB =+      case tB of+        Bin pB lB rB -> binBin uA tA (# pB, lB, rB #) tB++        Tip kB _ -> tipBin kB tB uA++        Nil -> Nil++    tipBin kA tA (# pB, lB, rB #)+      | beyond pB kA = Nil+      | otherwise    = tipAny kA tA $ if kA < pB+                                        then lB+                                        else rB++    binBin uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      case Prelude.compare pA pB of+        EQ                  -> rebin pA (anyAny lA lB) (anyAny rA rB)++        LT | pB <= upper pA -> binAny uB tB rA+           | pA >= lower pB -> binAny uA tA lB+           | otherwise      -> Nil++        GT | pA <= upper pB -> binAny uA tA rB+           | pB >= lower pA -> binAny uB tB lA+           | otherwise      -> Nil++++-- | \(\mathcal{O}(n_A + n_B)\).+--   Left-biased intersection of two trees.+intersectionL :: Patricia a -> Patricia b -> Patricia a+intersectionL =+  intersection_ $ \s k a b ->+    let !(# c #) = case s of+                     L -> (# a #)+                     R -> (# b #)+    in Tip k c++-- | \(\mathcal{O}(n_A + n_B)\).+--   Intersection of two trees with a combining function.+--+--   New values are evaluated to WHNF.+intersectionWith'+  :: (a -> b -> c)+  -> Patricia a+  -> Patricia b+  -> Patricia c+intersectionWith' f =+  intersection_ $ \s k a b ->+    Tip k $! case s of+               L -> f a b+               R -> f b a++-- | \(\mathcal{O}(n_A + n_B)\).+--   Intersection of two trees with a combining function.+--+--   New values are evaluated to WHNF.+intersectionWithKey'+  :: (Word -> a -> b -> c)+  -> Patricia a+  -> Patricia b+  -> Patricia c+intersectionWithKey' f =+  intersection_ $ \s k a b ->+    Tip k $! case s of+               L -> f k a b+               R -> f k b a++++{-# INLINE intersection_ #-}+intersection_+  :: (forall x y. S x y a b -> Key -> x -> y -> Patricia c)+  -> Patricia a+  -> Patricia b+  -> Patricia c+intersection_ (f :: forall n o. S n o x y -> Word -> n -> o -> Patricia c) =+  anyAny L+  where+    anyAny+      :: forall a b. S a b x y -> Patricia a -> Patricia b -> Patricia c+    anyAny s tA tB =+      case tA of+        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB++        Tip kA a -> tipAny s (# kA, a #) tA tB++        Nil -> Nil++    tipAny+      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> Patricia c+    tipAny s uA@(# kA, a #) tA tB =+      case tB of+        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #)++        Tip kB b+          | kA == kB  -> f s kA a b+          | otherwise -> Nil++        Nil -> Nil++    binAny+      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> Patricia c+    binAny s uA tA tB =+      case tB of+        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB++        Tip kB b -> let !(# s' #) = other s+                    in tipBin s' (# kB, b #) tB uA++        Nil -> Nil++    tipBin+      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> Patricia c+    tipBin s uA@(# kA, _ #) tA (# pB, lB, rB #)+      | beyond pB kA = Nil+      | otherwise    = tipAny s uA tA $ if kA < pB+                                          then lB+                                          else rB++    binBin+      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> Patricia c+    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      case Prelude.compare pA pB of+        EQ                  -> rebin pA (anyAny s lA lB) (anyAny s rA rB)++        LT | pB <= upper pA -> let !(# s' #) = other s+                               in binAny s' uB tB rA+           | pA >= lower pB -> binAny s uA tA lB+           | otherwise      -> Nil++        GT | pA <= upper pB -> binAny s uA tA rB+           | pB >= lower pA -> let !(# s' #) = other s+                               in binAny s' uB tB lA+           | otherwise      -> Nil++++{-# INLINE merge #-}+-- | \(\mathcal{O}(n_A + n_B)\).+--   General merge of two trees.+--+--   Collision and single value functions __must__ return either+--   'Tip' with the respective key, or 'Nil'.+--+--   Subtree argument functions may return any tree, however the shape of said tree+--   __must__ be compatible with the prefix passed to the function.+--+--   Resulting 'Patricia' trees in argument functions are evaluated to WHNF.+--+--   This functions inlines when all argument functions are provided.+merge+  :: (Key -> a -> b -> Patricia c)                      -- ^ Single value collision+  -> (Key -> a -> Patricia c)                           -- ^ Single left value+  -> (Prefix -> Patricia a -> Patricia a -> Patricia c) -- ^ Left subtree+  -> (Key -> b -> Patricia c)                           -- ^ Single right value+  -> (Prefix -> Patricia b -> Patricia b -> Patricia c) -- ^ Right subtree+  -> Patricia a+  -> Patricia b+  -> Patricia c+merge (f :: Key -> x -> y -> Patricia c) oneX treeX oneY treeY = anyAny L+  where+    {-# INLINE side #-}+    side one tree t =+      case t of+        Bin p l r -> tree p l r+        Tip k a   -> one k a+        Nil       -> Nil++    sideX = side oneX treeX++    sideY = side oneY treeY++    sideA :: forall a b. S a b x y -> Patricia a -> Patricia c+    sideA s tA = case s of+                   L -> sideX tA+                   R -> sideY tA++    sideB :: forall a b. S a b x y -> Patricia b -> Patricia c+    sideB s tB = case s of+                   L -> sideY tB+                   R -> sideX tB++    anyAny+      :: forall a b. S a b x y -> Patricia a -> Patricia b -> Patricia c+    anyAny s tA tB =+      case tA of+        Bin pA lA rA -> binAny s (# pA, lA, rA #) tA tB++        Tip kA a     -> tipAny s (# kA, a #) tA tB++        Nil          -> sideB s tB++    tipAny+      :: forall a b. S a b x y -> UTip a -> Patricia a -> Patricia b -> Patricia c+    tipAny s uA@(# kA, a #) tA tB =+      case tB of+        Bin pB lB rB -> tipBin s uA tA (# pB, lB, rB #)++        Tip kB b+          | kA == kB  -> case s of+                           L -> f kA a b+                           R -> f kA b a++          | otherwise -> case s of+                           L -> safeJoin kA (oneX kA a) kB (sideY tB)+                           R -> safeJoin kA (oneY kA a) kB (sideX tB)++        Nil          -> sideA s tA++    binAny+      :: forall a b. S a b x y -> UBin a -> Patricia a -> Patricia b -> Patricia c+    binAny s uA tA tB =+      case tB of+        Bin pB lB rB -> binBin s uA tA (# pB, lB, rB #) tB++        Tip kB b     -> let !(# s' #) = other s+                        in tipBin s' (# kB, b #) tB uA++        Nil          -> sideA s tA++    tipBin+      :: forall a b. S a b x y -> UTip a -> Patricia a -> UBin b -> Patricia c+    tipBin s uA@(# kA, a #) tA (# pB, lB, rB #)+      | beyond pB kA = case s of+                         L -> safeJoin kA (oneX kA a) pB (treeY pB lB rB)+                         R -> safeJoin kA (oneY kA a) pB (treeX pB lB rB)++      | kA < pB      = rebin pB (tipAny s uA tA lB) (sideB s rB)++      | otherwise    = rebin pB (sideB s lB) (tipAny s uA tA rB)++    binBin+      :: forall a b. S a b x y -> UBin a -> Patricia a -> UBin b -> Patricia b -> Patricia c+    binBin s uA@(# pA, lA, rA #) tA uB@(# pB, lB, rB #) tB =+      let {-# NOINLINE no #-}+          no = case s of+                 L -> safeJoin pA (treeX pA lA rA) pB (treeY pB lB rB)+                 R -> safeJoin pA (treeY pA lA rA) pB (treeX pB lB rB)++      in case Prelude.compare pA pB of+           EQ                  -> rebin pA (anyAny s lA lB) (anyAny s rA rB)++           LT | pB <= upper pA -> let !(# s' #) = other s++                                  in rebin pA (sideA s lA) (binAny s' uB tB rA)++              | pA >= lower pB -> rebin pB (binAny s uA tA lB) (sideB s rB)++              | otherwise      -> no++           GT | pA <= upper pB -> rebin pB (sideB s lB) (binAny s uA tA rB)++              | pB >= lower pA -> let !(# s' #) = other s++                                  in rebin pA (binAny s' uB tB lA) (sideA s rA)++              | otherwise      -> no++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the value at a key in the tree.+lookup :: Word -> Patricia a -> Maybe a+lookup !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> Nothing+          | w < p      -> go l+          | otherwise  -> go r++        Tip k a+          | k == w    -> Just a+          | otherwise -> Nothing++        Nil -> Nothing++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the value at a key in the tree, falling back to the given default value+--   if it does not exist.+find :: a -> Word -> Patricia a -> a+find d !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> d+          | w < p      -> go l+          | otherwise  -> go r++        Tip k a+          | k == w    -> a+          | otherwise -> d++        Nil -> d++-- | \(\mathcal{O}(\min(n,W))\).+--   Check whether the value exists at a key in the tree.+member :: Word -> Patricia a -> Bool+member !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> False+          | w < p      -> go l+          | otherwise  -> go r++        Tip k _ -> k == w++        Nil -> False++-- 'lookup' that doesn't allocate a 'Maybe'.+takeOne :: Word -> Patricia a -> Patricia a+takeOne !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> Nil+          | w < p      -> go l+          | otherwise  -> go r++        Tip k _+          | k == w    -> t+          | otherwise -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the value at a key in the tree.+dirtyLookup :: Word -> Patricia a -> Maybe a+dirtyLookup !w = go+  where+    go t =+      case t of+        Bin p l r+          | w < p     -> go l+          | otherwise -> go r++        Tip k a+          | k == w    -> Just a+          | otherwise -> Nothing++        Nil -> Nothing++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the value at a key in the tree, falling back to the default value+--   if it does not exist.+dirtyFind :: a -> Word -> Patricia a -> a+dirtyFind d !w = go+  where+    go t =+      case t of+        Bin p l r+          | w < p     -> go l+          | otherwise -> go r++        Tip k a+          | k == w    -> a+          | otherwise -> d++        Nil -> d++-- | \(\mathcal{O}(\min(n,W))\).+--   Check whether the value exists at a key in the tree.+dirtyMember :: Word -> Patricia a -> Bool+dirtyMember !w = go+  where+    go t =+      case t of+        Bin p l r+          | w < p     -> go l+          | otherwise -> go r++        Tip k _ -> k == w++        Nil -> False++++-- | \(\mathcal{O}(\min(n,W))\).+--   Insert a new value in the tree at the given key.+--   If a value already exists at that key, it is replaced.+insert :: Word -> a -> Patricia a -> Patricia a+insert !w a = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> join w (Tip w a) p t+          | w < p      -> Bin p (go l) r+          | otherwise  -> Bin p l (go r)++        Tip k _+          | k == w    -> Tip k a+          | otherwise -> join w (Tip w a) k t++        Nil -> Tip w a++++-- | \(\mathcal{O}(\min(n,W))\).+--   Insert a new value in the tree at the given key.+--   If a value already exists at that key, the function is used instead.+insertWith :: (a -> a) -> Word -> a -> Patricia a -> Patricia a+insertWith f !w b = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> join w (Tip w b) p t+          | w < p      -> Bin p (go l) r+          | otherwise  -> Bin p l (go r)++        Tip k a+          | k == w    -> Tip k (f a)+          | otherwise -> join w (Tip w b) k t++        Nil -> Tip w b++-- | \(\mathcal{O}(\min(n,W))\).+--   Insert a new value in the tree at the given key.+--   If a value already exists at that key, the function is used instead.+--+--   New value is evaluted to WHNF.+insertWith' :: (a -> a) -> Word -> a -> Patricia a -> Patricia a+insertWith' f !w b = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> join w (b `seq` Tip w b) p t+          | w < p      -> Bin p (go l) r+          | otherwise  -> Bin p l (go r)++        Tip k a+          | k == w    -> Tip k $! f a+          | otherwise -> join w (b `seq` Tip w b) k t++        Nil -> Tip w b++++-- | \(\mathcal{O}(\min(n,W))\).+--   Apply a function to a value in the tree at the given key.+adjust :: (a -> a) -> Word -> Patricia a -> Patricia a+adjust f !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> t+          | w < p      -> Bin p (go l) r+          | otherwise  -> Bin p l (go r)++        Tip k a+          | k == w    -> Tip k (f a)+          | otherwise -> t++        Nil -> Nil++-- | \(\mathcal{O}(\min(n,W))\).+--   Apply a function to a value in the tree at the given key.+--+--   New value is evaluated to WHNF.+adjust' :: (a -> a) -> Word -> Patricia a -> Patricia a+adjust' f !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> t+          | w < p      -> Bin p (go l) r+          | otherwise  -> Bin p l (go r)++        Tip k a+          | k == w    -> Tip k $! f a+          | otherwise -> t++        Nil -> Nil++++-- | \(\mathcal{O}(\min(n,W))\).+--   Delete a value in the tree at the given key.+delete :: Word -> Patricia a -> Patricia a+delete !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> t+          | w < p      -> rebinL p (go l) r+          | otherwise  -> rebinR p l (go r)++        Tip k _+          | k == w    -> Nil+          | otherwise -> t++        Nil -> Nil++-- | \(\mathcal{O}(\min(n,W))\).+--   Update or delete a value in the tree at the given key.+--+--   The 'Maybe' is evaluated to WHNF.+update :: (a -> Maybe a) -> Word -> Patricia a -> Patricia a+update f !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> t+          | w < p      -> rebinL p (go l) r+          | otherwise  -> rebinR p l (go r)++        Tip k a+          | k == w    -> retip k (f a)+          | otherwise -> t++        Nil -> Nil++++-- | \(\mathcal{O}(\min(n,W))\).+--   Insert, update or delete a value in the tree at the given key.+--+--   The resulting 'Maybe' is evaluated to WHNF.+alter :: (Maybe a -> Maybe a) -> Word -> Patricia a -> Patricia a+alter f !w = go+  where+    go t =+      case t of+        Bin p l r+          | beyond p w -> case f Nothing of+                            Just b  -> join p t w (Tip w b)+                            Nothing -> t++          | w < p      -> rebinL p (go l) r+          | otherwise  -> rebinR p l (go r)++        Tip k a+          | k == w    -> case f (Just a) of+                           Just b  -> Tip k b+                           Nothing -> Nil++          | otherwise -> case f Nothing of+                           Just b  -> join k t w (Tip w b)+                           Nothing -> t++        Nil -> case f Nothing of+                 Just b  -> Tip w b+                 Nothing -> Nil++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at a largest key smaller than or equal to the given key.+lookupL :: Word -> Patricia a -> Maybe (Lookup a)+lookupL !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then go l+                   else Nothing++            else Just $! if w <= upper p+                           then case go r of+                                  Just x  -> x+                                  Nothing -> unsafeLookupMaxWithKey l++                           else unsafeLookupMaxWithKey r++        Tip k a+          | k <= w    -> Just $! Lookup k a+          | otherwise -> Nothing++        Nil -> Nothing++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at a smallest key greater than or equal to the given key.+lookupR :: Word -> Patricia a -> Maybe (Lookup a)+lookupR !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then Just $! if w >= lower p+                           then case go l of+                                  Just x  -> x+                                  Nothing -> unsafeLookupMinWithKey r++                           else unsafeLookupMinWithKey l++            else if w <= upper p+                   then go r+                   else Nothing++        Tip k a+          | k >= w    -> Just $! Lookup k a+          | otherwise -> Nothing++        Nil -> Nothing++++-- | \(\mathcal{O}(\min(n,W) + n_L)\).+--   Apply a function to every value for which the key is smaller than+--   or equal to the given one.+adjustL :: (a -> a) -> Word -> Patricia a -> Patricia a+adjustL f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then Bin p (go l) r+                   else t++            else Bin p (Data.Patricia.Word.Strict.Internal.map f l) $+                   if w <= upper p+                     then go r+                     else Data.Patricia.Word.Strict.Internal.map f r++        Tip k a+          | k <= w    -> Tip k (f a)+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_L)\).+--   Apply a function to every value for which the key is smaller than+--   or equal to the given one.+--+--   New value is evaluated to WHNF.+adjustL' :: (a -> a) -> Word -> Patricia a -> Patricia a+adjustL' f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then Bin p (go l) r+                   else t++            else Bin p (map' f l) $+                   if w <= upper p+                     then go r+                     else map' f r++        Tip k a+          | k <= w    -> Tip k $! f a+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_L)\).+--   Apply a function to every value for which the key is smaller than+--   or equal to the given one.+adjustLWithKey :: (Word -> a -> a) -> Word -> Patricia a -> Patricia a+adjustLWithKey f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then Bin p (go l) r+                   else t++            else Bin p (mapWithKey f l) $+                   if w <= upper p+                     then go r+                     else mapWithKey f r++        Tip k a+          | k <= w    -> Tip k (f k a)+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_L)\).+--   Apply a function to every value for which the key is smaller than+--   or equal to the given one.+--+--   New value is evaluated to WHNF.+adjustLWithKey' :: (Word -> a -> a) -> Word -> Patricia a -> Patricia a+adjustLWithKey' f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then Bin p (go l) r+                   else t++            else Bin p (mapWithKey' f l) $+                   if w <= upper p+                     then go r+                     else mapWithKey' f r++        Tip k a+          | k <= w    -> Tip k $! f k a+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(\min(n,W))\).+--   Delete values for which keys are smaller than or equal to the given one.+deleteL :: Word -> Patricia a -> Patricia a+deleteL !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then rebinL p (go l) r+                   else t++            else if w <= upper p+                   then go r+                   else Nil++        Tip k _+          | k <= w    -> Nil+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(\min(n,W) + n_L)\).+--   Update every value for which the key is smaller than or equal to the given one.+--+--   The 'Maybe' is evaluated to WHNF.+updateL :: (a -> Maybe a) -> Word -> Patricia a -> Patricia a+updateL f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then rebinL p (go l) r+                   else t++            else rebin p (mapMaybe f l) $+                   if w <= upper p+                     then go r+                     else mapMaybe f r++        Tip k a+          | k <= w    -> retip k (f a)+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_L)\).+--   Update every value for which the key is smaller than or equal to the given one.+--+--   The 'Maybe' is evaluated to WHNF.+updateLWithKey :: (Word -> a -> Maybe a) -> Word -> Patricia a -> Patricia a+updateLWithKey f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then rebinL p (go l) r+                   else t++            else rebin p (mapMaybeWithKey f l) $+                   if w <= upper p+                     then go r+                     else mapMaybeWithKey f r++        Tip k a+          | k <= w    -> retip k (f k a)+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(\min(n,W))\).+--   Take values for which keys are smaller than or equal to the given one.+takeL :: Word -> Patricia a -> Patricia a+takeL !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then go l+                   else Nil++            else if w <= upper p+                   then rebinR p l (go r)+                   else t++        Tip k _+          | k <= w    -> t+          | otherwise -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(\min(n,W) + n_R)\).+--   Apply a function to every value for which the key is greater than+--   or equal to the given one.+adjustR :: (a -> a) -> Word -> Patricia a -> Patricia a+adjustR f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then let l' = if w >= lower p+                            then go l+                            else Data.Patricia.Word.Strict.Internal.map f l++                 in Bin p l' (Data.Patricia.Word.Strict.Internal.map f r)++            else if w <= upper p+                   then Bin p l (go r)+                   else t++        Tip k a+          | k >= w    -> Tip k (f a)+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_R)\).+--   Apply a function to every value for which the key is greater than+--   or equal to the given one.+--+--   New value is evaluated to WHNF.+adjustR' :: (a -> a) -> Word -> Patricia a -> Patricia a+adjustR' f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then let l' = if w >= lower p+                            then go l+                            else map' f l++                 in Bin p l' (map' f r)++            else if w <= upper p+                   then Bin p l (go r)+                   else t++        Tip k a+          | k >= w    -> Tip k $! f a+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_R)\).+--   Apply a function to every value for which the key is greater than+--   or equal to the given one.+adjustRWithKey :: (Word -> a -> a) -> Word -> Patricia a -> Patricia a+adjustRWithKey f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then let l' = if w >= lower p+                            then go l+                            else mapWithKey f l++                 in Bin p l' (mapWithKey f r)++            else if w <= upper p+                   then Bin p l (go r)+                   else t++        Tip k a+          | k >= w    -> Tip k (f k a)+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_R)\).+--   Apply a function to every value for which the key is greater than+--   or equal to the given one.+--+--   New value is evaluated to WHNF.+adjustRWithKey' :: (Word -> a -> a) -> Word -> Patricia a -> Patricia a+adjustRWithKey' f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then let l' = if w >= lower p+                            then go l+                            else mapWithKey' f l++                 in Bin p l' (mapWithKey' f r)++            else if w <= upper p+                   then Bin p l (go r)+                   else t++        Tip k a+          | k >= w    -> Tip k $! f k a+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(\min(n,W))\).+--   Delete values for which keys are greater than or equal to the given one.+deleteR :: Word -> Patricia a -> Patricia a+deleteR !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then go l+                   else Nil++            else if w <= upper p+                   then rebinR p l (go r)+                   else t++        Tip k _+          | k >= w    -> Nil+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(\min(n,W) + n_R)\).+--   Update every value for which the key is greater than or equal to the given one.+--+--   The 'Maybe' is evaluated to WHNF.+updateR :: (a -> Maybe a) -> Word -> Patricia a -> Patricia a+updateR f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then let l' = if w >= lower p+                            then go l+                            else mapMaybe f l++                 in rebin p l' (mapMaybe f r)++            else if w <= upper p+                   then rebinR p l (go r)+                   else t++        Tip k a+          | k >= w    -> retip k (f a)+          | otherwise -> t++        Nil         -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_R)\).+--   Update every value for which the key is greater than or equal to the given one.+--+--   The 'Maybe' is evaluated to WHNF.+updateRWithKey :: (Word -> a -> Maybe a) -> Word -> Patricia a -> Patricia a+updateRWithKey f !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then let l' = if w >= lower p+                            then go l+                            else mapMaybeWithKey f l++                 in rebin p l' (mapMaybeWithKey f r)++            else if w <= upper p+                   then rebinR p l (go r)+                   else t++        Tip k a+          | k >= w    -> retip k (f k a)+          | otherwise -> t++        Nil         -> Nil+++-- | \(\mathcal{O}(\min(n,W))\).+--   Take values for which keys are greater than or equal to the given one.+takeR :: Word -> Patricia a -> Patricia a+takeR !w = go+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then rebinL p (go l) r+                   else t++            else if w <= upper p+                   then go r+                   else Nil++        Tip k _+          | k >= w    -> t+          | otherwise -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+adjustRange :: (a -> a) -> Range -> Patricia a -> Patricia a+adjustRange f (UnsafeRange kL kR)+  | kL == kR  = adjust f kL+  | otherwise = unsafeAdjustRange f kL kR++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeAdjustRange+  :: (a -> a)+  -> Word     -- ^ \(k_L\)+  -> Word     -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeAdjustRange f !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> Bin p (adjustR f wL l) (adjustL f wR r)++            LT | pM <= upper p -> Bin p l (go r)+               | p >= lower pM -> if wL < p+                                    then Bin p+                                           (adjustR f wL l)+                                           (Data.Patricia.Word.Strict.Internal.map f r)++                                    else Bin p l (adjustR f wL r)++               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then Bin p+                                           (Data.Patricia.Word.Strict.Internal.map f l)+                                           (adjustL f wR r)++                                    else Bin p (adjustL f wR l) r++               | pM >= lower p -> Bin p (go l) r+               | otherwise     -> t++        Tip k a+          | k >= wL && k <= wR -> Tip k (f a)+          | otherwise          -> t++        Nil -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+--+--   New value is evaluated to WHNF.+adjustRange' :: (a -> a) -> Range -> Patricia a -> Patricia a+adjustRange' f (UnsafeRange kL kR)+  | kL == kR  = adjust' f kL+  | otherwise = unsafeAdjustRange' f kL kR++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+--+--   New value is evaluated to WHNF.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeAdjustRange'+  :: (a -> a)+  -> Word     -- ^ \(k_L\)+  -> Word     -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeAdjustRange' f !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> Bin p (adjustR' f wL l) (adjustL' f wR r)++            LT | pM <= upper p -> Bin p l (go r)+               | p >= lower pM -> if wL < p+                                    then Bin p (adjustR' f wL l) (map' f r)+                                    else Bin p l (adjustR' f wL r)++               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then Bin p (map' f l) (adjustL' f wR r)+                                    else Bin p (adjustL' f wR l) r++               | pM >= lower p -> Bin p (go l) r+               | otherwise     -> t++        Tip k a+          | k >= wL && k <= wR -> Tip k $! f a+          | otherwise          -> t++        Nil -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+adjustRangeWithKey :: (Word -> a -> a) -> Range -> Patricia a -> Patricia a+adjustRangeWithKey f (UnsafeRange kL kR)+  | kL == kR  = adjust (f kL) kL+  | otherwise = unsafeAdjustRangeWithKey f kL kR++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeAdjustRangeWithKey+  :: (Word -> a -> a)+  -> Word             -- ^ \(k_L\)+  -> Word             -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeAdjustRangeWithKey f !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> Bin p (adjustRWithKey f wL l) (adjustLWithKey f wR r)++            LT | pM <= upper p -> Bin p l (go r)+               | p >= lower pM -> if wL < p+                                    then Bin p (adjustRWithKey f wL l) (mapWithKey f r)+                                    else Bin p l (adjustRWithKey f wL r)++               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then Bin p (mapWithKey f l) (adjustLWithKey f wR r)+                                    else Bin p (adjustLWithKey f wR l) r++               | pM >= lower p -> Bin p (go l) r+               | otherwise     -> t++        Tip k a+          | k >= wL && k <= wR -> Tip k (f k a)+          | otherwise          -> t++        Nil -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+--+--   New value is evaluated to WHNF.+adjustRangeWithKey' :: (Word -> a -> a) -> Range -> Patricia a -> Patricia a+adjustRangeWithKey' f (UnsafeRange kL kR)+  | kL == kR  = adjust' (f kL) kL+  | otherwise = unsafeAdjustRangeWithKey' f kL kR++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Apply a function to every value for which the key is in the given range.+--+--   New value is evaluated to WHNF.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeAdjustRangeWithKey'+  :: (Word -> a -> a)+  -> Word             -- ^ \(k_L\)+  -> Word             -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeAdjustRangeWithKey' f !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> Bin p (adjustRWithKey' f wL l) (adjustLWithKey' f wR r)++            LT | pM <= upper p -> Bin p l (go r)+               | p >= lower pM -> if wL < p+                                    then Bin p (adjustRWithKey' f wL l) (mapWithKey' f r)+                                    else Bin p l (adjustRWithKey' f wL r)++               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then Bin p (mapWithKey' f l) (adjustLWithKey' f wR r)+                                    else Bin p (adjustLWithKey' f wR l) r++               | pM >= lower p -> Bin p (go l) r+               | otherwise     -> t++        Tip k a+          | k >= wL && k <= wR -> Tip k $! f k a+          | otherwise          -> t++        Nil -> Nil+++-- | \(\mathcal{O}(\min(n,W))\).+--   Delete values for which keys are in the given range.+deleteRange :: Range -> Patricia a -> Patricia a+deleteRange (UnsafeRange kL kR)+  | kL == kR  = delete kL+  | otherwise = unsafeDeleteRange kL kR++-- | \(\mathcal{O}(\min(n,W))\).+--   Delete values for which keys are in the given range.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeDeleteRange+  :: Word         -- ^ \(k_L\)+  -> Word         -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeDeleteRange !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> rebin p (deleteR wL l) (deleteL wR r)++            LT | pM <= upper p -> rebinR p l (go r)+               | p >= lower pM -> if wL < p+                                    then deleteR wL l+                                    else rebinR p l (deleteR wL r)+               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then deleteL wR r+                                    else rebinL p (deleteL wR l) r++               | pM >= lower p -> rebinL p (go l) r+               | otherwise     -> t++        Tip k _+          | k >= wL && k <= wR -> Nil+          | otherwise          -> t++        Nil -> Nil+++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Update every value for which the key is in the given range.+--+--   The 'Maybe' is evaluated to WHNF.+updateRange :: (a -> Maybe a) -> Range -> Patricia a -> Patricia a+updateRange f (UnsafeRange kL kR)+  | kL == kR  = update f kL+  | otherwise = unsafeUpdateRange f kL kR++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Update every value for which the key is in the given range.+--+--   The 'Maybe' is evaluated to WHNF.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeUpdateRange+  :: (a -> Maybe a)+  -> Word           -- ^ \(k_L\)+  -> Word           -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeUpdateRange f !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> rebin p (updateR f wL l) (updateL f wR r)++            LT | pM <= upper p -> rebinR p l (go r)+               | p >= lower pM -> if wL < p+                                    then rebinL p (updateR f wL l) (mapMaybe f r)+                                    else rebinR p l (updateR f wL r)+               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then rebinR p (mapMaybe f l) (updateL f wR r)+                                    else rebinL p (updateL f wR l) r++               | pM >= lower p -> rebinL p (go l) r+               | otherwise     -> t++        Tip k a+          | k >= wL && k <= wR -> retip k (f a)+          | otherwise          -> t++        Nil -> Nil++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Update every value for which the key is in the given range.+--+--   The 'Maybe' is evaluated to WHNF.+updateRangeWithKey :: (Word -> a -> Maybe a) -> Range -> Patricia a -> Patricia a+updateRangeWithKey f (UnsafeRange kL kR)+  | kL == kR  = update (f kL) kL+  | otherwise = unsafeUpdateRangeWithKey f kL kR++-- | \(\mathcal{O}(\min(n,W) + n_I)\).+--   Update every value for which the key is in the given range.+--+--   The 'Maybe' is evaluated to WHNF.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeUpdateRangeWithKey+  :: (Word -> a -> Maybe a)+  -> Word                   -- ^ \(k_L\)+  -> Word                   -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeUpdateRangeWithKey f !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> rebin p (updateRWithKey f wL l) (updateLWithKey f wR r)++            LT | pM <= upper p -> rebinR p l (go r)+               | p >= lower pM -> if wL < p+                                    then rebinL p (updateRWithKey f wL l)+                                                  (mapMaybeWithKey f r)++                                    else rebinR p l (updateRWithKey f wL r)+               | otherwise     -> t++            GT | p <= upper pM -> if wR >= p+                                    then rebinR p (mapMaybeWithKey f l)+                                                  (updateLWithKey f wR r)++                                    else rebinL p (updateLWithKey f wR l) r++               | pM >= lower p -> rebinL p (go l) r+               | otherwise     -> t++        Tip k a+          | k >= wL && k <= wR -> retip k (f k a)+          | otherwise          -> t++        Nil -> Nil++++-- | \(\mathcal{O}(\min(n,W))\).+--   Take values for which keys are in the given range.+takeRange :: Range -> Patricia a -> Patricia a+takeRange (UnsafeRange kL kR)+  | kL == kR  = takeOne kL+  | otherwise = unsafeTakeRange kL kR++-- | \(\mathcal{O}(\min(n,W))\).+--   Take values for which keys are in the given range.+--+--   \(k_R\) __must__ be greater than \(k_L\).+unsafeTakeRange+  :: Word       -- ^ \(k_L\)+  -> Word       -- ^ \(k_R\)+  -> Patricia a+  -> Patricia a+unsafeTakeRange !wL !wR = go+  where+    !mM = branchingBit wL wR++    !pM = mask wL mM .|. mM++    go t =+      case t of+        Bin p l r ->+          case Prelude.compare p pM of+            EQ                 -> rebin p (takeR wL l) (takeL wR r)++            LT | pM <= upper p -> go r+               | p >= lower pM -> if wL < p+                                    then rebinL p (takeR wL l) r+                                    else takeR wL r++               | otherwise     -> Nil++            GT | p <= upper pM -> if wR >= p+                                    then rebinR p l (takeL wR r)+                                    else takeL wR l++               | pM >= lower p -> go l+               | otherwise     -> Nil++        Tip k _+          | k >= wL && k <= wR -> t+          | otherwise          -> Nil++        Nil -> Nil++++-- | Result of a tree split.+data Split l r = Split !(Patricia l) !(Patricia r)+                 deriving Show++-- | \(\mathcal{O}(\min(n,W))\).+--   Split the tree into two, such that+--   values with keys smaller than or equal to the given one are on the left,+--   and values with keys greater than the given one are on the right.+splitL :: Word -> Patricia a -> Split a a+splitL !w = \t ->+  case go t of+    (# !l, !r #) -> Split l r+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then let !(# !ll, !lr #) = go l+                        in (# ll, rebinL p lr r #)++                   else (# Nil, t #)++            else if w <= upper p+                   then let !(# !rl, !rr #) = go r+                        in (# rebinR p l rl, rr #)++                   else (# t, Nil #)++        Tip k _+          | w >= k    -> (# t, Nil #)+          | otherwise -> (# Nil, t #)++        Nil -> (# Nil, Nil #)++-- | \(\mathcal{O}(\min(n,W))\).+--   Split the tree into two, such that+--   values with keys smaller than the given one are on the left,+--   and values with keys greater than or equal to the given one are on the right.+splitR :: Word -> Patricia a -> Split a a+splitR !w = \t ->+  case go t of+    (# !l, !r #) -> Split l r+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then let !(# !ll, !lr #) = go l+                        in (# ll, rebinL p lr r #)++                   else (# Nil, t #)++            else if w <= upper p+                   then let !(# !rl, !rr #) = go r+                        in (# rebinR p l rl, rr #)++                   else (# t, Nil #)++        Tip k _+          | w > k     -> (# t, Nil #)+          | otherwise -> (# Nil, t #)++        Nil -> (# Nil, Nil #)++++-- | Result of a tree split with a lookup.+data SplitLookup l x r = SplitLookup !(Patricia l) !(Maybe x) !(Patricia r)+                         deriving Show++-- | \(\mathcal{O}(\min(n,W))\).+--   Split the tree into two, such that+--   values with keys smaller than the given one are on the left,+--   values with keys greater than the given one are on the right,+--   and the value at the given key is returned separately.+splitLookup :: Word -> Patricia a -> SplitLookup a a a+splitLookup !w = \t ->+  case go t of+    (# !l, !mx, !r #) -> SplitLookup l mx r+  where+    go t =+      case t of+        Bin p l r ->+          if w < p+            then if w >= lower p+                   then let !(# !ll, !mx, !lr #) = go l+                        in (# ll, mx, rebinL p lr r #)++                   else (# Nil, Nothing, t #)++            else if w <= upper p+                   then let !(# !rl, !mx, !rr #) = go r+                        in (# rebinR p l rl, mx, rr #)++                   else (# t, Nothing, Nil #)++        Tip k a ->+          case w `Prelude.compare` k of+            EQ -> (# Nil, Just a , Nil #)+            GT -> (# t  , Nothing, Nil #)+            LT -> (# Nil, Nothing, t   #)++        Nil -> (# Nil, Nothing, Nil #)++++-- | \(\mathcal{O}(n)\).+--   Filter values that satisfy the value predicate.+filter :: (a -> Bool) -> Patricia a -> Patricia a+filter f = go+  where+    go t =+      case t of+        Bin p l r -> rebin p (go l) (go r)++        Tip _ a+          | f a       -> t+          | otherwise -> Nil++        Nil -> Nil++-- | \(\mathcal{O}(n)\).+--   Filter values that satisfy the value predicate.+filterWithKey :: (Word -> a -> Bool) -> Patricia a -> Patricia a+filterWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> rebin p (go l) (go r)++        Tip k a+          | f k a     -> t+          | otherwise -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(n)\).+--   Apply a function to every value in the tree and create one out of 'Just' values.+--+--   The 'Maybe' is evaluated to WHNF.+mapMaybe :: (a -> Maybe b) -> Patricia a -> Patricia b+mapMaybe f = go+  where+    go t =+      case t of+        Bin p l r -> rebin p (go l) (go r)++        Tip k a ->+          case f a of+            Just b  -> Tip k b+            Nothing -> Nil++        Nil -> Nil++-- | \(\mathcal{O}(n)\).+--   Apply a function to every value in the tree+--   and create a tree out of 'Just' results.+--+--   The 'Maybe' is evaluated to WHNF.+mapMaybeWithKey :: (Word -> a -> Maybe b) -> Patricia a -> Patricia b+mapMaybeWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> rebin p (go l) (go r)++        Tip k a ->+          case f k a of+            Just b  -> Tip k b+            Nothing -> Nil++        Nil -> Nil++++-- | \(\mathcal{O}(n)\).+--   Split the tree into two, such that values that satisfy the predicate+--   are on the left and values that do not are on the right.+partition :: (a -> Bool) -> Patricia a -> Split a a+partition f = \t ->+  case go t of+    (# !l, !r #) -> Split l r+  where+    go t =+      case t of+        Bin p l r ->+          let !(# !ll, !lr #) = go l+              !(# !rl, !rr #) = go r++          in (# rebin p ll rl, rebin p lr rr #)++        Tip _ a+          | f a       -> (# t, Nil #)+          | otherwise -> (# Nil, t #)++        Nil -> (# Nil, Nil #)++-- | \(\mathcal{O}(n)\).+--   Split the tree into two, such that values that satisfy the predicate+--   are on the left and values that do not are on the right.+partitionWithKey :: (Word -> a -> Bool) -> Patricia a -> Split a a+partitionWithKey f = \t ->+  case go t of+    (# !l, !r #) -> Split l r+  where+    go t =+      case t of+        Bin p l r ->+          let !(# !ll, !lr #) = go l+              !(# !rl, !rr #) = go r++          in (# rebin p ll rl, rebin p lr rr #)++        Tip k a+          | f k a     -> (# t, Nil #)+          | otherwise -> (# Nil, t #)++        Nil -> (# Nil, Nil #)+++-- | \(\mathcal{O}(n)\).+--   Apply a function to every value in the tree and create two trees,+--   one out of 'Left' results and one out of 'Right' ones.+--+--   The 'Either' is evaluated to WHNF.+mapEither :: (a -> Either b c) -> Patricia a -> Split b c+mapEither f = \t ->+  case go t of+    (# !l, !r #) -> Split l r+  where+    go t =+      case t of+        Bin p l r ->+          let !(# !ll, !lr #) = go l+              !(# !rl, !rr #) = go r++          in (# rebin p ll rl, rebin p lr rr #)++        Tip k a ->+          case f a of+            Left b  -> (# Tip k b, Nil #)+            Right c -> (# Nil, Tip k c #)++        Nil -> (# Nil, Nil #)++-- | \(\mathcal{O}(n)\).+--   Apply a function to every value in the tree and create two trees,+--   one out of 'Left' results and one out of 'Right' ones.+--+--   The 'Either' is evaluated to WHNF.+mapEitherWithKey :: (Word -> a -> Either b c) -> Patricia a -> Split b c+mapEitherWithKey f = \t ->+  case go t of+    (# !l, !r #) -> Split l r+  where+    go t =+      case t of+        Bin p l r ->+          let !(# !ll, !lr #) = go l+              !(# !rl, !rr #) = go r++          in (# rebin p ll rl, rebin p lr rr #)++        Tip k a ->+          case f k a of+            Left b  -> (# Tip k b, Nil #)+            Right c -> (# Nil, Tip k c #)++        Nil -> (# Nil, Nil #)++++moduleLoc :: String+moduleLoc = "Patricia.Word.Strict"++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the leftmost key in the tree.+lookupMin :: Patricia a -> Maybe a+lookupMin Nil = Nothing+lookupMin t   = let !(# a #) = unsafeLookupMin t+                in Just a++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the leftmost key in the tree.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeLookupMin :: Patricia a -> (# a #)+unsafeLookupMin t =+  case t of+    Bin _ l _ -> unsafeLookupMin l+    Tip _ a   -> (# a #)+    Nil       -> throw $ MalformedTree moduleLoc "lookupMin"+++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the leftmost key in the tree.+lookupMinWithKey :: Patricia a -> Maybe (Lookup a)+lookupMinWithKey Nil = Nothing+lookupMinWithKey t   = Just $! unsafeLookupMinWithKey t++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the leftmost key in the tree.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeLookupMinWithKey :: Patricia a -> Lookup a+unsafeLookupMinWithKey t =+  case t of+    Bin _ l _ -> unsafeLookupMinWithKey l+    Tip k a   -> Lookup k a+    Nil       -> throw $ MalformedTree moduleLoc "lookupMinWithKey"++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the rightmost key in the tree.+lookupMax :: Patricia a -> Maybe a+lookupMax Nil = Nothing+lookupMax t   = let !(# a #) = unsafeLookupMax t+                in Just a++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the rightmost key in the tree.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeLookupMax :: Patricia a -> (# a #)+unsafeLookupMax t =+  case t of+    Bin _ _ r -> unsafeLookupMax r+    Tip _ a   -> (# a #)+    Nil       -> throw $ MalformedTree moduleLoc "lookupMax"+++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the rightmost key in the tree.+lookupMaxWithKey :: Patricia a -> Maybe (Lookup a)+lookupMaxWithKey Nil = Nothing+lookupMaxWithKey t   = Just $! unsafeLookupMaxWithKey t++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up a value at the rightmost key in the tree.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeLookupMaxWithKey :: Patricia a -> Lookup a+unsafeLookupMaxWithKey t =+  case t of+    Bin _ _ r -> unsafeLookupMaxWithKey r+    Tip k a   -> Lookup k a+    Nil       -> throw $ MalformedTree moduleLoc "lookupMaxWithKey"++++-- | \(\mathcal{O}(\min(n,W))\).+--   Delete a value at the leftmost key in the tree.+deleteMin :: Patricia a -> Patricia a+deleteMin = go+  where+    go t =+      case t of+        Bin p l r -> rebinL p (go l) r+        _         -> Nil++-- | \(\mathcal{O}(\min(n,W))\).+--   Delete a value at the rightmost key in the tree.+deleteMax :: Patricia a -> Patricia a+deleteMax = go+  where+    go t =+      case t of+        Bin p l r -> rebinR p l (go r)+        _         -> Nil++++-- | \(\mathcal{O}(\min(n,W))\).+--   Update a value at the leftmost key in the tree.+adjustMin :: (a -> a) -> Patricia a -> Patricia a+adjustMin f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) r+        Tip k a   -> Tip k (f a)+        Nil       -> Nil++-- | \(\mathcal{O}(\min(n,W))\).+--   Update a value at the leftmost key in the tree.+--+--   New value is evaluated to WHNF.+adjustMin' :: (a -> a) -> Patricia a -> Patricia a+adjustMin' f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) r+        Tip k a   -> Tip k $! f a+        Nil       -> Nil+++-- | \(\mathcal{O}(\min(n,W))\).+--   Update a value at the leftmost key in the tree.+adjustMinWithKey :: (Word -> a -> a) -> Patricia a -> Patricia a+adjustMinWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) r+        Tip k a   -> Tip k (f k a)+        Nil       -> Nil++-- | \(\mathcal{O}(\min(n,W))\).+--   Update a value at the leftmost key in the tree.+--+--   New value is evaluated to WHNF.+adjustMinWithKey' :: (Word -> a -> a) -> Patricia a -> Patricia a+adjustMinWithKey' f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p (go l) r+        Tip k a   -> Tip k $! f k a+        Nil       -> Nil+++-- | \(\mathcal{O}(\min(n,W))\).+--   Update a value at the rightmost key in the tree.+adjustMax :: (a -> a) -> Patricia a -> Patricia a+adjustMax f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p l (go r)+        Tip k a   -> Tip k (f a)+        Nil       -> Nil++-- | \(\mathcal{O}(\min(n,W))\).+--   Update a value at the rightmost key in the tree.+--+--   New value is evaluated to WHNF.+adjustMax' :: (a -> a) -> Patricia a -> Patricia a+adjustMax' f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p l (go r)+        Tip k a   -> Tip k $! f a+        Nil       -> Nil++-- | \(\mathcal{O}(\min(n,W))\).+--   Update a value at the rightmost key in the tree.+adjustMaxWithKey :: (Word -> a -> a) -> Patricia a -> Patricia a+adjustMaxWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p l (go r)+        Tip k a   -> Tip k (f k a)+        Nil       -> Nil++-- | \(\mathcal{O}(\min(n,W))\).+--   Update a value at the rightmost key in the tree.+--+--   New value is evaluated to WHNF.+adjustMaxWithKey' :: (Word -> a -> a) -> Patricia a -> Patricia a+adjustMaxWithKey' f = go+  where+    go t =+      case t of+        Bin p l r -> Bin p l (go r)+        Tip k a   -> Tip k $! f k a+        Nil       -> Nil++++-- | \(\mathcal{O}(\min(n,W))\).+--   Update or delete a value at the leftmost key in the tree.+--+--   The 'Maybe' is evaluated to WHNF.+updateMin :: (a -> Maybe a) -> Patricia a -> Patricia a+updateMin f = go+  where+    go t =+      case t of+        Bin p l r -> rebinL p (go l) r+        Tip k a   -> retip k (f a)+        Nil       -> Nil++-- | \(\mathcal{O}(\min(n,W))\).+--   Update or delete a value at the leftmost key in the tree.+--+--   The 'Maybe' is evaluated to WHNF.+updateMinWithKey :: (Word -> a -> Maybe a) -> Patricia a -> Patricia a+updateMinWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> rebinL p (go l) r+        Tip k a   -> retip k (f k a)+        Nil       -> Nil+++-- | \(\mathcal{O}(\min(n,W))\).+--   Update or delete a value at the rightmost key in the tree.+--+--   The 'Maybe' is evaluated to WHNF.+updateMax :: (a -> Maybe a) -> Patricia a -> Patricia a+updateMax f = go+  where+    go t =+      case t of+        Bin p l r -> rebinR p l (go r)+        Tip k a   -> retip k (f a)+        Nil       -> Nil++-- | \(\mathcal{O}(\min(n,W))\).+--   Update or delete a value at the rightmost key in the tree.+--+--   The 'Maybe' is evaluated to WHNF.+updateMaxWithKey :: (Word -> a -> Maybe a) -> Patricia a -> Patricia a+updateMaxWithKey f = go+  where+    go t =+      case t of+        Bin p l r -> rebinR p l (go r)+        Tip k a   -> retip k (f k a)+        Nil       -> Nil++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the leftmost value and return it alongside the tree without it.+minView :: Patricia a -> Maybe (ViewL a)+minView Nil = Nothing+minView t   = Just $! unsafeMinView t++-- | The leftmost value with its key and the rest of the tree.+data ViewL a = ViewL {-# UNPACK #-} !(Lookup a) !(Patricia a)+               deriving Show++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the leftmost value and return it alongside the tree without it.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeMinView :: Patricia a -> ViewL a+unsafeMinView t =+  case t of+    Bin p l r ->+      let !(ViewL a l0) = unsafeMinView l+      in ViewL a (rebinL p l0 r)++    Tip k a -> ViewL (Lookup k a) Nil++    Nil -> throw $ MalformedTree moduleLoc "minView"++++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the rightmost value and return it alongside the tree without it.+maxView :: Patricia a -> Maybe (ViewR a)+maxView Nil = Nothing+maxView t   = Just $! unsafeMaxView t++-- | The rightmost value with its key and the rest of the tree.+data ViewR a = ViewR !(Patricia a) {-# UNPACK #-} !(Lookup a)+               deriving Show++-- | \(\mathcal{O}(\min(n,W))\).+--   Look up the rightmost value and return it alongside the tree without it.+--+--   Throws 'MalformedTree' if the tree is empty.+unsafeMaxView :: Patricia a -> ViewR a+unsafeMaxView t =+  case t of+    Bin p l r ->+      let !(ViewR r0 a) = unsafeMaxView r+      in ViewR (rebinR p l r0) a++    Tip k a -> ViewR Nil (Lookup k a)++    Nil -> throw $ MalformedTree moduleLoc "maxView"