proc binSrch {lst x} {
set len [llength $lst]
if {$len == 0} {
return -1
} else {
set pivotIndex [expr {$len / 2}]
set pivotValue [lindex $lst $pivotIndex]
if {$pivotValue == $x} {
return $pivotIndex
} elseif {$pivotValue -1 ? $recursive + $pivotIndex + 1 : -1}]
} elseif {$pivotValue > $x} {
set recursive [binSrch [lrange $lst 0 $pivotIndex-1] $x]
return [expr {$recursive > -1 ? $recursive : -1}]
}
}
}

import Control.Monad
import System.Random

data BTree k v = Node k v (BTree k v) (BTree k v) | Empty

find :: (k -> k -> Ordering) -> k -> BTree k v -> Maybe v
find _   _ Empty          = Nothing
find cmp k (Node k' v' l r) = case cmp k k' of EQ -> Just v'
                                               LT -> find cmp k l
                                               GT -> find cmp k r

insert :: (k -> k -> Ordering) -> k -> v -> BTree k v -> BTree k v
insert _   k v Empty            = Node k v Empty Empty
insert cmp k v (Node k' v' l r) = case cmp k k' of
    EQ -> Node k v l r
    LT -> Node k' v' (insert cmp k v l) r
    GT -> Node k' v' l (insert cmp k v r)

delete :: (k -> k -> Ordering) -> k -> BTree k v -> IO (BTree k v)
delete _   _ Empty              = return Empty
delete cmp k t@(Node k' v' l r) = case cmp k k' of
    EQ -> fmap (flip deroot t . (== 0)) $ randomRIO (0,1 :: Int)
    LT -> fmap (flip (Node k' v') r) $ delete cmp k l
    GT -> fmap (      Node k' v'  l) $ delete cmp k r

deroot :: Bool -> BTree k v -> BTree k v
deroot _    Empty              = Empty
deroot _    (Node _ _ l Empty) = l
deroot _    (Node _ _ Empty r) = r
deroot True (Node k v l (Node rk rv rl rr)) =
    Node rk rv (deroot False $ Node k v l rl) rr
deroot _    (Node k v (Node lk lv ll lr) r) =
    Node lk lv ll (deroot True $ Node k v lr r)

toList :: BTree k v -> [(k, v)]
toList Empty          = []
toList (Node k v l r) = toList l ++ (k, v) : toList r