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