Rosetta Code

Algebraic data types: Difference between revisions

Page Discussion

Algebraic data types (view source)

Revision as of 23:58, 11 August 2009

152 bytes removed ,  14 years ago
update as per kpreid's suggestions
(update as per kpreid's suggestions)
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)
(('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)))
(tree color a x b))))
 
(defun %insert (x s)
(toad-ecaseecase1 s
(nil -> (tree 'red nil x nil))
((tree color a y b) -> (cond ((< x y)
(cond ((< x y)
(balance color (%insert x a) y b))
(balance color ((>%insert x a) y b))
(balance color a y (%insert> x b))y)
(balance color a y (%insert x (t s)b)))
(t s)))))
 
(defun insert (x s)
(toad-ecaseecase1 (%insert x s)
((tree t a y b) -> (tree 'black a y b))))</lang>
 
=={{Header|E}}==
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/40879"