Initial data commit

Task/Algebraic-data-types/TXR/algebraic-data-types-1.txr

@@ -0,0 +1,5 @@
+(defstruct (rbnode color left right data) ()
+  color
+  left
+  right
+  data)

Task/Algebraic-data-types/TXR/algebraic-data-types-2.txr

@@ -0,0 +1 @@
+@(struct time year @y month @m)

Task/Algebraic-data-types/TXR/algebraic-data-types-3.txr

@@ -0,0 +1,13 @@
+(defmatch rb (color left right data)
+  (flet ((var? (sym) (if (bindable sym) ^@,sym sym)))
+    ^@(struct rbnode
+        color ,(var? color)
+        left ,(var? left)
+        right ,(var? right)
+        data ,(var? data))))
+
+(defmatch red (left right data)
+  ^@(rb :red ,left ,right ,data))
+
+(defmatch black (left right data)
+  ^@(rb :black ,left ,right ,data))

Task/Algebraic-data-types/TXR/algebraic-data-types-4.txr

@@ -0,0 +1,27 @@
+(defun-match rb-balance
+  ((@(or @(black @(red @(red a b x) c y) d z)
+         @(black @(red a @(red b c x) x) d z)
+         @(black a @(red @(red b c y) d z) x)
+         @(black a @(red b @(red c d z) y) x)))
+   (new (rbnode :red
+                (new (rbnode :black a b x))
+                (new (rbnode :black c d z))
+                y)))
+  ((@else) else))
+
+(defun rb-insert-rec (tree x)
+  (match-ecase tree
+    (nil
+     (new (rbnode :red nil nil x)))
+    (@(rb color a b y)
+     (cond
+       ((< x y)
+        (rb-balance (new (rbnode color (rb-insert-rec a) b y))))
+       ((> x y)
+        (rb-balance (new (rbnode color a (rb-insert-rec b) y))))
+       (t tree)))))
+
+(defun rb-insert (tree x)
+  (match-case (rb-insert-rec tree x)
+    (@(red a b y) (new (rbnode :black a b y)))
+    (@else else)))