{
: MAP
: SET
}

Where

Define (MAP compare item_key)
    (make compare item_key)

Let SET
    Define (item_key item) item
    In
    Func {compare}
        Let MAP (make compare item_key)
        In
        Define (union s t)
            (LIST.reduce (MAP.list s) t MAP.insert)
        Define (diff s t)
            (LIST.reduce (MAP.list s) MAP.empty
                Func {u item}
                    Match (MAP.search t item)
                    | 'nothing (MAP.insert u item)
                    | 'just._ u
                    ;)
        In
        {
        : compare
        : empty MAP.empty
        : new MAP.new
        : search MAP.search
        : insert MAP.insert
        : list MAP.list
        : union
        : diff
        }

Where

Define (make compare item_key)
    Define (search tree key)
        Iterate {depth t} From {tree.depth tree.root}
            Cond
            | [depth = 0] 'nothing
            | [depth = 1]
                Match t
                | 'one.a
                    Match (compare key (item_key a))
                    | 'equal 'just.a
                    | _ 'nothing
                    ;
                | 'two.{a b}
                    Match (compare key (item_key a))
                    | 'equal 'just.a
                    | _
                        Match (compare key (item_key b))
                        | 'equal 'just.b
                        | _ 'nothing
                        ;
                    ;
                ;
            | True
                Match t
                | 'one.{u a v}
                    Match (compare key (item_key a))
                    | 'less Continue {[depth - 1] u}
                    | 'equal 'just.a
                    | 'greater Continue {[depth - 1] v}
                    ;
                | 'two.{u a v b w}
                    Match (compare key (item_key a))
                    | 'less Continue {[depth - 1] u}
                    | 'equal 'just.a
                    | 'greater
                        Match (compare key (item_key b))
                        | 'less Continue {[depth - 1] v}
                        | 'equal 'just.b
                        | 'greater Continue {[depth - 1] w}
                        ;
                    ;
                ;
            ;
    In
    Let empty
        {
        : depth 0
        : root 'zero
        }
    Define (insert tree a)
        Define (rec rec depth tree a)
            Cond
            | [depth = 1]
                Match tree
                | 'one.b
                    Match (compare (item_key a) (item_key b))
                    | 'less 'no_split.'two.{a b}
                    | 'greater 'no_split.'two.{b a}
                    | 'equal 'no_split.'one.a
                    ;
                | 'two.{b c}
                    Let key_a (item_key a)
                    Let key_b (item_key b)
                    Let key_c (item_key c)
                    In
                    Match (compare key_a key_b)
                    | 'less 'split.{'one.a b 'one.c}
                    | 'greater
                        Match (compare key_a key_c)
                        | 'less 'split.{'one.b a 'one.c}
                        | 'greater 'split.{'one.b c 'one.a}
                        | 'equal 'no_split.'two.{b a}
                        ;
                    | 'equal 'no_split.'two.{a c}
                    ;
                ;
            | True
                Match tree
                | 'one.{u b v}
                    Match (compare (item_key a) (item_key b))
                    | 'less
                        Match (rec rec [depth - 1] u a)
                        | 'no_split.u
                            'no_split.'one.{u b v}
                        | 'split.{t a u}
                            'no_split.'two.{t a u b v}
                        ;
                    | 'greater
                        Match (rec rec [depth - 1] v a)
                        | 'no_split.v
                            'no_split.'one.{u b v}
                        | 'split.{v c w}
                            'no_split.'two.{u b v c w}
                        ;
                    | 'equal 'no_split.'one.{u a v}
                    ;
                | 'two.{t b u c v}
                    Let key_a (item_key a)
                    Let key_b (item_key b)
                    Let key_c (item_key c)
                    In
                    Match (compare key_a key_b)
                    | 'less
                        Match (rec rec [depth - 1] t a)
                        | 'no_split.t
                            'no_split.'two.{t b u c v}
                        | 'split.{tt a tu}
                            'split.{'one.{tt a tu} b 'one.{u c v}}
                        ;
                    | 'greater
                        Match (compare key_a key_c)
                        | 'less
                            Match (rec rec [depth - 1] u a)
                            | 'no_split.u
                                'no_split.'two.{t b u c v}
                            | 'split.{ut a uv}
                                'split.{'one.{t b ut} a 'one.{uv c v}}
                            ;
                        | 'greater
                            Match (rec rec [depth - 1] v a)
                            | 'no_split.v
                                'no_split.'two.{t b u c v}
                            | 'split.{vu a vv}
                                'split.{'one.{t b u} c 'one.{vu a vv}}
                            ;
                        | 'equal 'no_split.'two.{t b u a v}
                        ;
                    | 'equal 'no_split.'two.{t a u c v}
                    ;
                ;
            ;
        In
        If [tree.depth = 0]
            {
            : depth 1
            : root 'one.a
            }
            Match (rec rec tree.depth tree.root a)
            | 'no_split.t
                {
                : depth tree.depth
                : root t
                }
            | 'split.{u a v}
                {
                : depth [tree.depth + 1]
                : root 'one.{u a v}
                }
            ;
    Define (list tree)
        Define (rec rec depth t list)
            If [depth = 1]
                Match t
                | 'one.a [a & list]
                | 'two.{a b} [Right a & b & list]
                ;
                Match t
                | 'one.{u a v}
                    Let depth [depth - 1]
                    In
                    (rec rec depth u [a & (rec rec depth v list)])
                | 'two.{u a v b w}
                    Let depth [depth - 1]
                    In
                    Let list 
                        (rec rec depth v
                            [b & (rec rec depth w list)])
                    In
                    (rec rec depth u [a & list])
                ;
        In
        If [tree.depth = 0]
            'nil
            (rec rec tree.depth tree.root 'nil)
    In
    Define (new items)
        (LIST.reduce items empty insert)
    In
    {
    : compare
    : item_key
    : new
    : empty
    : insert
    : search
    : list
    }

Where

Let STDIO Package "stdio"
Let LIST Package "list"