1 files changed, 60 insertions, 0 deletions
diff --git a/stdlib/source/lux/data/struct/tree/rose.lux b/stdlib/source/lux/data/struct/tree/rose.lux
new file mode 100644
index 000000000..8620e46a7
--- /dev/null
+++ b/stdlib/source/lux/data/struct/tree/rose.lux
@@ -0,0 +1,60 @@
+##  Copyright (c) Eduardo Julian. All rights reserved.
+##  This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+##  If a copy of the MPL was not distributed with this file,
+##  You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+  lux
+  (lux (control monad
+                eq)
+       (data (struct [list "" Monad<List>]))
+       [compiler]
+       (macro [ast]
+              ["s" syntax #+ syntax: Syntax])))
+
+## [Types]
+(type: #export (Tree a)
+  {#value a
+   #children (List (Tree a))})
+
+## [Values]
+(def: #export (flatten tree)
+  (All [a] (-> (Tree a) (List a)))
+  (#;Cons (get@ #value tree)
+          (join (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})
+
+## [Syntax]
+(type: #rec Tree-AST
+  [AST (List Tree-AST)])
+
+(def: (tree^ _)
+  (-> Unit (Syntax Tree-AST))
+  (s;either (s;record (s;seq s;any (s;tuple (s;some (lambda [state] ((tree^ []) state))))))
+            (s;seq s;any (:: s;Monad<Syntax> wrap (list)))))
+
+(syntax: #export (tree type [root (tree^ [])])
+  {#;doc (doc "Tree literals."
+              (tree Int 10)
+              (tree Int {10 [20
+                             {30 []}
+                             40]}))}
+  (wrap (list (` (: (Tree (~ type))
+                    (~ (loop [[value children] root]
+                         (` {#value (~ value)
+                             #children (list (~@ (map recur children)))}))))))))
+
+## [Structs]
+(struct: #export (Eq<Tree> Eq<a>) (All [a] (-> (Eq a) (Eq (Tree a))))
+  (def: (= tx ty)
+    (and (:: Eq<a> = (get@ #value tx) (get@ #value ty))
+         (:: (list;Eq<List> (Eq<Tree> Eq<a>)) = (get@ #children tx) (get@ #children ty)))))