{ : 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"