treerack/test.mml

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)
)