[Fencommits] fenserve: add StormMap, a probabilistically balanced search tree whose nodes are storm blocks; untested, some simple details not yet implemented

[Benja Fallenstein]

Wed Apr 18 01:10:36 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * add StormMap, a probabilistically balanced search tree whose nodes are storm blocks; untested, some simple details not yet implemented
diff -rN -u old-fenserve/StormData.hs new-fenserve/StormData.hs
--- old-fenserve/StormData.hs	2007-04-18 01:10:47.000000000 +0300
+++ new-fenserve/StormData.hs	2007-04-18 01:10:47.000000000 +0300
@@ -24,7 +24,7 @@
 import Fenfire.Utils
 import qualified Fenfire.Raptor as Raptor
 
-import Control.Monad
+import Control.Monad hiding (join)
 
 import Data.Binary (Binary)
 import qualified Data.Binary as Binary
@@ -94,7 +94,7 @@
 -- Binary data
 ----------------------------------------------------------------------------
 
-data Binary a => BinRef a = BinRef BlockId
+data Binary a => BinRef a = BinRef { refId :: BlockId }   deriving (Eq,Ord)
 
 getBinary :: (Binary a, StormMonad m) => BlockId -> m a
 getBinary bid = liftM (Binary.decode . Lazy.pack . ByteString.unpack) $
@@ -114,6 +114,86 @@
 
 
 ----------------------------------------------------------------------------
+-- Data structures: StormMap (hash-balanced search tree)
+----------------------------------------------------------------------------
+
+-- Definition: The *degree* of a storm block is the number of leading zeros
+-- in the block id.
+
+-- A StormMap is a binary search tree mapping (keys serializable as)
+-- storm blocks to (values serialziable as) storm blocks.
+
+-- The root of a subtree contains the key/value mapping whose key
+-- has the highest degree in this subtree. If there is more than one key
+-- with the same degree, the root contains the one whose block id is smallest.
+
+-- This gives us a probabilistically balanced tree whose shape is determined
+-- by the set of key/value mappings. This data structure is essentially due to
+-- Pugh and Teitelbaum, "Incremental computation via function caching," 1989.
+
+type StormMap k v = Maybe (BinRef (Tree k v))
+data Tree     k v = Tree (StormMap k v) (BinRef k) (BinRef v) (StormMap k v)
+
+degree :: BinRef a -> Int
+degree = error "StormData.degree: not implemented"
+
+instance Binary (Tree k v) where -- XXX
+
+search :: (Binary k, Binary v, StormMonad m) =>
+          BinRef k -> StormMap k v -> m (Maybe v)
+search _ Nothing = return Nothing
+search x (Just ref) = readBinRef ref >>= f where
+    f (Tree l k v r) | x < k  = search x l
+                     | x == k = liftM Just (readBinRef v)
+                     | x > k  = search x r
+                     
+-- Changes to the tree are done through two internal functions: split and join.
+-- 'split k t' returns a pair of subtrees: one containing the mappings
+-- whose keys are smaller than 'k' and one containing the mappings whose keys
+-- are larger. 'join s t' joins s and t under the assumption that
+-- all elements of s are smaller than all elements of t.
+
+split :: (Binary k, Binary v, StormMonad m) =>
+         BinRef k -> StormMap k v -> m (StormMap k v, StormMap k v)
+split _ Nothing = return (Nothing, Nothing)
+split x (Just ref) = readBinRef ref >>= f where
+    f (Tree l k v r) | x < k  = do (ll,lr) <- split x l
+                                   t <- newBinRef (Tree lr k v r)
+                                   return (ll, Just t)
+                     | x == k = return (l, r)
+                     | x > k  = do (rl,rr) <- split x r
+                                   t <- newBinRef (Tree l k v rl)
+                                   return (Just t, rr)
+
+join :: (Binary k, Binary v, StormMonad m) =>
+        StormMap k v -> StormMap k v -> m (StormMap k v)
+join l Nothing = return l
+join Nothing r = return r
+join (Just x) (Just y) = do x' <- readBinRef x; y' <- readBinRef y; f x' y'
+    where f (Tree lx kx vx rx) (Tree ly ky vy ry)
+              | degree kx < degree ky = do ly' <- join (Just x) ly
+                                           t <- newBinRef (Tree ly' ky vy ry)
+                                           return (Just t)
+              | otherwise             = do rx' <- join rx (Just y)
+                                           t <- newBinRef (Tree lx kx vx rx')
+                                           return (Just t)
+
+-- With the heavy lifting done, the rest is simple.
+
+insert :: (Binary k, Binary v, StormMonad m) =>
+          BinRef k -> BinRef v -> StormMap k v -> m (StormMap k v)
+insert k v m = do (l,r) <- split k m
+                  t <- newBinRef (Tree Nothing k v Nothing)
+                  t' <- join (Just t) r
+                  join l t'
+
+remove :: (Binary k, Binary v, StormMonad m) =>
+          BinRef k -> StormMap k v -> m (StormMap k v)
+remove k m = do (l,r) <- split k m
+                join l r
+
+
+----------------------------------------------------------------------------
 -- Data structures: Append-only log
 ----------------------------------------------------------------------------