red-black-trees.scm

 ;;;; red-black-trees, based on the Functional Pearls article:
  ;;;; 'Red-Black Trees in a Functional Setting' by Chris Okasaki, 1993

  (define-type R | B) ;; red black
  (define-type T color left elt right) ;; tree

  (define rbt:insert
    x t -> (match (rbt:insert* x t)
             (T _ a y b) -> (T B a y b)))

  ;;;; sadly will probably need to rewrite this using a more complicated
  ;;;; folding operation in order to make it iterative
  ;;;; keeping the pretty abstraction for now
  
  (define rbt:insert*
    x (Empty)     -> (T R Empty x Empty)
    x (T c a y b) -> (cond
                      (< x y) (rbt:balance c (rbt:insert* x a) y b)
                      (> x y) (rbt:balance c a y (rbt:insert* x b))
                      else    (T c a y b)))
  
  (define rbt:balance
    B (T R (T R a x b) y c) z d -> (T R (T B a x b) y (T B c z d))
    B (T R a x (T R b y c)) z d -> (T R (T B a x b) y (T B c z d))
    B a x (T R (T R b y c) z d) -> (T R (T B a x b) y (T B c z d))
    B a x (T R b y (T R c z d)) -> (T R (T B a x b) y (T B c z d))
    color a x b                 -> (T color a x b))

  (define rbt:member?
    x (Empty)     -> false
    x (T _ a y b) -> (cond
                      (< x y) (rbt:member? x a)
                      (> x y) (rbt:member? x b)
                      else    true))