From 9906f649d26adfed5126065082fb4a7d5e4696bb Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 1 May 2018 22:13:07 -0400
Subject: - Re-organized "lux/data/coll/tree/*" modules.

---
 stdlib/source/lux/data/coll/tree/parser.lux      |  50 -----
 stdlib/source/lux/data/coll/tree/rose/parser.lux |  50 +++++
 stdlib/source/lux/data/coll/tree/rose/zipper.lux | 235 +++++++++++++++++++++++
 stdlib/source/lux/data/coll/tree/zipper.lux      | 235 -----------------------
 4 files changed, 285 insertions(+), 285 deletions(-)
 delete mode 100644 stdlib/source/lux/data/coll/tree/parser.lux
 create mode 100644 stdlib/source/lux/data/coll/tree/rose/parser.lux
 create mode 100644 stdlib/source/lux/data/coll/tree/rose/zipper.lux
 delete mode 100644 stdlib/source/lux/data/coll/tree/zipper.lux

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/data/coll/tree/parser.lux b/stdlib/source/lux/data/coll/tree/parser.lux
deleted file mode 100644
index e5881d097..000000000
--- a/stdlib/source/lux/data/coll/tree/parser.lux
+++ /dev/null
@@ -1,50 +0,0 @@
-(.module:
-  lux
-  (lux (control ["p" parser]
-                ["ex" exception #+ exception:])
-       (data ["E" error]))
-  (// ["T" rose]
-      ["Z" zipper]))
-
-(type: #export (Parser t a)
-  (p.Parser (Z.Zipper t) a))
-
-(def: #export (run-zipper zipper parser)
-  (All [t a] (-> (Z.Zipper t) (Parser t a) (E.Error a)))
-  (case (p.run zipper parser)
-    (#E.Success [zipper output])
-    (#E.Success output)
-
-    (#E.Error error)
-    (#E.Error error)))
-
-(def: #export (run tree parser)
-  (All [t a] (-> (T.Tree t) (Parser t a) (E.Error a)))
-  (run-zipper (Z.zip tree) parser))
-
-(def: #export value
-  (All [t] (Parser t t))
-  (function (_ zipper)
-    (#E.Success [zipper (Z.value zipper)])))
-
-(exception: #export Cannot-Move-Further)
-
-(do-template [<name> <direction>]
-  [(def: #export <name>
-     (All [t] (Parser t []))
-     (function (_ zipper)
-       (let [next (<direction> zipper)]
-         (if (is? zipper next)
-           (ex.throw Cannot-Move-Further [])
-           (#E.Success [next []])))))]
-
-  [up        Z.up]
-  [down      Z.down]
-  [left      Z.left]
-  [right     Z.right]
-  [root      Z.root]
-  [rightmost Z.rightmost]
-  [leftmost  Z.leftmost]
-  [next      Z.next]
-  [prev      Z.prev]
-  )
diff --git a/stdlib/source/lux/data/coll/tree/rose/parser.lux b/stdlib/source/lux/data/coll/tree/rose/parser.lux
new file mode 100644
index 000000000..bee1e07f9
--- /dev/null
+++ b/stdlib/source/lux/data/coll/tree/rose/parser.lux
@@ -0,0 +1,50 @@
+(.module:
+  lux
+  (lux (control ["p" parser]
+                ["ex" exception #+ exception:])
+       (data ["E" error]))
+  [// #+ Tree]
+  (// [zipper #+ Zipper]))
+
+(type: #export (Parser t a)
+  (p.Parser (Zipper t) a))
+
+(def: #export (run-zipper zipper parser)
+  (All [t a] (-> (Zipper t) (Parser t a) (E.Error a)))
+  (case (p.run zipper parser)
+    (#E.Success [zipper output])
+    (#E.Success output)
+
+    (#E.Error error)
+    (#E.Error error)))
+
+(def: #export (run tree parser)
+  (All [t a] (-> (Tree t) (Parser t a) (E.Error a)))
+  (run-zipper (zipper.zip tree) parser))
+
+(def: #export value
+  (All [t] (Parser t t))
+  (function (_ zipper)
+    (#E.Success [zipper (zipper.value zipper)])))
+
+(exception: #export Cannot-Move-Further)
+
+(do-template [<name> <direction>]
+  [(def: #export <name>
+     (All [t] (Parser t []))
+     (function (_ zipper)
+       (let [next (<direction> zipper)]
+         (if (is? zipper next)
+           (ex.throw Cannot-Move-Further [])
+           (#E.Success [next []])))))]
+
+  [up        zipper.up]
+  [down      zipper.down]
+  [left      zipper.left]
+  [right     zipper.right]
+  [root      zipper.root]
+  [rightmost zipper.rightmost]
+  [leftmost  zipper.leftmost]
+  [next      zipper.next]
+  [prev      zipper.prev]
+  )
diff --git a/stdlib/source/lux/data/coll/tree/rose/zipper.lux b/stdlib/source/lux/data/coll/tree/rose/zipper.lux
new file mode 100644
index 000000000..845dd4c4c
--- /dev/null
+++ b/stdlib/source/lux/data/coll/tree/rose/zipper.lux
@@ -0,0 +1,235 @@
+(.module:
+  lux
+  (lux (control functor
+                comonad)
+       (data (coll [list "L/" Monad<List> Fold<List> Monoid<List>]
+                   (tree [rose #+ Tree "T/" Functor<Tree>])
+                   [stack #+ Stack])
+             [maybe "M/" Monad<Maybe>])
+       [macro]
+       (macro [code]
+              ["s" syntax #+ syntax: Syntax])))
+
+## Adapted from the clojure.zip namespace in the Clojure standard library.
+
+## [Types]
+(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)})
+
+## [Values]
+(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 #rose.value])))
+
+(def: #export (children zipper)
+  (All [a] (-> (Zipper a) (List (Tree a))))
+  (|> zipper (get@ [#node #rose.children])))
+
+(def: #export (branch? zipper)
+  (All [a] (-> (Zipper a) Bool))
+  (|> zipper children list.empty? not))
+
+(def: #export (leaf? zipper)
+  (All [a] (-> (Zipper a) Bool))
+  (|> zipper branch? not))
+
+(def: #export (end? zipper)
+  (All [a] (-> (Zipper a) Bool))
+  (and (list.empty? (get@ #rights zipper))
+       (list.empty? (children zipper))))
+
+(def: #export (root? zipper)
+  (All [a] (-> (Zipper a) Bool))
+  (case (get@ #parent zipper)
+    #.None
+    true
+
+    _
+    false))
+
+(def: #export (down zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (case (children zipper)
+    #.Nil
+    zipper
+
+    (#.Cons chead ctail)
+    {#parent (#.Some zipper)
+     #lefts stack.empty
+     #rights ctail
+     #node chead}))
+
+(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@ #rose.children (L/compose (list.reverse (get@ #lefts zipper))
+                                                            (#.Cons (get@ #node zipper)
+                                                                    (get@ #rights zipper)))
+                                  node))))
+        ## (update@ #node (function (_ node)
+        ##                  (set@ #rose.children (L/compose (list.reverse (get@ #lefts zipper))
+        ##                                                  (#.Cons (get@ #node zipper)
+        ##                                                          (get@ #rights zipper)))
+        ##                        node)))
+        )))
+
+(def: #export (root zipper)
+  (All [a] (-> (Zipper a) (Zipper a)))
+  (loop [zipper zipper]
+    (case (get@ #parent zipper)
+      #.None     zipper
+      (#.Some _) (recur (up zipper)))))
+
+(do-template [<one-name> <all-name> <side> <op-side>]
+  [(def: #export (<one-name> 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-name> zipper)
+     (All [a] (-> (Zipper a) (Zipper a)))
+     (L/fold (function (_ _) <one-name>) zipper (get@ <side> zipper)))]
+
+  [right rightmost #rights #lefts]
+  [left  leftmost  #lefts  #rights]
+  )
+
+(do-template [<name> <h-side> <h-op> <v-op>]
+  [(def: #export (<name> zipper)
+     (All [a] (-> (Zipper a) (Zipper a)))
+     (case (get@ <h-side> zipper)
+       #.Nil
+       (<v-op> zipper)
+
+       _
+       (<h-op> zipper)))]
+
+  [next #rights right down]
+  [prev #lefts  left up]
+  )
+
+(def: #export (set value zipper)
+  (All [a] (-> a (Zipper a) (Zipper a)))
+  (set@ [#node #rose.value] value zipper))
+
+(def: #export (update f zipper)
+  (All [a] (-> (-> a a) (Zipper a) (Zipper a)))
+  (update@ [#node #rose.value] f zipper))
+
+(def: #export (prepend-child value zipper)
+  (All [a] (-> a (Zipper a) (Zipper a)))
+  (update@ [#node #rose.children]
+           (function (_ children)
+             ## TODO: Remove once new-luxc becomes the standard compiler.
+             (list& (: (Tree ($ +0))
+                       (rose.tree [value {}]))
+                    children)
+             ## (list& (rose.tree [value {}])
+             ##        children)
+             )
+           zipper))
+
+(def: #export (append-child value zipper)
+  (All [a] (-> a (Zipper a) (Zipper a)))
+  (update@ [#node #rose.children]
+           (function (_ children)
+             (L/compose children
+                        ## TODO: Remove once new-luxc becomes the standard compiler.
+                        (list (: (Tree ($ +0))
+                                 (rose.tree [value {}])))
+                        ## (list (rose.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 #rose.children] (|>> list.tail (maybe.default (list)))))))
+
+    (#.Cons next side)
+    (#.Some (|> zipper
+                (set@ #lefts side)
+                (set@ #node next)))))
+
+(do-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))
+                                                (rose.tree [value {}]))
+                                             side)
+                                     ## (#.Cons (rose.tree [value {}])
+                                     ##         side)
+                                     ))))))]
+
+  [insert-left  #lefts]
+  [insert-right #rights]
+  )
+
+(struct: #export _ (Functor Zipper)
+  (def: (map f fa)
+    {#parent (|> fa (get@ #parent) (M/map (map f)))
+     #lefts (|> fa (get@ #lefts) (L/map (T/map f)))
+     #rights (|> fa (get@ #rights) (L/map (T/map f)))
+     #node (T/map f (get@ #node fa))}))
+
+## TODO: Add again once new-luxc becomes the standard compiler.
+## (struct: #export _ (CoMonad Zipper)
+##   (def: functor Functor<Zipper>)
+
+##   (def: unwrap (get@ [#node #rose.value]))
+
+##   (def: (split wa)
+##     (let [tree-splitter (function (tree-splitter tree)
+##                           {#rose.value (zip tree)
+##                            #rose.children (L/map tree-splitter
+##                                                  (get@ #rose.children tree))})]
+##       {#parent (|> wa (get@ #parent) (M/map split))
+##        #lefts (|> wa (get@ #lefts) (L/map tree-splitter))
+##        #rights (|> wa (get@ #rights) (L/map tree-splitter))
+##        #node (|> fa (get@ #node) tree-splitter)})))
diff --git a/stdlib/source/lux/data/coll/tree/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux
deleted file mode 100644
index 845dd4c4c..000000000
--- a/stdlib/source/lux/data/coll/tree/zipper.lux
+++ /dev/null
@@ -1,235 +0,0 @@
-(.module:
-  lux
-  (lux (control functor
-                comonad)
-       (data (coll [list "L/" Monad<List> Fold<List> Monoid<List>]
-                   (tree [rose #+ Tree "T/" Functor<Tree>])
-                   [stack #+ Stack])
-             [maybe "M/" Monad<Maybe>])
-       [macro]
-       (macro [code]
-              ["s" syntax #+ syntax: Syntax])))
-
-## Adapted from the clojure.zip namespace in the Clojure standard library.
-
-## [Types]
-(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)})
-
-## [Values]
-(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 #rose.value])))
-
-(def: #export (children zipper)
-  (All [a] (-> (Zipper a) (List (Tree a))))
-  (|> zipper (get@ [#node #rose.children])))
-
-(def: #export (branch? zipper)
-  (All [a] (-> (Zipper a) Bool))
-  (|> zipper children list.empty? not))
-
-(def: #export (leaf? zipper)
-  (All [a] (-> (Zipper a) Bool))
-  (|> zipper branch? not))
-
-(def: #export (end? zipper)
-  (All [a] (-> (Zipper a) Bool))
-  (and (list.empty? (get@ #rights zipper))
-       (list.empty? (children zipper))))
-
-(def: #export (root? zipper)
-  (All [a] (-> (Zipper a) Bool))
-  (case (get@ #parent zipper)
-    #.None
-    true
-
-    _
-    false))
-
-(def: #export (down zipper)
-  (All [a] (-> (Zipper a) (Zipper a)))
-  (case (children zipper)
-    #.Nil
-    zipper
-
-    (#.Cons chead ctail)
-    {#parent (#.Some zipper)
-     #lefts stack.empty
-     #rights ctail
-     #node chead}))
-
-(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@ #rose.children (L/compose (list.reverse (get@ #lefts zipper))
-                                                            (#.Cons (get@ #node zipper)
-                                                                    (get@ #rights zipper)))
-                                  node))))
-        ## (update@ #node (function (_ node)
-        ##                  (set@ #rose.children (L/compose (list.reverse (get@ #lefts zipper))
-        ##                                                  (#.Cons (get@ #node zipper)
-        ##                                                          (get@ #rights zipper)))
-        ##                        node)))
-        )))
-
-(def: #export (root zipper)
-  (All [a] (-> (Zipper a) (Zipper a)))
-  (loop [zipper zipper]
-    (case (get@ #parent zipper)
-      #.None     zipper
-      (#.Some _) (recur (up zipper)))))
-
-(do-template [<one-name> <all-name> <side> <op-side>]
-  [(def: #export (<one-name> 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-name> zipper)
-     (All [a] (-> (Zipper a) (Zipper a)))
-     (L/fold (function (_ _) <one-name>) zipper (get@ <side> zipper)))]
-
-  [right rightmost #rights #lefts]
-  [left  leftmost  #lefts  #rights]
-  )
-
-(do-template [<name> <h-side> <h-op> <v-op>]
-  [(def: #export (<name> zipper)
-     (All [a] (-> (Zipper a) (Zipper a)))
-     (case (get@ <h-side> zipper)
-       #.Nil
-       (<v-op> zipper)
-
-       _
-       (<h-op> zipper)))]
-
-  [next #rights right down]
-  [prev #lefts  left up]
-  )
-
-(def: #export (set value zipper)
-  (All [a] (-> a (Zipper a) (Zipper a)))
-  (set@ [#node #rose.value] value zipper))
-
-(def: #export (update f zipper)
-  (All [a] (-> (-> a a) (Zipper a) (Zipper a)))
-  (update@ [#node #rose.value] f zipper))
-
-(def: #export (prepend-child value zipper)
-  (All [a] (-> a (Zipper a) (Zipper a)))
-  (update@ [#node #rose.children]
-           (function (_ children)
-             ## TODO: Remove once new-luxc becomes the standard compiler.
-             (list& (: (Tree ($ +0))
-                       (rose.tree [value {}]))
-                    children)
-             ## (list& (rose.tree [value {}])
-             ##        children)
-             )
-           zipper))
-
-(def: #export (append-child value zipper)
-  (All [a] (-> a (Zipper a) (Zipper a)))
-  (update@ [#node #rose.children]
-           (function (_ children)
-             (L/compose children
-                        ## TODO: Remove once new-luxc becomes the standard compiler.
-                        (list (: (Tree ($ +0))
-                                 (rose.tree [value {}])))
-                        ## (list (rose.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 #rose.children] (|>> list.tail (maybe.default (list)))))))
-
-    (#.Cons next side)
-    (#.Some (|> zipper
-                (set@ #lefts side)
-                (set@ #node next)))))
-
-(do-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))
-                                                (rose.tree [value {}]))
-                                             side)
-                                     ## (#.Cons (rose.tree [value {}])
-                                     ##         side)
-                                     ))))))]
-
-  [insert-left  #lefts]
-  [insert-right #rights]
-  )
-
-(struct: #export _ (Functor Zipper)
-  (def: (map f fa)
-    {#parent (|> fa (get@ #parent) (M/map (map f)))
-     #lefts (|> fa (get@ #lefts) (L/map (T/map f)))
-     #rights (|> fa (get@ #rights) (L/map (T/map f)))
-     #node (T/map f (get@ #node fa))}))
-
-## TODO: Add again once new-luxc becomes the standard compiler.
-## (struct: #export _ (CoMonad Zipper)
-##   (def: functor Functor<Zipper>)
-
-##   (def: unwrap (get@ [#node #rose.value]))
-
-##   (def: (split wa)
-##     (let [tree-splitter (function (tree-splitter tree)
-##                           {#rose.value (zip tree)
-##                            #rose.children (L/map tree-splitter
-##                                                  (get@ #rose.children tree))})]
-##       {#parent (|> wa (get@ #parent) (M/map split))
-##        #lefts (|> wa (get@ #lefts) (L/map tree-splitter))
-##        #rights (|> wa (get@ #rights) (L/map tree-splitter))
-##        #node (|> fa (get@ #node) tree-splitter)})))
-- 
cgit v1.2.3