fn defaultCompare(a, b) { switch { case a < b: -1 case a > b: 1 default: 0 } } let empty {} fn treeWithCompare(compare) { compare: compare node: empty } let tree treeWithCompare(defaultCompare) let hasLess hasField("less") let hasGreater hasField("greater") fn nextNode(compare, node, value) { let greater node != empty && compare(node.value, value) > 0 switch { case greater && hasLess(node): nextNode(compare, node.less, value) case greater: node case hasGreater(node): nextNode(compare, node.greater, value) default: empty } } fn prevNode(compare, node, value) { let less node != empty && compare(node.value, value) < 0 switch { case less && hasGreater(node): prevNode(compare, node.greater, value) case less: node case hasLess(node): prevNode(compare, node.less, value) default: empty } } fn findNode(compare, node, value) { switch { case node == empty: false case node.value == value: true case compare(node.value, value) < 0: findNode(compare, node.greater, value) default: findNode(compare, node.less, value) } } fn delNode(compare, node, value) { fn delBetween() { let next nextNode(compare, node, node.value) { node... value: next.value greater: delNode(compare, node.greater, next.value) } /* -> updateDepth() */ -> balance() } fn delCurrent() { match node { case {less, greater}: delBetween() case {less}: node.less case {greater}: node.greater } } fn delGreater() { match node { case {greater}: { node... greater: delNode(compare, node.greater, node.value) } -> balance() default: node } } fn delLess() { match node { case {less}: { node... less: delNode(compare, node.less, node.value) } -> balance() default: node } } fn delNode() { let c compare(node.value, value) switch { case c == 0: delCurrent() case c < 0: delGreater() default: delLess() } } node == empty ? empty : delNode() } fn insertNode(compare, node, value) { let ( empty node == empty c empty ? 0 : compare(node.value, value) insertGreater fn() { node... greater: insertNode( compare node.greater value ) } insertLess fn() { node... less: insertNode( compare node.less value ) } ) switch { case empty: {value: value} case c > 0: insertGreater() -> balance() case c < 0: insertLess() -> balance() default: node } } fn prevNextValue(f, tree, value) { let node f(tree.compare, tree.node, value) node == empty ? value : node.value } fn update(f, tree, value) { tree... node: f(tree.compare, tree.node, value) } type alias tree {compare: fn(a, a) int, node: {}} type next fn(tree, a) a type prev fn(tree, a) a type find fn(tree, a) bool type delete fn(tree, a) tree type insert fn(tree, a) tree let ( next = prevNextValue(prevNode) prev = prevNextValue(nextNode) ) fn find(tree, value) findNode(tree.compare, tree.node, value) != empty let ( del update(delNode) insert update(insertNode) )