types.lisp

   1 (in-package :trees)
   2
   3 \f
   4 ;;; tree nodes
   5
   6 ;;; Structures give better performance than CLOS.
   7
   8 (defstruct (tree-node
   9              (:conc-name)
  10              (:constructor make-tree-node (datum))
  11              (:copier nil))
  12   (left nil :type (or null tree-node))
  13   (right nil :type (or null tree-node))
  14   (rank 1 :type fixnum)
  15   (datum nil))
  16
  17 (defstruct (avl-tree-node
  18              (:conc-name)
  19              (:constructor make-avl-node (datum))
  20              (:copier nil)
  21              (:include tree-node))
  22   (balance-info 0 :type (integer -2 2)))
  23
  24 (defconstant +avl-equal+ 0)
  25 (defconstant +avl-leans-left+ -1)
  26 (defconstant +avl-leans-right+ +1)
  27 (defconstant +avl-falls-left+ -2)
  28 (defconstant +avl-falls-right+ +2)
  29
  30 (deftype red-black-color ()
  31   "Keywords denoting red-black tree colors."
  32   '(member :red :black))
  33
  34 (defstruct (red-black-tree-node
  35              (:conc-name)
  36              (:constructor make-red-black-node (datum))
  37              (:copier nil)
  38              (:include tree-node))
  39   (color :red :type red-black-color))
  40
  41 (defstruct (aa-tree-node
  42              (:conc-name)
  43              (:constructor make-aa-node (datum))
  44              (:copier nil)
  45              (:include tree-node))
  46   (level 1 :type fixnum))
  47 \f
  48 ;;; trees
  49
  50 (defstruct (binary-tree
  51              (:conc-name)
  52              (:constructor %make-binary-tree (pred key test
  53                                                    nodegen
  54                                                    rebalance/insert
  55                                                    rebalance/delete))
  56              (:copier nil))
  57   (test #1=(error "missing arg") :type function :read-only t)
  58   (key #1# :type function :read-only t)
  59   (pred #1# :type function :read-only t)
  60   (size 0 :type fixnum)
  61   (root nil :type (or null tree-node))
  62   (modcount 0 :type fixnum)
  63   (nodegen #1# :type function :read-only t)
  64   (rebalance/insert nil :type (or null function) :read-only t)
  65   (rebalance/delete nil :type (or null function) :read-only t))