Function: avl-tree--enter-balance

avl-tree--enter-balance is a byte-compiled function defined in avl-tree.el.gz.

Signature

(avl-tree--enter-balance NODE BRANCH DIR)

Documentation

Rebalance tree after insertion of NODE.

NODE was inserted into the left (DIR=0) or right (DIR=1) sub-tree of the left (BRANCH=0) or right (BRANCH=1) child of NODE. Return t if the height of the tree has grown.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/avl-tree.el.gz
;; ----------------------------------------------------------------
;;                           Entering data

(defun avl-tree--enter-balance (node branch dir)
  "Rebalance tree after insertion of NODE.
NODE was inserted into the left (DIR=0) or right (DIR=1) sub-tree
of the left (BRANCH=0) or right (BRANCH=1) child of NODE.
Return t if the height of the tree has grown."
  (let ((br (avl-tree--node-branch node branch))
	;; opposite direction: 0,1 -> 1,0
	(opp (avl-tree--switch-dir dir))
	;; direction 0,1 -> sign factor -1,+1
	(sgn (avl-tree--dir-to-sign dir))
        p1 p2 b2)
    (cond
     ((< (* sgn (avl-tree--node-balance br)) 0)
      (setf (avl-tree--node-balance br) 0)
      nil)

     ((= (avl-tree--node-balance br) 0)
      (setf (avl-tree--node-balance br) sgn)
      t)

     (t
      ;; Tree has grown => Rebalance.
      (setq p1 (avl-tree--node-branch br dir))
      (if (> (* sgn (avl-tree--node-balance p1)) 0)
          ;; Single rotation.
          (progn
            (setf (avl-tree--node-branch br dir)
		  (avl-tree--node-branch p1 opp))
            (setf (avl-tree--node-branch p1 opp) br)
            (setf (avl-tree--node-balance br) 0)
            (setf (avl-tree--node-branch node branch) p1))

        ;; Double rotation.
        (setf p2 (avl-tree--node-branch p1 opp)
	      b2 (avl-tree--node-balance p2)
	      (avl-tree--node-branch p1 opp)
                (avl-tree--node-branch p2 dir)
	      (avl-tree--node-branch p2 dir) p1
	      (avl-tree--node-branch br dir)
                (avl-tree--node-branch p2 opp)
	      (avl-tree--node-branch p2 opp) br
	      (avl-tree--node-balance br)
                (if (> (* sgn b2) 0) (- sgn) 0)
	      (avl-tree--node-balance p1)
                (if (< (* sgn b2) 0) sgn 0)
                (avl-tree--node-branch node branch) p2))
      (setf (avl-tree--node-balance
             (avl-tree--node-branch node branch))
            0)
      nil))))