(in-package :trees)


;;; tree nodes

;;; Structures give better performance than CLOS.

(defstruct (tree-node
             (:conc-name)
             (:constructor make-tree-node (datum))
             (:copier nil))
  (left nil :type (or null tree-node))
  (right nil :type (or null tree-node))
  (rank 1 :type fixnum)
  (datum nil))

(defstruct (avl-tree-node
             (:conc-name)
             (:constructor make-avl-node (datum))
             (:copier nil)
             (:include tree-node))
  (balance-info 0 :type (integer -2 2)))

(defconstant +avl-equal+ 0)
(defconstant +avl-leans-left+ -1)
(defconstant +avl-leans-right+ +1)
(defconstant +avl-falls-left+ -2)
(defconstant +avl-falls-right+ +2)

(deftype red-black-color ()
  "Keywords denoting red-black tree colors."
  '(member :red :black))

(defstruct (red-black-tree-node
             (:conc-name)
             (:constructor make-red-black-node (datum))
             (:copier nil)
             (:include tree-node))
  (color :red :type red-black-color))

(defstruct (aa-tree-node
             (:conc-name)
             (:constructor make-aa-node (datum))
             (:copier nil)
             (:include tree-node))
  (level 1 :type fixnum))

;;; trees

#+sbcl
(defclass binary-tree (sequence standard-object)
  ((test :initform #1=(error "missing arg")
         :initarg :test
         :type 'function
         :reader test)
   (key :initform #1#
        :initarg :key
        :type 'function
        :reader key)
   (pred :initform #1#
         :initarg :pred
         :type 'function
         :reader pred)
   (size :initform 0
         :initarg :size
         :type 'fixnum
         :accessor size)
   (root :initform nil
         :initarg :root
         :type '(or null tree-node)
         :accessor root)
   (modcount :initform 0
             :initarg :modcount
             :type 'fixnum
             :accessor modcount)
   (nodegen :initform #1#
            :initarg :nodegen
            :type 'function
            :reader nodegen)
   (rebalance/insert :initform nil
                     :initarg :rebalance/insert
                     :type '(or null function)
                     :reader rebalance/insert)
   (rebalance/delete :initform nil
                     :initarg :rebalance/delete
                     :type '(or null function)
                     :reader rebalance/delete)))

#+sbcl
(defun %make-binary-tree (pred key test nodegen rebalance/insert rebalance/delete)
  (make-instance 'binary-tree :pred pred :key key :test test :nodegen nodegen
                              :rebalance/insert rebalance/insert
                              :rebalance/delete rebalance/delete))

#-sbcl
(defstruct (binary-tree
             (:conc-name)
             (:constructor %make-binary-tree (pred key test
                                                   nodegen
                                                   rebalance/insert
                                                   rebalance/delete))
             (:copier nil))
  (test #1=(error "missing arg") :type function :read-only t)
  (key #1# :type function :read-only t)
  (pred #1# :type function :read-only t)
  (size 0 :type fixnum)
  (root nil :type (or null tree-node))
  (modcount 0 :type fixnum)
  (nodegen #1# :type function :read-only t)
  (rebalance/insert nil :type (or null function) :read-only t)
  (rebalance/delete nil :type (or null function) :read-only t))