Algebraic data types: Difference between revisions
Content added Content deleted
(update as per kpreid's suggestions) |
|||
Line 16: | Line 16: | ||
(defstruct (red-black-tree (:constructor tree (color left val right))) |
(defstruct (red-black-tree (:constructor tree (color left val right))) |
||
color left val right) |
color left val right) |
||
(defcomponent tree (operator macro-mixin)) |
(defcomponent tree (operator macro-mixin)) |
||
(defexpand tree (color left val right) |
(defexpand tree (color left val right) |
||
Line 24: | Line 24: | ||
red-black-tree-right ,right)) |
red-black-tree-right ,right)) |
||
(pushnew 'tree *used-components*) |
(pushnew 'tree *used-components*) |
||
(defun balance (color left val right) |
(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) |
|||
(tree 'red (tree 'black a x b) y |
|||
(tree 'black 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))) |
|||
(('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))) |
|||
(('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))) |
|||
((color a x b) |
|||
(tree color a x b)))) |
|||
(defun %insert (x s) |
(defun %insert (x s) |
||
(toad- |
(toad-ecase1 s |
||
nil |
(nil (tree 'red nil x nil)) |
||
(tree color a y b |
((tree color a y b) |
||
(cond ((< x y) |
|||
(balance color (%insert x a) y b)) |
|||
(balance color (%insert x a) y b)) |
|||
((> x y) |
|||
(balance color a y (%insert x b))) |
|||
(t s))))) |
|||
(defun insert (x s) |
(defun insert (x s) |
||
(toad- |
(toad-ecase1 (%insert x s) |
||
(tree t a y b) |
((tree t a y b) (tree 'black a y b))))</lang> |
||
=={{Header|E}}== |
=={{Header|E}}== |