From 9465270e1f800199ef98f878b6f457331bf7dcab Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 19 Apr 2019 19:09:56 -0400
Subject: Re-named "lux/data/collection/tree/rose" to
 "lux/data/collection/tree".

---
 stdlib/source/lux/control/parser/tree.lux          |   9 +-
 stdlib/source/lux/data/collection/tree.lux         |  73 ++++++
 stdlib/source/lux/data/collection/tree/rose.lux    |  73 ------
 .../lux/data/collection/tree/rose/zipper.lux       | 285 ---------------------
 stdlib/source/lux/data/collection/tree/zipper.lux  | 285 +++++++++++++++++++++
 stdlib/source/lux/macro/poly/equivalence.lux       |   5 +-
 stdlib/source/test/lux/data/collection.lux         |   9 +-
 stdlib/source/test/lux/data/collection/tree.lux    |  63 +++++
 .../source/test/lux/data/collection/tree/rose.lux  |  63 -----
 .../test/lux/data/collection/tree/rose/zipper.lux  | 116 ---------
 .../test/lux/data/collection/tree/zipper.lux       | 115 +++++++++
 11 files changed, 546 insertions(+), 550 deletions(-)
 create mode 100644 stdlib/source/lux/data/collection/tree.lux
 delete mode 100644 stdlib/source/lux/data/collection/tree/rose.lux
 delete mode 100644 stdlib/source/lux/data/collection/tree/rose/zipper.lux
 create mode 100644 stdlib/source/lux/data/collection/tree/zipper.lux
 create mode 100644 stdlib/source/test/lux/data/collection/tree.lux
 delete mode 100644 stdlib/source/test/lux/data/collection/tree/rose.lux
 delete mode 100644 stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
 create mode 100644 stdlib/source/test/lux/data/collection/tree/zipper.lux

(limited to 'stdlib')

diff --git a/stdlib/source/lux/control/parser/tree.lux b/stdlib/source/lux/control/parser/tree.lux
index 1c6e21f43..50c8c8a0e 100644
--- a/stdlib/source/lux/control/parser/tree.lux
+++ b/stdlib/source/lux/control/parser/tree.lux
@@ -1,12 +1,11 @@
 (.module:
   [lux #*
    [control
-    ["ex" exception (#+ exception:)]]
+    ["." exception (#+ exception:)]]
    [data
     ["." error (#+ Error)]
-    [tree
-     [rose (#+ Tree)
-      ["." zipper (#+ Zipper)]]]]]
+    [tree (#+ Tree)
+     ["." zipper (#+ Zipper)]]]]
   ["." //])
 
 (type: #export (Parser t a)
@@ -38,7 +37,7 @@
      (function (_ zipper)
        (let [next (<direction> zipper)]
          (if (is? zipper next)
-           (ex.throw cannot-move-further [])
+           (exception.throw cannot-move-further [])
            (#error.Success [next []])))))]
 
   [up        zipper.up]
diff --git a/stdlib/source/lux/data/collection/tree.lux b/stdlib/source/lux/data/collection/tree.lux
new file mode 100644
index 000000000..ad64b72ed
--- /dev/null
+++ b/stdlib/source/lux/data/collection/tree.lux
@@ -0,0 +1,73 @@
+(.module:
+  [lux #*
+   [abstract
+    functor
+    [monad (#+ do Monad)]
+    equivalence
+    fold]
+   [control
+    ["p" parser]]
+   [data
+    [collection
+     ["." list ("#@." monad fold)]]]
+   ["." macro
+    ["." code]
+    ["s" syntax (#+ 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^
+  (Syntax 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<a>) (All [a] (-> (Equivalence a) (Equivalence (Tree a))))
+  (def: (= tx ty)
+    (and (:: Equivalence<a> = (get@ #value tx) (get@ #value ty))
+         (:: (list.equivalence (equivalence Equivalence<a>)) = (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))))
diff --git a/stdlib/source/lux/data/collection/tree/rose.lux b/stdlib/source/lux/data/collection/tree/rose.lux
deleted file mode 100644
index ad64b72ed..000000000
--- a/stdlib/source/lux/data/collection/tree/rose.lux
+++ /dev/null
@@ -1,73 +0,0 @@
-(.module:
-  [lux #*
-   [abstract
-    functor
-    [monad (#+ do Monad)]
-    equivalence
-    fold]
-   [control
-    ["p" parser]]
-   [data
-    [collection
-     ["." list ("#@." monad fold)]]]
-   ["." macro
-    ["." code]
-    ["s" syntax (#+ 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^
-  (Syntax 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<a>) (All [a] (-> (Equivalence a) (Equivalence (Tree a))))
-  (def: (= tx ty)
-    (and (:: Equivalence<a> = (get@ #value tx) (get@ #value ty))
-         (:: (list.equivalence (equivalence Equivalence<a>)) = (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))))
diff --git a/stdlib/source/lux/data/collection/tree/rose/zipper.lux b/stdlib/source/lux/data/collection/tree/rose/zipper.lux
deleted file mode 100644
index bac8961e3..000000000
--- a/stdlib/source/lux/data/collection/tree/rose/zipper.lux
+++ /dev/null
@@ -1,285 +0,0 @@
-(.module:
-  [lux #*
-   [abstract
-    functor
-    comonad
-    [equivalence (#+ Equivalence)]]
-   [data
-    ["." maybe ("#@." monad)]
-    [collection
-     ["." list ("#@." functor fold monoid)]
-     ["." stack (#+ Stack)]]]
-   ["." macro
-    ["." code]
-    ["s" syntax (#+ Syntax syntax:)]]]
-  ["." // (#+ Tree) ("#@." functor)])
-
-(type: #export (Zipper a)
-  {#.doc "Tree zippers, for easy navigation and editing over trees."}
-  {#parent (Maybe (Zipper a))
-   #lefts (Stack (Tree a))
-   #rights (Stack (Tree a))
-   #node (Tree a)})
-
-(structure: #export (equivalence ,equivalence)
-  (All [a]
-    (-> (Equivalence a)
-        (Equivalence (Zipper a))))
-  (def: (= reference sample)
-    (and (:: (//.equivalence ,equivalence) =
-             (get@ #node reference)
-             (get@ #node sample))
-         (:: (stack.equivalence (//.equivalence ,equivalence)) =
-             (get@ #lefts reference)
-             (get@ #lefts sample))
-         (:: (stack.equivalence (//.equivalence ,equivalence)) =
-             (get@ #rights reference)
-             (get@ #rights sample))
-         (:: (maybe.equivalence (equivalence ,equivalence)) =
-             (get@ #parent reference)
-             (get@ #parent sample))
-         )))
-
-(def: #export (zip tree)
-  (All [a] (-> (Tree a) (Zipper a)))
-  {#parent #.None
-   #lefts stack.empty
-   #rights stack.empty
-   #node tree})
-
-(def: #export (unzip zipper)
-  (All [a] (-> (Zipper a) (Tree a)))
-  (get@ #node zipper))
-
-(def: #export (value zipper)
-  (All [a] (-> (Zipper a) a))
-  (|> zipper (get@ [#node #//.value])))
-
-(def: #export (children zipper)
-  (All [a] (-> (Zipper a) (List (Tree a))))
-  (|> zipper (get@ [#node #//.children])))
-
-(def: #export (branch? zipper)
-  (All [a] (-> (Zipper a) Bit))
-  (|> zipper children list.empty? not))
-
-(def: #export (leaf? zipper)
-  (All [a] (-> (Zipper a) Bit))
-  (|> zipper branch? not))
-
-(def: #export (start? zipper)
-  (All [a] (-> (Zipper a) Bit))
-  (case (get@ #parent zipper)
-    #.None
-    #1
-
-    _
-    #0))
-
-(def: #export (down zipper)
-  (All [a] (-> (Zipper a) (Zipper a)))
-  (case (children zipper)
-    #.Nil
-    zipper
-
-    (#.Cons head tail)
-    {#parent (#.Some zipper)
-     #lefts stack.empty
-     #rights tail
-     #node head}))
-
-(def: #export (up zipper)
-  (All [a] (-> (Zipper a) (Zipper a)))
-  (case (get@ #parent zipper)
-    #.None
-    zipper
-
-    (#.Some parent)
-    (|> parent
-        ## TODO: Remove once new-luxc becomes the standard compiler.
-        (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0)))
-                          (function (_ node)
-                            (set@ #//.children (list@compose (list.reverse (get@ #lefts zipper))
-                                                             (#.Cons (get@ #node zipper)
-                                                                     (get@ #rights zipper)))
-                                  node))))
-        ## (update@ #node (function (_ node)
-        ##                  (set@ #//.children (list@compose (list.reverse (get@ #lefts zipper))
-        ##                                                     (#.Cons (get@ #node zipper)
-        ##                                                             (get@ #rights zipper)))
-        ##                        node)))
-        )))
-
-(def: #export (start zipper)
-  (All [a] (-> (Zipper a) (Zipper a)))
-  (let [ancestor (..up zipper)]
-    (if (is? zipper ancestor)
-      zipper
-      (start ancestor))))
-
-(template [<one> <all> <side> <op-side>]
-  [(def: #export (<one> zipper)
-     (All [a] (-> (Zipper a) (Zipper a)))
-     (case (get@ <side> zipper)
-       #.Nil
-       zipper
-
-       (#.Cons next side')
-       (|> zipper
-           (update@ <op-side> (function (_ op-side)
-                                (#.Cons (get@ #node zipper) op-side)))
-           (set@ <side> side')
-           (set@ #node next))))
-
-   (def: #export (<all> zipper)
-     (All [a] (-> (Zipper a) (Zipper a)))
-     (case (list.reverse (get@ <side> zipper))
-       #.Nil
-       zipper
-
-       (#.Cons last prevs)
-       (|> zipper
-           (set@ <side> #.Nil)
-           (set@ <op-side> (|> (get@ <op-side> zipper)
-                               (#.Cons (get@ #node zipper))
-                               (list@compose prevs)))
-           (set@ #node last))))]
-
-  [right rightmost #rights #lefts]
-  [left  leftmost  #lefts  #rights]
-  )
-
-(def: #export (next zipper)
-  (All [a] (-> (Zipper a) (Zipper a)))
-  (let [forward (..down zipper)]
-    (if (is? zipper forward)
-      (loop [zipper zipper]
-        (let [jump (..right zipper)]
-          (if (is? zipper jump)
-            (let [backward (..up zipper)]
-              (if (is? zipper backward)
-                zipper
-                (recur backward)))
-            jump)))
-      forward)))
-
-(def: #export (end zipper)
-  (All [a] (-> (Zipper a) (Zipper a)))
-  (case (get@ #rights zipper)
-    #.Nil
-    (case (get@ [#node #//.children] zipper)
-      #.Nil
-      zipper
-      
-      (#.Cons _)
-      (end (..down zipper)))
-    
-    (#.Cons _)
-    (end (..rightmost zipper))))
-
-(def: #export (prev zipper)
-  (All [a] (-> (Zipper a) (Zipper a)))
-  (let [forward (..left zipper)]
-    (if (is? zipper forward)
-      (..up zipper)
-      (case (get@ [#node #//.children] forward)
-        #.Nil
-        forward
-        
-        (#.Cons _)
-        (..end (..down forward))))))
-
-(def: #export (set value zipper)
-  (All [a] (-> a (Zipper a) (Zipper a)))
-  (set@ [#node #//.value] value zipper))
-
-(def: #export (update f zipper)
-  (All [a] (-> (-> a a) (Zipper a) (Zipper a)))
-  (update@ [#node #//.value] f zipper))
-
-(def: #export (prepend-child value zipper)
-  (All [a] (-> a (Zipper a) (Zipper a)))
-  (update@ [#node #//.children]
-           (function (_ children)
-             ## TODO: Remove once new-luxc becomes the standard compiler.
-             (list& (: (Tree ($ 0))
-                       (//.tree [value {}]))
-                    children)
-             ## (list& (//.tree [value {}])
-             ##        children)
-             )
-           zipper))
-
-(def: #export (append-child value zipper)
-  (All [a] (-> a (Zipper a) (Zipper a)))
-  (update@ [#node #//.children]
-           (function (_ children)
-             (list@compose children
-                           ## TODO: Remove once new-luxc becomes the standard compiler.
-                           (list (: (Tree ($ 0))
-                                    (//.tree [value {}])))
-                           ## (list (//.tree [value {}]))
-                           ))
-           zipper))
-
-(def: #export (remove zipper)
-  (All [a] (-> (Zipper a) (Maybe (Zipper a))))
-  (case (get@ #lefts zipper)
-    #.Nil
-    (case (get@ #parent zipper)
-      #.None
-      #.None
-
-      (#.Some next)
-      (#.Some (|> next
-                  (update@ [#node #//.children] (|>> list.tail (maybe.default (list)))))))
-
-    (#.Cons next side)
-    (#.Some (|> zipper
-                (set@ #lefts side)
-                (set@ #node next)))))
-
-(template [<name> <side>]
-  [(def: #export (<name> value zipper)
-     (All [a] (-> a (Zipper a) (Maybe (Zipper a))))
-     (case (get@ #parent zipper)
-       #.None
-       #.None
-
-       _
-       (#.Some (|> zipper
-                   (update@ <side> (function (_ side)
-                                     ## TODO: Remove once new-luxc becomes the standard compiler.
-                                     (#.Cons (: (Tree ($ 0))
-                                                (//.tree [value {}]))
-                                             side)
-                                     ## (#.Cons (//.tree [value {}])
-                                     ##         side)
-                                     ))))))]
-
-  [insert-left  #lefts]
-  [insert-right #rights]
-  )
-
-(structure: #export functor (Functor Zipper)
-  (def: (map f fa)
-    {#parent (|> fa (get@ #parent) (maybe@map (map f)))
-     #lefts (|> fa (get@ #lefts) (list@map (//@map f)))
-     #rights (|> fa (get@ #rights) (list@map (//@map f)))
-     #node (//@map f (get@ #node fa))}))
-
-## TODO: Add again once new-luxc becomes the standard compiler.
-## (structure: #export comonad (CoMonad Zipper)
-##   (def: &functor ..functor)
-
-##   (def: unwrap (get@ [#node #//.value]))
-
-##   (def: (split wa)
-##     (let [tree-splitter (function (tree-splitter tree)
-##                           {#//.value (zip tree)
-##                            #//.children (list@map tree-splitter
-##                                                  (get@ #//.children tree))})]
-##       {#parent (|> wa (get@ #parent) (maybe@map split))
-##        #lefts (|> wa (get@ #lefts) (list@map tree-splitter))
-##        #rights (|> wa (get@ #rights) (list@map tree-splitter))
-##        #node (|> fa (get@ #node) tree-splitter)})))
diff --git a/stdlib/source/lux/data/collection/tree/zipper.lux b/stdlib/source/lux/data/collection/tree/zipper.lux
new file mode 100644
index 000000000..bac8961e3
--- /dev/null
+++ b/stdlib/source/lux/data/collection/tree/zipper.lux
@@ -0,0 +1,285 @@
+(.module:
+  [lux #*
+   [abstract
+    functor
+    comonad
+    [equivalence (#+ Equivalence)]]
+   [data
+    ["." maybe ("#@." monad)]
+    [collection
+     ["." list ("#@." functor fold monoid)]
+     ["." stack (#+ Stack)]]]
+   ["." macro
+    ["." code]
+    ["s" syntax (#+ Syntax syntax:)]]]
+  ["." // (#+ Tree) ("#@." functor)])
+
+(type: #export (Zipper a)
+  {#.doc "Tree zippers, for easy navigation and editing over trees."}
+  {#parent (Maybe (Zipper a))
+   #lefts (Stack (Tree a))
+   #rights (Stack (Tree a))
+   #node (Tree a)})
+
+(structure: #export (equivalence ,equivalence)
+  (All [a]
+    (-> (Equivalence a)
+        (Equivalence (Zipper a))))
+  (def: (= reference sample)
+    (and (:: (//.equivalence ,equivalence) =
+             (get@ #node reference)
+             (get@ #node sample))
+         (:: (stack.equivalence (//.equivalence ,equivalence)) =
+             (get@ #lefts reference)
+             (get@ #lefts sample))
+         (:: (stack.equivalence (//.equivalence ,equivalence)) =
+             (get@ #rights reference)
+             (get@ #rights sample))
+         (:: (maybe.equivalence (equivalence ,equivalence)) =
+             (get@ #parent reference)
+             (get@ #parent sample))
+         )))
+
+(def: #export (zip tree)
+  (All [a] (-> (Tree a) (Zipper a)))
+  {#parent #.None
+   #lefts stack.empty
+   #rights stack.empty
+   #node tree})
+
+(def: #export (unzip zipper)
+  (All [a] (-> (Zipper a) (Tree a)))
+  (get@ #node zipper))
+
+(def: #export (value zipper)
+  (All [a] (-> (Zipper a) a))
+  (|> zipper (get@ [#node #//.value])))
+
+(def: #export (children zipper)
+  (All [a] (-> (Zipper a) (List (Tree a))))
+  (|> zipper (get@ [#node #//.children])))
+
+(def: #export (branch? zipper)
+  (All [a] (-> (Zipper a) Bit))
+  (|> zipper children list.empty? not))
+
+(def: #export (leaf? zipper)
+  (All [a] (-> (Zipper a) Bit))
+  (|> zipper branch? not))
+
+(def: #export (start? zipper)
+  (All [a] (-> (Zipper a) Bit))
+  (case (get@ #parent zipper)
+    #.None
+    #1
+
+    _
+    #0))
+
+(def: #export (down zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (case (children zipper)
+    #.Nil
+    zipper
+
+    (#.Cons head tail)
+    {#parent (#.Some zipper)
+     #lefts stack.empty
+     #rights tail
+     #node head}))
+
+(def: #export (up zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (case (get@ #parent zipper)
+    #.None
+    zipper
+
+    (#.Some parent)
+    (|> parent
+        ## TODO: Remove once new-luxc becomes the standard compiler.
+        (update@ #node (: (-> (Tree ($ 0)) (Tree ($ 0)))
+                          (function (_ node)
+                            (set@ #//.children (list@compose (list.reverse (get@ #lefts zipper))
+                                                             (#.Cons (get@ #node zipper)
+                                                                     (get@ #rights zipper)))
+                                  node))))
+        ## (update@ #node (function (_ node)
+        ##                  (set@ #//.children (list@compose (list.reverse (get@ #lefts zipper))
+        ##                                                     (#.Cons (get@ #node zipper)
+        ##                                                             (get@ #rights zipper)))
+        ##                        node)))
+        )))
+
+(def: #export (start zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (let [ancestor (..up zipper)]
+    (if (is? zipper ancestor)
+      zipper
+      (start ancestor))))
+
+(template [<one> <all> <side> <op-side>]
+  [(def: #export (<one> zipper)
+     (All [a] (-> (Zipper a) (Zipper a)))
+     (case (get@ <side> zipper)
+       #.Nil
+       zipper
+
+       (#.Cons next side')
+       (|> zipper
+           (update@ <op-side> (function (_ op-side)
+                                (#.Cons (get@ #node zipper) op-side)))
+           (set@ <side> side')
+           (set@ #node next))))
+
+   (def: #export (<all> zipper)
+     (All [a] (-> (Zipper a) (Zipper a)))
+     (case (list.reverse (get@ <side> zipper))
+       #.Nil
+       zipper
+
+       (#.Cons last prevs)
+       (|> zipper
+           (set@ <side> #.Nil)
+           (set@ <op-side> (|> (get@ <op-side> zipper)
+                               (#.Cons (get@ #node zipper))
+                               (list@compose prevs)))
+           (set@ #node last))))]
+
+  [right rightmost #rights #lefts]
+  [left  leftmost  #lefts  #rights]
+  )
+
+(def: #export (next zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (let [forward (..down zipper)]
+    (if (is? zipper forward)
+      (loop [zipper zipper]
+        (let [jump (..right zipper)]
+          (if (is? zipper jump)
+            (let [backward (..up zipper)]
+              (if (is? zipper backward)
+                zipper
+                (recur backward)))
+            jump)))
+      forward)))
+
+(def: #export (end zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (case (get@ #rights zipper)
+    #.Nil
+    (case (get@ [#node #//.children] zipper)
+      #.Nil
+      zipper
+      
+      (#.Cons _)
+      (end (..down zipper)))
+    
+    (#.Cons _)
+    (end (..rightmost zipper))))
+
+(def: #export (prev zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (let [forward (..left zipper)]
+    (if (is? zipper forward)
+      (..up zipper)
+      (case (get@ [#node #//.children] forward)
+        #.Nil
+        forward
+        
+        (#.Cons _)
+        (..end (..down forward))))))
+
+(def: #export (set value zipper)
+  (All [a] (-> a (Zipper a) (Zipper a)))
+  (set@ [#node #//.value] value zipper))
+
+(def: #export (update f zipper)
+  (All [a] (-> (-> a a) (Zipper a) (Zipper a)))
+  (update@ [#node #//.value] f zipper))
+
+(def: #export (prepend-child value zipper)
+  (All [a] (-> a (Zipper a) (Zipper a)))
+  (update@ [#node #//.children]
+           (function (_ children)
+             ## TODO: Remove once new-luxc becomes the standard compiler.
+             (list& (: (Tree ($ 0))
+                       (//.tree [value {}]))
+                    children)
+             ## (list& (//.tree [value {}])
+             ##        children)
+             )
+           zipper))
+
+(def: #export (append-child value zipper)
+  (All [a] (-> a (Zipper a) (Zipper a)))
+  (update@ [#node #//.children]
+           (function (_ children)
+             (list@compose children
+                           ## TODO: Remove once new-luxc becomes the standard compiler.
+                           (list (: (Tree ($ 0))
+                                    (//.tree [value {}])))
+                           ## (list (//.tree [value {}]))
+                           ))
+           zipper))
+
+(def: #export (remove zipper)
+  (All [a] (-> (Zipper a) (Maybe (Zipper a))))
+  (case (get@ #lefts zipper)
+    #.Nil
+    (case (get@ #parent zipper)
+      #.None
+      #.None
+
+      (#.Some next)
+      (#.Some (|> next
+                  (update@ [#node #//.children] (|>> list.tail (maybe.default (list)))))))
+
+    (#.Cons next side)
+    (#.Some (|> zipper
+                (set@ #lefts side)
+                (set@ #node next)))))
+
+(template [<name> <side>]
+  [(def: #export (<name> value zipper)
+     (All [a] (-> a (Zipper a) (Maybe (Zipper a))))
+     (case (get@ #parent zipper)
+       #.None
+       #.None
+
+       _
+       (#.Some (|> zipper
+                   (update@ <side> (function (_ side)
+                                     ## TODO: Remove once new-luxc becomes the standard compiler.
+                                     (#.Cons (: (Tree ($ 0))
+                                                (//.tree [value {}]))
+                                             side)
+                                     ## (#.Cons (//.tree [value {}])
+                                     ##         side)
+                                     ))))))]
+
+  [insert-left  #lefts]
+  [insert-right #rights]
+  )
+
+(structure: #export functor (Functor Zipper)
+  (def: (map f fa)
+    {#parent (|> fa (get@ #parent) (maybe@map (map f)))
+     #lefts (|> fa (get@ #lefts) (list@map (//@map f)))
+     #rights (|> fa (get@ #rights) (list@map (//@map f)))
+     #node (//@map f (get@ #node fa))}))
+
+## TODO: Add again once new-luxc becomes the standard compiler.
+## (structure: #export comonad (CoMonad Zipper)
+##   (def: &functor ..functor)
+
+##   (def: unwrap (get@ [#node #//.value]))
+
+##   (def: (split wa)
+##     (let [tree-splitter (function (tree-splitter tree)
+##                           {#//.value (zip tree)
+##                            #//.children (list@map tree-splitter
+##                                                  (get@ #//.children tree))})]
+##       {#parent (|> wa (get@ #parent) (maybe@map split))
+##        #lefts (|> wa (get@ #lefts) (list@map tree-splitter))
+##        #rights (|> wa (get@ #rights) (list@map tree-splitter))
+##        #node (|> fa (get@ #node) tree-splitter)})))
diff --git a/stdlib/source/lux/macro/poly/equivalence.lux b/stdlib/source/lux/macro/poly/equivalence.lux
index 50dabcd16..b9bb1f335 100644
--- a/stdlib/source/lux/macro/poly/equivalence.lux
+++ b/stdlib/source/lux/macro/poly/equivalence.lux
@@ -24,8 +24,7 @@
      ["." queue]
      ["." set]
      ["." dictionary (#+ Dictionary)]
-     [tree
-      ["." rose]]]]
+     ["." tree]]]
    [time
     ["." duration]
     ["." date]
@@ -77,7 +76,7 @@
                   [array.Array (~! array.equivalence)]
                   [queue.Queue (~! queue.equivalence)]
                   [set.Set     (~! set.equivalence)]
-                  [rose.Tree   (~! rose.equivalence)]
+                  [tree.Tree   (~! tree.equivalence)]
                   ))
             (do @
               [[_ _ valC] (<type>.apply ($_ p.and
diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux
index ad86d3225..0d6cb1e64 100644
--- a/stdlib/source/test/lux/data/collection.lux
+++ b/stdlib/source/test/lux/data/collection.lux
@@ -14,9 +14,8 @@
     ["#/." priority]]
    ["#." set
     ["#/." ordered]]
-   ["#." tree #_
-    ["#/." rose
-     ["#/." zipper]]]])
+   ["#." tree
+    ["#/." zipper]]])
 
 (def: dictionary
   Test
@@ -42,8 +41,8 @@
 (def: tree
   Test
   ($_ _.and
-      /tree/rose.test
-      /tree/rose/zipper.test
+      /tree.test
+      /tree/zipper.test
       ))
 
 (def: #export test
diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux
new file mode 100644
index 000000000..65b46e382
--- /dev/null
+++ b/stdlib/source/test/lux/data/collection/tree.lux
@@ -0,0 +1,63 @@
+(.module:
+  [lux #*
+   data/text/format
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #test]
+     [/
+      ["$." equivalence]
+      ["$." fold]
+      ["$." functor]]}]
+   [data
+    [number
+     ["." nat]]
+    [collection
+     ["." list ("#@." functor fold)]]]
+   [math
+    ["r" random (#+ Random)]]]
+  {1
+   ["." / (#+ Tree)]})
+
+(def: #export (tree size gen-value)
+  (All [a] (-> Nat (Random a) (Random (Tree a))))
+  (let [singleton (:: r.monad map /.leaf gen-value)]
+    (case size
+      0
+      singleton
+      
+      1
+      singleton
+
+      2
+      (do r.monad
+        [value gen-value
+         single (tree 1 gen-value)]
+        (wrap (/.branch value (list single))))
+      
+      _
+      (do r.monad
+        [value gen-value
+         #let [size (dec size)]
+         left (tree (n// 2 size) gen-value)
+         right (tree (n/+ (n/% 2 size) (n// 2 size))
+                     gen-value)]
+        (wrap (/.branch value (list left right))))
+      )))
+
+(def: #export test
+  Test
+  (<| (_.context (%name (name-of /.Tree)))
+      (do r.monad
+        [size (:: @ map (|>> (n/% 100) (n/+ 1)) r.nat)]
+        ($_ _.and
+            ($equivalence.spec (/.equivalence nat.equivalence) (..tree size r.nat))
+            ($fold.spec /.leaf /.equivalence /.fold)
+            ($functor.spec /.leaf /.equivalence /.functor)
+            
+            (do @
+              [sample (..tree size r.nat)]
+              (_.test "Can flatten a tree to get all the nodes as a flat tree."
+                      (n/= size
+                           (list.size (/.flatten sample)))))
+            ))))
diff --git a/stdlib/source/test/lux/data/collection/tree/rose.lux b/stdlib/source/test/lux/data/collection/tree/rose.lux
deleted file mode 100644
index 65b46e382..000000000
--- a/stdlib/source/test/lux/data/collection/tree/rose.lux
+++ /dev/null
@@ -1,63 +0,0 @@
-(.module:
-  [lux #*
-   data/text/format
-   ["_" test (#+ Test)]
-   [abstract
-    [monad (#+ do)]
-    {[0 #test]
-     [/
-      ["$." equivalence]
-      ["$." fold]
-      ["$." functor]]}]
-   [data
-    [number
-     ["." nat]]
-    [collection
-     ["." list ("#@." functor fold)]]]
-   [math
-    ["r" random (#+ Random)]]]
-  {1
-   ["." / (#+ Tree)]})
-
-(def: #export (tree size gen-value)
-  (All [a] (-> Nat (Random a) (Random (Tree a))))
-  (let [singleton (:: r.monad map /.leaf gen-value)]
-    (case size
-      0
-      singleton
-      
-      1
-      singleton
-
-      2
-      (do r.monad
-        [value gen-value
-         single (tree 1 gen-value)]
-        (wrap (/.branch value (list single))))
-      
-      _
-      (do r.monad
-        [value gen-value
-         #let [size (dec size)]
-         left (tree (n// 2 size) gen-value)
-         right (tree (n/+ (n/% 2 size) (n// 2 size))
-                     gen-value)]
-        (wrap (/.branch value (list left right))))
-      )))
-
-(def: #export test
-  Test
-  (<| (_.context (%name (name-of /.Tree)))
-      (do r.monad
-        [size (:: @ map (|>> (n/% 100) (n/+ 1)) r.nat)]
-        ($_ _.and
-            ($equivalence.spec (/.equivalence nat.equivalence) (..tree size r.nat))
-            ($fold.spec /.leaf /.equivalence /.fold)
-            ($functor.spec /.leaf /.equivalence /.functor)
-            
-            (do @
-              [sample (..tree size r.nat)]
-              (_.test "Can flatten a tree to get all the nodes as a flat tree."
-                      (n/= size
-                           (list.size (/.flatten sample)))))
-            ))))
diff --git a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux b/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
deleted file mode 100644
index e8f59a43a..000000000
--- a/stdlib/source/test/lux/data/collection/tree/rose/zipper.lux
+++ /dev/null
@@ -1,116 +0,0 @@
-(.module:
-  [lux #*
-   data/text/format
-   ["_" test (#+ Test)]
-   [abstract/monad (#+ do Monad)]
-   [control
-    pipe]
-   [data
-    ["." maybe]
-    ["." text]
-    [number
-     ["." nat]]
-    [collection
-     ["." list]
-     [tree
-      ["." rose]]]]
-   [math
-    ["r" random]]]
-  ["." //]
-  {1
-   ["." / (#+ Zipper)]}
-  )
-
-(def: #export test
-  Test
-  (<| (_.context (%name (name-of /.Zipper)))
-      (do r.monad
-        [size (:: @ map (|>> (n/% 90) (n/+ 10)) r.nat)
-         sample (//.tree size r.nat)
-         mid-val r.nat
-         new-val r.nat
-         pre-val r.nat
-         post-val r.nat
-         #let [(^open "tree@.") (rose.equivalence nat.equivalence)
-               (^open "list@.") (list.equivalence nat.equivalence)]]
-        ($_ _.and
-            (_.test "Trees can be converted to/from zippers."
-                    (|> sample
-                        /.zip /.unzip
-                        (tree@= sample)))
-            (_.test "Creating a zipper gives you a start node."
-                    (|> sample /.zip /.start?))
-            (_.test "Can move down inside branches. Can move up from lower nodes."
-                    (let [zipper (/.zip sample)]
-                      (if (/.branch? zipper)
-                        (let [child (|> zipper /.down)]
-                          (and (not (tree@= sample (/.unzip child)))
-                               (|> child /.up (is? zipper) not)
-                               (|> child /.start (is? zipper) not)))
-                        (and (/.leaf? zipper)
-                             (|> zipper (/.prepend-child new-val) /.branch?)))))
-            (do @
-              [branch-value r.nat
-               #let [zipper (|> (/.zip (rose.branch branch-value (list (rose.leaf mid-val))))
-                                (/.prepend-child pre-val)
-                                (/.append-child post-val))]]
-              (_.test "Can prepend and append children."
-                      (and (and (|> zipper /.down /.value (is? pre-val))
-                                (|> zipper /.down /.right /.left /.value (is? pre-val))
-                                (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val)))
-                           (|> zipper /.down /.right /.value (is? mid-val))
-                           (and (|> zipper /.down /.right /.right /.value (is? post-val))
-                                (|> zipper /.down /.rightmost /.value (is? post-val))))))
-            (do @
-              [branch-value r.nat
-               #let [zipper (/.zip (rose.branch branch-value (list (rose.leaf mid-val))))]]
-              (_.test "Can insert children around a node (unless it's start)."
-                      (and (let [zipper (|> zipper
-                                            /.down
-                                            (/.insert-left pre-val)
-                                            maybe.assume
-                                            (/.insert-right post-val)
-                                            maybe.assume
-                                            /.up)]
-                             (and (|> zipper /.down /.value (is? pre-val))
-                                  (|> zipper /.down /.right /.value (is? mid-val))
-                                  (|> zipper /.down /.right /.right /.value (is? post-val))
-                                  (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
-                                  (|> zipper /.down /.right /.left /.value (is? pre-val))
-                                  (|> zipper /.down /.rightmost /.value (is? post-val))))
-                           (and (|> zipper
-                                    (/.insert-left pre-val)
-                                    (case> (#.Some _) false
-                                           #.None     true))
-                                (|> zipper
-                                    (/.insert-right post-val)
-                                    (case> (#.Some _) false
-                                           #.None     true))))))
-            (_.test "Can set and update the value of a node."
-                    (|> sample /.zip (/.set new-val) /.value (n/= new-val)))
-            (_.test "Zipper traversal follows the outline of the tree depth-first."
-                    (let [root (/.zip sample)]
-                      (list@= (rose.flatten sample)
-                              (loop [zipper (/.start root)]
-                                (let [zipper' (/.next zipper)]
-                                  (#.Cons (/.value zipper)
-                                          (if (:: (/.equivalence nat.equivalence) = root zipper')
-                                            (list)
-                                            (recur zipper'))))))))
-            (_.test "Backwards zipper traversal yield reverse tree flatten."
-                    (let [root (/.zip sample)]
-                      (list@= (list.reverse (rose.flatten sample))
-                              (loop [zipper (/.end root)]
-                                (#.Cons (/.value zipper)
-                                        (if (:: (/.equivalence nat.equivalence) = root zipper)
-                                          (list)
-                                          (recur (/.prev zipper))))))))
-            (_.test "Can remove nodes (except start nodes)."
-                    (let [zipper (/.zip sample)]
-                      (if (/.branch? zipper)
-                        (and (|> zipper /.down /.start? not)
-                             (|> zipper /.down /.remove (case> #.None false
-                                                               (#.Some node) (/.start? node))))
-                        (|> zipper /.remove (case> #.None     true
-                                                   (#.Some _) false)))))
-            ))))
diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux
new file mode 100644
index 000000000..f4b812420
--- /dev/null
+++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux
@@ -0,0 +1,115 @@
+(.module:
+  [lux #*
+   data/text/format
+   ["_" test (#+ Test)]
+   [abstract/monad (#+ do Monad)]
+   [control
+    pipe]
+   [data
+    ["." maybe]
+    ["." text]
+    [number
+     ["." nat]]
+    [collection
+     ["." list]]]
+   [math
+    ["r" random]]]
+  ["." //]
+  {1
+   ["." / (#+ Zipper)
+    ["tree" //]]}
+  )
+
+(def: #export test
+  Test
+  (<| (_.context (%name (name-of /.Zipper)))
+      (do r.monad
+        [size (:: @ map (|>> (n/% 90) (n/+ 10)) r.nat)
+         sample (//.tree size r.nat)
+         mid-val r.nat
+         new-val r.nat
+         pre-val r.nat
+         post-val r.nat
+         #let [(^open "tree@.") (tree.equivalence nat.equivalence)
+               (^open "list@.") (list.equivalence nat.equivalence)]]
+        ($_ _.and
+            (_.test "Trees can be converted to/from zippers."
+                    (|> sample
+                        /.zip /.unzip
+                        (tree@= sample)))
+            (_.test "Creating a zipper gives you a start node."
+                    (|> sample /.zip /.start?))
+            (_.test "Can move down inside branches. Can move up from lower nodes."
+                    (let [zipper (/.zip sample)]
+                      (if (/.branch? zipper)
+                        (let [child (|> zipper /.down)]
+                          (and (not (tree@= sample (/.unzip child)))
+                               (|> child /.up (is? zipper) not)
+                               (|> child /.start (is? zipper) not)))
+                        (and (/.leaf? zipper)
+                             (|> zipper (/.prepend-child new-val) /.branch?)))))
+            (do @
+              [branch-value r.nat
+               #let [zipper (|> (/.zip (tree.branch branch-value (list (tree.leaf mid-val))))
+                                (/.prepend-child pre-val)
+                                (/.append-child post-val))]]
+              (_.test "Can prepend and append children."
+                      (and (and (|> zipper /.down /.value (is? pre-val))
+                                (|> zipper /.down /.right /.left /.value (is? pre-val))
+                                (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val)))
+                           (|> zipper /.down /.right /.value (is? mid-val))
+                           (and (|> zipper /.down /.right /.right /.value (is? post-val))
+                                (|> zipper /.down /.rightmost /.value (is? post-val))))))
+            (do @
+              [branch-value r.nat
+               #let [zipper (/.zip (tree.branch branch-value (list (tree.leaf mid-val))))]]
+              (_.test "Can insert children around a node (unless it's start)."
+                      (and (let [zipper (|> zipper
+                                            /.down
+                                            (/.insert-left pre-val)
+                                            maybe.assume
+                                            (/.insert-right post-val)
+                                            maybe.assume
+                                            /.up)]
+                             (and (|> zipper /.down /.value (is? pre-val))
+                                  (|> zipper /.down /.right /.value (is? mid-val))
+                                  (|> zipper /.down /.right /.right /.value (is? post-val))
+                                  (|> zipper /.down /.rightmost /.leftmost /.value (is? pre-val))
+                                  (|> zipper /.down /.right /.left /.value (is? pre-val))
+                                  (|> zipper /.down /.rightmost /.value (is? post-val))))
+                           (and (|> zipper
+                                    (/.insert-left pre-val)
+                                    (case> (#.Some _) false
+                                           #.None     true))
+                                (|> zipper
+                                    (/.insert-right post-val)
+                                    (case> (#.Some _) false
+                                           #.None     true))))))
+            (_.test "Can set and update the value of a node."
+                    (|> sample /.zip (/.set new-val) /.value (n/= new-val)))
+            (_.test "Zipper traversal follows the outline of the tree depth-first."
+                    (let [root (/.zip sample)]
+                      (list@= (tree.flatten sample)
+                              (loop [zipper (/.start root)]
+                                (let [zipper' (/.next zipper)]
+                                  (#.Cons (/.value zipper)
+                                          (if (:: (/.equivalence nat.equivalence) = root zipper')
+                                            (list)
+                                            (recur zipper'))))))))
+            (_.test "Backwards zipper traversal yield reverse tree flatten."
+                    (let [root (/.zip sample)]
+                      (list@= (list.reverse (tree.flatten sample))
+                              (loop [zipper (/.end root)]
+                                (#.Cons (/.value zipper)
+                                        (if (:: (/.equivalence nat.equivalence) = root zipper)
+                                          (list)
+                                          (recur (/.prev zipper))))))))
+            (_.test "Can remove nodes (except start nodes)."
+                    (let [zipper (/.zip sample)]
+                      (if (/.branch? zipper)
+                        (and (|> zipper /.down /.start? not)
+                             (|> zipper /.down /.remove (case> #.None false
+                                                               (#.Some node) (/.start? node))))
+                        (|> zipper /.remove (case> #.None     true
+                                                   (#.Some _) false)))))
+            ))))
-- 
cgit v1.2.3