From 402919654d174235512851a9907c54c092df0b7f Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 6 Apr 2017 20:18:36 -0400
Subject: - Made some changes to (rose) trees and zippers.

---
 stdlib/source/lux/data/coll/tree/rose.lux   | 41 ++++++++++++++---------
 stdlib/source/lux/data/coll/tree/zipper.lux | 52 ++++++++++++++++++++++-------
 2 files changed, 65 insertions(+), 28 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/source/lux/data/coll/tree/rose.lux b/stdlib/source/lux/data/coll/tree/rose.lux
index ebd208a83..dc44510d5 100644
--- a/stdlib/source/lux/data/coll/tree/rose.lux
+++ b/stdlib/source/lux/data/coll/tree/rose.lux
@@ -1,8 +1,9 @@
 (;module:
   lux
-  (lux (control monad
+  (lux (control functor
+                monad
                 eq)
-       (data (coll [list "" Monad<List>]))
+       (data (coll [list "L/" Monad<List>]))
        [compiler]
        (macro [ast]
               ["s" syntax #+ syntax: Syntax])))
@@ -16,7 +17,7 @@
 (def: #export (flatten tree)
   (All [a] (-> (Tree a) (List a)))
   (#;Cons (get@ #value tree)
-          (join (map flatten (get@ #children tree)))))
+          (L/join (L/map flatten (get@ #children tree)))))
 
 (def: #export (leaf value)
   (All [a] (-> a (Tree a)))
@@ -32,24 +33,32 @@
 (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)))))
+(def: tree^
+  (Syntax Tree-AST)
+  (|> (|>. s;some s;record (s;seq s;any))
+      s;rec
+      s;some
+      s;record
+      (s;seq s;any)
+      s;tuple))
 
-(syntax: #export (tree type [root (tree^ [])])
+(syntax: #export (tree [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)))}))))))))
+              (tree Int [10 {20 {}
+                             30 {}
+                             40 {}}]))}
+  (wrap (list (` (~ (loop [[value children] root]
+                      (` {#value (~ value)
+                          #children (list (~@ (L/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)))))
+
+(struct: #export _ (Functor Tree)
+  (def: (map f fa)
+    {#value (f (get@ #value fa))
+     #children (L/map (map f)
+                      (get@ #children fa))}))
diff --git a/stdlib/source/lux/data/coll/tree/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux
index 3c443f281..59a4d40ff 100644
--- a/stdlib/source/lux/data/coll/tree/zipper.lux
+++ b/stdlib/source/lux/data/coll/tree/zipper.lux
@@ -1,8 +1,11 @@
 (;module:
   lux
-  (lux (data (coll [list "" Monad<List> Fold<List> "List/" Monoid<List>]
-                   (tree [rose #+ Tree])
-                   [stack #+ Stack]))
+  (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>])
        [compiler]
        (macro [ast]
               ["s" syntax #+ syntax: Syntax])))
@@ -71,9 +74,9 @@
     (|> parent
         (update@ #node (: (-> (Tree ($ +0)) (Tree ($ +0)))
                           (lambda [node]
-                            (set@ #rose;children (List/append (list;reverse (get@ #lefts zipper))
-                                                              (#;Cons (get@ #node zipper)
-                                                                      (get@ #rights zipper)))
+                            (set@ #rose;children (L/append (list;reverse (get@ #lefts zipper))
+                                                           (#;Cons (get@ #node zipper)
+                                                                   (get@ #rights zipper)))
                                   node)))))))
 
 (def: #export (root zipper)
@@ -99,7 +102,7 @@
 
    (def: #export (<all-name> zipper)
      (All [a] (-> (Zipper a) (Zipper a)))
-     (fold (lambda [_] <one-name>) zipper (get@ <side> zipper)))]
+     (L/fold (lambda [_] <one-name>) zipper (get@ <side> zipper)))]
 
   [right rightmost #rights #lefts]
   [left  leftmost  #lefts  #rights]
@@ -117,16 +120,18 @@
   (All [a] (-> a (Zipper a) (Zipper a)))
   (update@ [#node #rose;children]
            (lambda [children]
-             (#;Cons (rose;tree ($ +0) {value []})
-                     children))
+             (list& (: (Tree ($ +0))
+                       (rose;tree [value {}]))
+                    children))
            zipper))
 
 (def: #export (append-child value zipper)
   (All [a] (-> a (Zipper a) (Zipper a)))
   (update@ [#node #rose;children]
            (lambda [children]
-             (List/append children
-                          (list (rose;tree ($ +0) {value []}))))
+             (L/append children
+                       (list (: (Tree ($ +0))
+                                (rose;tree [value {}])))))
            zipper))
 
 (def: #export (remove zipper)
@@ -156,7 +161,8 @@
        _
        (#;Some (|> zipper
                    (update@ <side> (lambda [side]
-                                     (#;Cons (rose;tree ($ +0) {value []})
+                                     (#;Cons (: (Tree ($ +0))
+                                                (rose;tree [value {}]))
                                              side)))))))]
 
   [insert-left  #lefts]
@@ -190,3 +196,25 @@
 
     _
     false))
+
+(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))}))
+
+## (struct: #export _ (CoMonad Zipper)
+##   (def: functor Functor<Zipper>)
+
+##   (def: unwrap (get@ [#node #rose;value]))
+
+##   (def: (split wa)
+##     (let [tree-splitter (lambda tree-splitter [tree]
+##                           {#rose;value (from-tree 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