Algebraic data types: Difference between revisions

Line 16:

(defstruct (red-black-tree (:constructor tree (color left val right)))

color left val right)

(defcomponent tree (operator macro-mixin))

(defexpand tree (color left val right)

Line 24:

red-black-tree-right ,right))

(pushnew 'tree *used-components*)

(defun balance (color left val right)

(toad-ecase color left val right

(toad-ecase (color left val right)

'black (tree 'red (tree 'red a x b) y c) z d

(('black (tree 'red (tree 'red a x b) y c) z d)

-> (tree 'red (tree 'black a x b) y

(tree 'red (tree 'black a x b) y

(tree 'black c z d))

(tree 'black c z d)))

'black (tree 'red a x (tree 'red b y c)) z d

(('black (tree 'red a x (tree 'red b y c)) z d)

-> (tree 'red (tree 'black a x b) y (tree 'black c z d))

(tree 'red (tree 'black a x b) y (tree 'black c z d)))

'black a x (tree 'red (tree 'red b y c) z d)

(('black a x (tree 'red (tree 'red b y c) z d))

-> (tree 'red (tree 'black a x b) y (tree 'black c z d))

(tree 'red (tree 'black a x b) y (tree 'black c z d)))

'black a x (tree 'red b y (tree 'red c z d))

(('black a x (tree 'red b y (tree 'red c z d)))

-> (tree 'red (tree 'black a x b) y (tree 'black c z d))

(tree 'red (tree 'black a x b) y (tree 'black c z d)))

~~color a x b ->~~ (~~tree~~ color a x b)))

((color a x b)

(tree color a x b))))

(defun %insert (x s)

(toad-~~ecase~~ s

(toad-ecase1 s

nil -> (tree 'red nil x nil)

(nil (tree 'red nil x nil))

(tree color a y b~~) -> (cond ((< x y~~)

((tree color a y b)

(cond ((< x y)

(balance color (%insert x a) y b))

((> x y)

(balance color (%insert x a) y b))

(~~balance color a y~~ (~~%insert~~ x ~~b))~~)

((> x y)

~~(t s)~~)))

(balance color a y (%insert x b)))

(t s)))))

(defun insert (x s)

(toad-~~ecase~~ (%insert x s)

(toad-ecase1 (%insert x s)

(tree t a y b) -> (tree 'black a y b)))</lang>

((tree t a y b) (tree 'black a y b))))</lang>

=={{Header|E}}==