(.module:
[lux #*
[abstract
functor
[monad (#+ do Monad)]
equivalence
fold]
[control
["p" parser
["s" code (#+ Parser)]]]
[data
[collection
["." list ("#@." monad fold)]]]
["." macro
["." code]
[syntax (#+ syntax:)]]])
(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)
(|> (|>> p.some s.record (p.and s.any))
p.rec
p.some
s.record
(p.and s.any)
s.tuple))
(syntax: #export (tree {root tree^})
{#.doc (doc "Tree literals."
(tree Int [+10 {+20 {}
+30 {}
+40 {}}]))}
(wrap (list (` (~ (loop [[value children] root]
(` {#value (~ value)
#children (list (~+ (list@map recur children)))})))))))
(structure: #export (equivalence Equivalence) (All [a] (-> (Equivalence a) (Equivalence (Tree a))))
(def: (= tx ty)
(and (:: Equivalence = (get@ #value tx) (get@ #value ty))
(:: (list.equivalence (equivalence Equivalence)) = (get@ #children tx) (get@ #children ty)))))
(structure: #export functor (Functor Tree)
(def: (map f fa)
{#value (f (get@ #value fa))
#children (list@map (map f)
(get@ #children fa))}))
(structure: #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))))