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. --- .../test/test/lux/data/coll/tree/rose/zipper.lux | 124 +++++++++++++++++++++ stdlib/test/test/lux/data/coll/tree/zipper.lux | 124 --------------------- stdlib/test/tests.lux | 6 +- 3 files changed, 127 insertions(+), 127 deletions(-) create mode 100644 stdlib/test/test/lux/data/coll/tree/rose/zipper.lux delete mode 100644 stdlib/test/test/lux/data/coll/tree/zipper.lux (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/data/coll/tree/rose/zipper.lux b/stdlib/test/test/lux/data/coll/tree/rose/zipper.lux new file mode 100644 index 000000000..ff52e706d --- /dev/null +++ b/stdlib/test/test/lux/data/coll/tree/rose/zipper.lux @@ -0,0 +1,124 @@ +(.module: + lux + (lux [io] + (control [monad #+ do Monad] + pipe) + (data (coll [list "list/" Fold Functor] + (tree [rose] + (rose ["&" zipper]))) + [text] + text/format + [number] + [maybe]) + ["r" math/random]) + lux/test) + +(def: gen-tree + (r.Random (rose.Tree Nat)) + (r.rec (function (_ gen-tree) + (do r.Monad + ## Each branch can have, at most, 1 child. + [size (|> r.nat (:: @ map (n/% +2)))] + (r.seq r.nat + (r.list size gen-tree)))))) + +(def: (to-end zipper) + (All [a] (-> (&.Zipper a) (&.Zipper a))) + (loop [zipper zipper] + (if (&.end? zipper) + zipper + (recur (&.next zipper))))) + +(context: "Zippers." + (<| (times +100) + (do @ + [sample gen-tree + new-val r.nat + pre-val r.nat + post-val r.nat + #let [(^open "tree/") (rose.Eq number.Eq) + (^open "list/") (list.Eq number.Eq)]] + ($_ seq + (test "Trees can be converted to/from zippers." + (|> sample + &.zip &.unzip + (tree/= sample))) + + (test "Creating a zipper gives you a root node." + (|> sample &.zip &.root?)) + + (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 &.root (is? zipper) not))) + (and (&.leaf? zipper) + (|> zipper (&.prepend-child new-val) &.branch?))))) + + (test "Can prepend and append children." + (let [zipper (&.zip sample)] + (if (&.branch? zipper) + (let [mid-val (|> zipper &.down &.value) + zipper (|> zipper + (&.prepend-child pre-val) + (&.append-child post-val))] + (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)))) + true))) + + (test "Can insert children around a node (unless it's root)." + (let [zipper (&.zip sample)] + (if (&.branch? zipper) + (let [mid-val (|> zipper &.down &.value) + 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." + (list/= (rose.flatten sample) + (loop [zipper (&.zip sample)] + (if (&.end? zipper) + (list (&.value zipper)) + (#.Cons (&.value zipper) + (recur (&.next zipper))))))) + + (test "Backwards zipper traversal yield reverse tree flatten." + (list/= (list.reverse (rose.flatten sample)) + (loop [zipper (to-end (&.zip sample))] + (if (&.root? zipper) + (list (&.value zipper)) + (#.Cons (&.value zipper) + (recur (&.prev zipper))))))) + + (test "Can remove nodes (except root nodes)." + (let [zipper (&.zip sample)] + (if (&.branch? zipper) + (and (|> zipper &.down &.root? not) + (|> zipper &.down &.remove (case> #.None false + (#.Some node) (&.root? node)))) + (|> zipper &.remove (case> #.None true + (#.Some _) false))))) + )))) diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux deleted file mode 100644 index 7b182a918..000000000 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ /dev/null @@ -1,124 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do Monad] - pipe) - (data (coll [list "L/" Fold Functor] - (tree ["&" zipper] - [rose])) - [text] - text/format - [number] - [maybe]) - ["r" math/random]) - lux/test) - -(def: gen-tree - (r.Random (rose.Tree Nat)) - (r.rec (function (_ gen-tree) - (do r.Monad - ## Each branch can have, at most, 1 child. - [size (|> r.nat (:: @ map (n/% +2)))] - (r.seq r.nat - (r.list size gen-tree)))))) - -(def: (to-end zipper) - (All [a] (-> (&.Zipper a) (&.Zipper a))) - (loop [zipper zipper] - (if (&.end? zipper) - zipper - (recur (&.next zipper))))) - -(context: "Zippers." - (<| (times +100) - (do @ - [sample gen-tree - new-val r.nat - pre-val r.nat - post-val r.nat - #let [(^open "tree/") (rose.Eq number.Eq) - (^open "L/") (list.Eq number.Eq)]] - ($_ seq - (test "Trees can be converted to/from zippers." - (|> sample - &.zip &.unzip - (tree/= sample))) - - (test "Creating a zipper gives you a root node." - (|> sample &.zip &.root?)) - - (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 &.root (is? zipper) not))) - (and (&.leaf? zipper) - (|> zipper (&.prepend-child new-val) &.branch?))))) - - (test "Can prepend and append children." - (let [zipper (&.zip sample)] - (if (&.branch? zipper) - (let [mid-val (|> zipper &.down &.value) - zipper (|> zipper - (&.prepend-child pre-val) - (&.append-child post-val))] - (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)))) - true))) - - (test "Can insert children around a node (unless it's root)." - (let [zipper (&.zip sample)] - (if (&.branch? zipper) - (let [mid-val (|> zipper &.down &.value) - 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." - (L/= (rose.flatten sample) - (loop [zipper (&.zip sample)] - (if (&.end? zipper) - (list (&.value zipper)) - (#.Cons (&.value zipper) - (recur (&.next zipper))))))) - - (test "Backwards zipper traversal yield reverse tree flatten." - (L/= (list.reverse (rose.flatten sample)) - (loop [zipper (to-end (&.zip sample))] - (if (&.root? zipper) - (list (&.value zipper)) - (#.Cons (&.value zipper) - (recur (&.prev zipper))))))) - - (test "Can remove nodes (except root nodes)." - (let [zipper (&.zip sample)] - (if (&.branch? zipper) - (and (|> zipper &.down &.root? not) - (|> zipper &.down &.remove (case> #.None false - (#.Some node) (&.root? node)))) - (|> zipper &.remove (case> #.None true - (#.Some _) false))))) - )))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index a25d419bc..71317af18 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -53,8 +53,8 @@ ["_." set/ordered] ["_." queue] (queue ["_." priority]) - (tree ["tree_." rose] - ["tree_." zipper])) + (tree ["_." rose] + (rose ["_." zipper]))) (text ["_." format] ["_." lexer] ["_." regex])) @@ -90,7 +90,7 @@ (format [context] [html] [css]) - (coll (tree ["tree_." parser]))) + (coll (tree ["_." rose/parser]))) [macro] (macro (poly [json])) (type [unit] -- cgit v1.2.3