aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/data/collection/tree/zipper.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/library/lux/data/collection/tree/zipper.lux')
-rw-r--r--stdlib/source/library/lux/data/collection/tree/zipper.lux188
1 files changed, 95 insertions, 93 deletions
diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux
index 60c11d032..767365e6f 100644
--- a/stdlib/source/library/lux/data/collection/tree/zipper.lux
+++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux
@@ -46,7 +46,7 @@
(def: .public (zipper tree)
(All (_ a) (-> (Tree a) (Zipper a)))
- [#family #.None
+ [#family {.#None}
#node tree])
(def: .public tree
@@ -55,19 +55,19 @@
(def: .public value
(All (_ a) (-> (Zipper a) a))
- (value@ [#node #//.value]))
+ (value@ [#node //.#value]))
(def: .public (set value zipper)
(All (_ a) (-> a (Zipper a) (Zipper a)))
- (with@ [#node #//.value] value zipper))
+ (with@ [#node //.#value] value zipper))
(def: .public (update transform zipper)
(All (_ a) (-> (-> a a) (Zipper a) (Zipper a)))
- (revised@ [#node #//.value] transform zipper))
+ (revised@ [#node //.#value] transform zipper))
(def: children
(All (_ a) (-> (Zipper a) (List (Tree a))))
- (value@ [#node #//.children]))
+ (value@ [#node //.#children]))
(def: .public leaf?
(All (_ a) (-> (Zipper a) Bit))
@@ -80,7 +80,7 @@
(def: .public (start? zipper)
(All (_ a) (-> (Zipper a) Bit))
(case (value@ #family zipper)
- #.None
+ {.#None}
true
_
@@ -89,12 +89,12 @@
(def: .public (down zipper)
(All (_ a) (-> (Zipper a) (Maybe (Zipper a))))
(case (..children zipper)
- #.End
- #.None
+ {.#End}
+ {.#None}
- {#.Item head tail}
- {#.Some [#family {#.Some [#parent (with@ [#node #//.children] (list) zipper)
- #lefts #.End
+ {.#Item head tail}
+ {.#Some [#family {.#Some [#parent (with@ [#node //.#children] (list) zipper)
+ #lefts {.#End}
#rights tail]}
#node head]}))
@@ -106,64 +106,64 @@
(for [@.old
(revised@ #node (: (-> (Tree (:parameter 0))
(Tree (:parameter 0)))
- (with@ #//.children (list\composite (list.reversed lefts)
- {#.Item (value@ #node zipper)
- rights})))
- parent)]
- (with@ [#node #//.children]
- (list\composite (list.reversed lefts)
- {#.Item (value@ #node zipper)
- rights})
- parent))))))
+ (with@ //.#children (list\composite (list.reversed #lefts)
+ {.#Item (value@ #node zipper)
+ #rights})))
+ #parent)]
+ (with@ [#node //.#children]
+ (list\composite (list.reversed #lefts)
+ {.#Item (value@ #node zipper)
+ #rights})
+ #parent))))))
(template [<one> <all> <side> <op_side>]
[(def: .public (<one> zipper)
(All (_ a) (-> (Zipper a) (Maybe (Zipper a))))
(case (value@ #family zipper)
- {#.Some family}
+ {.#Some family}
(case (value@ <side> family)
- {#.Item next side'}
- {#.Some (for [@.old
- [#family {#.Some (|> family
+ {.#Item next side'}
+ {.#Some (for [@.old
+ [#family {.#Some (|> family
(with@ <side> side')
- (revised@ <op_side> (|>> {#.Item (value@ #node zipper)})))}
+ (revised@ <op_side> (|>> {.#Item (value@ #node zipper)})))}
#node next]]
(let [move (: (All (_ a) (-> (List (Tree a)) (Zipper a) (Family Zipper a) (Family Zipper a)))
(function (_ side' zipper)
(|>> (with@ <side> side')
- (revised@ <op_side> (|>> {#.Item (value@ #node zipper)})))))]
- [#family {#.Some (move side' zipper family)}
+ (revised@ <op_side> (|>> {.#Item (value@ #node zipper)})))))]
+ [#family {.#Some (move side' zipper family)}
#node next]))}
- #.End
- #.None)
+ {.#End}
+ {.#None})
- #.None
- #.None))
+ {.#None}
+ {.#None}))
(def: .public (<all> zipper)
(All (_ a) (-> (Zipper a) (Maybe (Zipper a))))
(case (value@ #family zipper)
- #.None
- #.None
+ {.#None}
+ {.#None}
- {#.Some family}
+ {.#Some family}
(case (list.reversed (value@ <side> family))
- #.End
- #.None
+ {.#End}
+ {.#None}
- {#.Item last prevs}
- {#.Some (for [@.old [#family {#.Some (|> family
- (with@ <side> #.End)
- (revised@ <op_side> (|>> {#.Item (value@ #node zipper)}
+ {.#Item last prevs}
+ {.#Some (for [@.old [#family {.#Some (|> family
+ (with@ <side> {.#End})
+ (revised@ <op_side> (|>> {.#Item (value@ #node zipper)}
(list\composite prevs))))}
#node last]]
(let [move (: (All (_ a) (-> (List (Tree a)) (Zipper a) (Family Zipper a) (Family Zipper a)))
(function (_ prevs zipper)
- (|>> (with@ <side> #.End)
- (revised@ <op_side> (|>> {#.Item (value@ #node zipper)}
+ (|>> (with@ <side> {.#End})
+ (revised@ <op_side> (|>> {.#Item (value@ #node zipper)}
(list\composite prevs))))))]
- [#family {#.Some (move prevs zipper family)}
+ [#family {.#Some (move prevs zipper family)}
#node last]))})))]
[right rightmost #rights #lefts]
@@ -173,16 +173,16 @@
(def: .public (next zipper)
(All (_ a) (-> (Zipper a) (Maybe (Zipper a))))
(case (..down zipper)
- {#.Some forward}
- {#.Some forward}
+ {.#Some forward}
+ {.#Some forward}
- #.None
+ {.#None}
(loop [@ zipper]
(case (..right @)
- {#.Some forward}
- {#.Some forward}
+ {.#Some forward}
+ {.#Some forward}
- #.None
+ {.#None}
(do maybe.monad
[@ (..up @)]
(recur @))))))
@@ -190,45 +190,45 @@
(def: (bottom zipper)
(All (_ a) (-> (Zipper a) (Zipper a)))
(case (..right zipper)
- {#.Some forward}
+ {.#Some forward}
(bottom forward)
- #.None
+ {.#None}
(case (..down zipper)
- {#.Some forward}
+ {.#Some forward}
(bottom forward)
- #.None
+ {.#None}
zipper)))
(def: .public (previous zipper)
(All (_ a) (-> (Zipper a) (Maybe (Zipper a))))
(case (..left zipper)
- #.None
+ {.#None}
(..up zipper)
- {#.Some backward}
- {#.Some (case (..down backward)
- {#.Some then}
+ {.#Some backward}
+ {.#Some (case (..down backward)
+ {.#Some then}
(..bottom then)
- #.None
+ {.#None}
backward)}))
(template [<name> <move>]
[(def: .public (<name> zipper)
(All (_ a) (-> (Zipper a) (Maybe (Zipper a))))
(case (<move> zipper)
- #.None
- #.None
+ {.#None}
+ {.#None}
- {#.Some @}
+ {.#Some @}
(loop [@ @]
(case (<move> @)
- #.None
- {#.Some @}
+ {.#None}
+ {.#Some @}
- {#.Some @}
+ {.#Some @}
(recur @)))))]
[end ..next]
@@ -238,22 +238,22 @@
(def: .public (end? zipper)
(All (_ a) (-> (Zipper a) Bit))
(case (..end zipper)
- #.None
+ {.#None}
true
- {#.Some _}
+ {.#Some _}
false))
(def: .public (interpose value zipper)
(All (_ a) (-> a (Zipper a) (Zipper a)))
- (revised@ [#node #//.children]
+ (revised@ [#node //.#children]
(|>> (//.branch value) list)
zipper))
(def: .public (adopt value zipper)
(All (_ a) (-> a (Zipper a) (Zipper a)))
- (revised@ [#node #//.children]
- (|>> {#.Item (//.leaf value)})
+ (revised@ [#node //.#children]
+ (|>> {.#Item (//.leaf value)})
zipper))
(def: .public (remove zipper)
@@ -261,28 +261,28 @@
(do maybe.monad
[family (value@ #family zipper)]
(case (value@ #lefts family)
- #.End
- (in (with@ [#node #//.children]
+ {.#End}
+ (in (with@ [#node //.#children]
(value@ #rights family)
(value@ #parent family)))
- {#.Item next side}
+ {.#Item next side}
(in (|> zipper
(with@ #family (|> family
(with@ #lefts side)
- #.Some))
+ {.#Some}))
(with@ #node next))))))
(template [<name> <side>]
[(def: .public (<name> value zipper)
(All (_ a) (-> a (Zipper a) (Maybe (Zipper a))))
(case (value@ #family zipper)
- #.None
- #.None
+ {.#None}
+ {.#None}
- {#.Some family}
- {#.Some (with@ #family
- {#.Some (revised@ <side> (|>> {#.Item (//.leaf value)}) family)}
+ {.#Some family}
+ {.#Some (with@ #family
+ {.#Some (revised@ <side> (|>> {.#Item (//.leaf value)}) family)}
zipper)}))]
[insert_left #lefts]
@@ -294,29 +294,31 @@
(def: (each f (^slots [#family #node]))
[#family (maybe\each (function (_ (^slots [#parent #lefts #rights]))
- [#parent (each f parent)
- #lefts (list\each (//\each f) lefts)
- #rights (list\each (//\each f) rights)])
- family)
- #node (//\each f node)]))
+ [#parent (each f #parent)
+ #lefts (list\each (//\each f) #lefts)
+ #rights (list\each (//\each f) #rights)])
+ #family)
+ #node (//\each f #node)]))
(implementation: .public comonad
(CoMonad Zipper)
- (def: &functor ..functor)
+ (def: &functor
+ ..functor)
- (def: out (value@ [#node #//.value]))
+ (def: out
+ (value@ [#node //.#value]))
(def: (disjoint (^slots [#family #node]))
(let [tree_splitter (: (All (_ a) (-> (Tree a) (Tree (Zipper a))))
(function (tree_splitter tree)
- [#//.value (..zipper tree)
- #//.children (|> tree
- (value@ #//.children)
+ [//.#value (..zipper tree)
+ //.#children (|> tree
+ (value@ //.#children)
(list\each tree_splitter))]))]
[#family (maybe\each (function (_ (^slots [#parent #lefts #rights]))
- [#parent (disjoint parent)
- #lefts (list\each tree_splitter lefts)
- #rights (list\each tree_splitter rights)])
- family)
- #node (tree_splitter node)])))
+ [..#parent (disjoint #parent)
+ ..#lefts (list\each tree_splitter #lefts)
+ ..#rights (list\each tree_splitter #rights)])
+ #family)
+ #node (tree_splitter #node)])))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-08 04:40:31 +0000