1 files changed, 85 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/data/collection/tree.lux b/stdlib/source/library/lux/data/collection/tree.lux
new file mode 100644
index 000000000..f6b3746e7
--- /dev/null
+++ b/stdlib/source/library/lux/data/collection/tree.lux
@@ -0,0 +1,85 @@
+(.module:
+  [library
+   [lux #*
+    [abstract
+     [functor (#+ Functor)]
+     [equivalence (#+ Equivalence)]
+     [fold (#+ Fold)]
+     [monad (#+ do)]]
+    [control
+     ["<>" parser
+      ["<c>" code (#+ Parser)]]]
+    [data
+     [collection
+      ["." list ("#\." monad fold)]]]
+    [macro
+     [syntax (#+ syntax:)]
+     ["." code]]]])
+
+(type: #export (Tree a)
+  {#value a
+   #children (List (Tree a))})
+
+(def: #export (flatten tree)
+  (All [a] (-> (Tree a) (List a)))
+  (#.Cons (get@ #value tree)
+          (list\join (list\map flatten (get@ #children tree)))))
+
+(def: #export (leaf value)
+  (All [a] (-> a (Tree a)))
+  {#value value
+   #children (list)})
+
+(def: #export (branch value children)
+  (All [a] (-> a (List (Tree a)) (Tree a)))
+  {#value value
+   #children children})
+
+(type: #rec Tree-Code
+  [Code (List Tree-Code)])
+
+(def: tree^
+  (Parser Tree-Code)
+  (|> (|>> <>.some
+           <c>.record
+           (<>.and <c>.any))
+      <>.rec
+      <>.some
+      <c>.record
+      (<>.default (list))
+      (<>.and <c>.any)))
+
+(syntax: #export (tree {root tree^})
+  {#.doc (doc "Tree literals."
+              (: (Tree Nat)
+                 (tree 10
+                       {20 {}
+                        30 {}
+                        40 {}})))}
+  (wrap (list (` (~ (loop [[value children] root]
+                      (` {#value (~ value)
+                          #children (list (~+ (list\map recur children)))})))))))
+
+(implementation: #export (equivalence super)
+  (All [a] (-> (Equivalence a) (Equivalence (Tree a))))
+  
+  (def: (= tx ty)
+    (and (\ super = (get@ #value tx) (get@ #value ty))
+         (\ (list.equivalence (equivalence super)) = (get@ #children tx) (get@ #children ty)))))
+
+(implementation: #export functor
+  (Functor Tree)
+  
+  (def: (map f fa)
+    {#value (f (get@ #value fa))
+     #children (list\map (map f)
+                         (get@ #children fa))}))
+
+(implementation: #export fold
+  (Fold Tree)
+  
+  (def: (fold f init tree)
+    (list\fold (function (_ tree' init') (fold f init' tree'))
+               (f (get@ #value tree)
+                  init)
+               (get@ #children tree))))