module Table(table, mapTable, listTable, tableUpdate, tableLookup, emptyTable,
             Table) where
import Tree234

newtype Table a = T (Tree234 a) deriving (Table a -> Table a -> Bool
(Table a -> Table a -> Bool)
-> (Table a -> Table a -> Bool) -> Eq (Table a)
forall a. Eq a => Table a -> Table a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Table a -> Table a -> Bool
$c/= :: forall a. Eq a => Table a -> Table a -> Bool
== :: Table a -> Table a -> Bool
$c== :: forall a. Eq a => Table a -> Table a -> Bool
Eq, Eq (Table a)
Eq (Table a)
-> (Table a -> Table a -> Ordering)
-> (Table a -> Table a -> Bool)
-> (Table a -> Table a -> Bool)
-> (Table a -> Table a -> Bool)
-> (Table a -> Table a -> Bool)
-> (Table a -> Table a -> Table a)
-> (Table a -> Table a -> Table a)
-> Ord (Table a)
Table a -> Table a -> Bool
Table a -> Table a -> Ordering
Table a -> Table a -> Table a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Table a)
forall a. Ord a => Table a -> Table a -> Bool
forall a. Ord a => Table a -> Table a -> Ordering
forall a. Ord a => Table a -> Table a -> Table a
min :: Table a -> Table a -> Table a
$cmin :: forall a. Ord a => Table a -> Table a -> Table a
max :: Table a -> Table a -> Table a
$cmax :: forall a. Ord a => Table a -> Table a -> Table a
>= :: Table a -> Table a -> Bool
$c>= :: forall a. Ord a => Table a -> Table a -> Bool
> :: Table a -> Table a -> Bool
$c> :: forall a. Ord a => Table a -> Table a -> Bool
<= :: Table a -> Table a -> Bool
$c<= :: forall a. Ord a => Table a -> Table a -> Bool
< :: Table a -> Table a -> Bool
$c< :: forall a. Ord a => Table a -> Table a -> Bool
compare :: Table a -> Table a -> Ordering
$ccompare :: forall a. Ord a => Table a -> Table a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Table a)
Ord,Int -> Table a -> ShowS
[Table a] -> ShowS
Table a -> String
(Int -> Table a -> ShowS)
-> (Table a -> String) -> ([Table a] -> ShowS) -> Show (Table a)
forall a. Show a => Int -> Table a -> ShowS
forall a. Show a => [Table a] -> ShowS
forall a. Show a => Table a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Table a] -> ShowS
$cshowList :: forall a. Show a => [Table a] -> ShowS
show :: Table a -> String
$cshow :: forall a. Show a => Table a -> String
showsPrec :: Int -> Table a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Table a -> ShowS
Show)

emptyTable :: Table a
emptyTable = Tree234 a -> Table a
forall a. Tree234 a -> Table a
T Tree234 a
forall a. Tree234 a
initTree234

tableLookup :: t1 -> ((a, b) -> t1) -> (a, b) -> Table (a, b) -> t1
tableLookup t1
n (a, b) -> t1
j (a, b)
x (T Tree234 (a, b)
t) = t1
-> ((a, b) -> t1)
-> ((a, b) -> t1 -> t1 -> t1 -> t1)
-> Tree234 (a, b)
-> t1
forall t1 t2 t3.
t1
-> (t2 -> t3) -> (t2 -> t1 -> t3 -> t1 -> t1) -> Tree234 t2 -> t1
treeSearch t1
n (a, b) -> t1
j ((a, b) -> (a, b) -> t1 -> t1 -> t1 -> t1
forall a b b p. Ord a => (a, b) -> (a, b) -> p -> p -> p -> p
keyCmp (a, b)
x) Tree234 (a, b)
t

tableUpdate :: (a, b) -> Table (a, b) -> Table (a, b)
tableUpdate (a, b)
x (T Tree234 (a, b)
t) = Tree234 (a, b) -> Table (a, b)
forall a. Tree234 a -> Table a
T ((a, b) -> Tree234 (a, b) -> Tree234 (a, b)
forall a b. Ord a => (a, b) -> Tree234 (a, b) -> Tree234 (a, b)
update' (a, b)
x Tree234 (a, b)
t)

update' :: (a, b) -> Tree234 (a, b) -> Tree234 (a, b)
update' (a, b)
x = ((a, b) -> (a, b) -> (a, b))
-> ((a, b)
    -> (a, b)
    -> Tree234 (a, b)
    -> Tree234 (a, b)
    -> Tree234 (a, b)
    -> Tree234 (a, b))
-> (a, b)
-> Tree234 (a, b)
-> Tree234 (a, b)
forall a.
(a -> a -> a)
-> (a -> a -> Tree234 a -> Tree234 a -> Tree234 a -> Tree234 a)
-> a
-> Tree234 a
-> Tree234 a
treeAdd (a, b) -> (a, b) -> (a, b)
forall a b. a -> b -> a
const (a, b)
-> (a, b)
-> Tree234 (a, b)
-> Tree234 (a, b)
-> Tree234 (a, b)
-> Tree234 (a, b)
forall a b b p. Ord a => (a, b) -> (a, b) -> p -> p -> p -> p
keyCmp (a, b)
x

mapTable :: (t -> a) -> Table t -> Table a
mapTable t -> a
f (T Tree234 t
t) = Tree234 a -> Table a
forall a. Tree234 a -> Table a
T ((t -> a) -> Tree234 t -> Tree234 a
forall t a. (t -> a) -> Tree234 t -> Tree234 a
treeMap t -> a
f Tree234 t
t)

listTable :: Table a -> [a]
listTable (T Tree234 a
t) = Tree234 a -> [a]
forall a. Tree234 a -> [a]
treeList Tree234 a
t

table :: [(a, b)] -> Table (a, b)
table [(a, b)]
xs = Tree234 (a, b) -> Table (a, b)
forall a. Tree234 a -> Table a
T (((a, b) -> (a, b) -> (a, b))
-> ((a, b)
    -> (a, b)
    -> Tree234 (a, b)
    -> Tree234 (a, b)
    -> Tree234 (a, b)
    -> Tree234 (a, b))
-> [(a, b)]
-> Tree234 (a, b)
forall a.
(a -> a -> a)
-> (a -> a -> Tree234 a -> Tree234 a -> Tree234 a -> Tree234 a)
-> [a]
-> Tree234 a
treeFromList (a, b) -> (a, b) -> (a, b)
forall a b. a -> b -> a
const (a, b)
-> (a, b)
-> Tree234 (a, b)
-> Tree234 (a, b)
-> Tree234 (a, b)
-> Tree234 (a, b)
forall a b b p. Ord a => (a, b) -> (a, b) -> p -> p -> p -> p
keyCmp [(a, b)]
xs)

keyCmp :: (a, b) -> (a, b) -> p -> p -> p -> p
keyCmp (a
a, b
_) (a
b, b
_) p
lt p
eq p
gt =
    if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b then p
eq else if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b then p
lt else p
gt