;; -*- Mode: Irken -*-
(include "lib/core.scm")
;; http://eternallyconfuzzled.com/tuts/datastructures/jsw_tut_andersson.aspx
;; http://en.wikipedia.org/wiki/AA_tree
(define tree/nil
{level = 0
left = tree/nil
right = tree/nil
data = (magic #u)
})
;; shame that doesn't just work.
(set! tree/nil.left tree/nil)
(set! tree/nil.right tree/nil)
(define (node/make data level)
{level = level
left = tree/nil
right = tree/nil
data = data})
;; these are not tail-recursive.
(define (tree/skew root)
(if (> root.level 0)
(begin
(if (= root.left.level root.level)
(let ((save root))
(set! root root.left)
(set! save.left root.right)
(set! root.right save)))
(set! root.right (tree/skew root.right))))
root)
(define (tree/split root)
(if (and (= root.right.right.level root.level)
(not (= root.level 0)))
(let ((save root))
(set! root root.right)
(set! save.right root.left)
(set! root.left save)
(set! root.level (+ 1 root.level))
(set! root.right (tree/split root.right))))
root)
(define (tree/insert root data <)
(let loop ((n root))
(if (= n.level 0)
(node/make data 1)
(begin
(if (< data n.data)
(set! n.left (loop n.left))
(set! n.right (loop n.right)))
(tree/split (tree/skew n))))))
(define indent
0 -> #u
n -> (begin (print-string " ") (indent (- n 1))))
(define (tree/dump t)
(if (> t.level 0)
(begin
(tree/dump t.left)
(indent t.level)
(print t.level)
(print-string " ")
(printn t.data)
(tree/dump t.right))))
(define (t0)
(let ((t tree/nil))
(for-range
i 100
(set! t (tree/insert t i <)))
(tree/dump t)
))
(t0)