From e6afba3e17f03ed0652d18a26d0f3c053a49e7a5 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 19 Sep 2017 19:17:37 -0400 Subject: - Tree parsing. --- stdlib/source/lux/data/coll/tree/parser.lux | 50 ++++++++++++++++++ stdlib/source/lux/data/coll/tree/zipper.lux | 68 +++++++++++------------- stdlib/test/test/lux/data/coll/tree/zipper.lux | 73 +++++++++++++------------- stdlib/test/tests.lux | 11 ++-- 4 files changed, 124 insertions(+), 78 deletions(-) create mode 100644 stdlib/source/lux/data/coll/tree/parser.lux (limited to 'stdlib') diff --git a/stdlib/source/lux/data/coll/tree/parser.lux b/stdlib/source/lux/data/coll/tree/parser.lux new file mode 100644 index 000000000..203f55b16 --- /dev/null +++ b/stdlib/source/lux/data/coll/tree/parser.lux @@ -0,0 +1,50 @@ +(;module: + lux + (lux (control ["p" parser] + ["ex" exception #+ exception:]) + (data ["R" result])) + (.. ["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) (R;Result a))) + (case (p;run zipper parser) + (#R;Success [zipper output]) + (#R;Success output) + + (#R;Error error) + (#R;Error error))) + +(def: #export (run tree parser) + (All [t a] (-> (T;Tree t) (Parser t a) (R;Result a))) + (run-zipper (Z;zip tree) parser)) + +(def: #export value + (All [t] (Parser t t)) + (function [zipper] + (#R;Success [zipper (Z;value zipper)]))) + +(exception: #export Cannot-Move-Further) + +(do-template [ ] + [(def: #export + (All [t] (Parser t [])) + (function [zipper] + (let [next ( zipper)] + (if (is zipper next) + (ex;throw Cannot-Move-Further "") + (#R;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/zipper.lux b/stdlib/source/lux/data/coll/tree/zipper.lux index b217a0677..6b39178bc 100644 --- a/stdlib/source/lux/data/coll/tree/zipper.lux +++ b/stdlib/source/lux/data/coll/tree/zipper.lux @@ -21,24 +21,24 @@ #node (Tree a)}) ## [Values] -(def: #export (from-tree tree) +(def: #export (zip tree) (All [a] (-> (Tree a) (Zipper a))) {#parent #;None #lefts stack;empty #rights stack;empty #node tree}) -(def: #export (to-tree zipper) +(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) (get@ #rose;value))) + (|> zipper (get@ [#node #rose;value]))) (def: #export (children zipper) (All [a] (-> (Zipper a) (List (Tree a)))) - (|> zipper (get@ #node) (get@ #rose;children))) + (|> zipper (get@ [#node #rose;children]))) (def: #export (branch? zipper) (All [a] (-> (Zipper a) Bool)) @@ -48,9 +48,19 @@ (All [a] (-> (Zipper a) Bool)) (|> zipper branch? not)) -(def: #export (parent zipper) - (All [a] (-> (Zipper a) (Maybe (Zipper a)))) - (get@ #parent zipper)) +(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))) @@ -108,6 +118,20 @@ [left leftmost #lefts #rights] ) +(do-template [ ] + [(def: #export ( zipper) + (All [a] (-> (Zipper a) (Zipper a))) + (case (get@ zipper) + #;Nil + ( zipper) + + _ + ( 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)) @@ -169,34 +193,6 @@ [insert-right #rights] ) -(do-template [ ] - [(def: #export ( zipper) - (All [a] (-> (Zipper a) (Zipper a))) - (case (get@ zipper) - #;Nil - ( zipper) - - _ - ( zipper)))] - - [next #rights right down] - [prev #lefts left up] - ) - -(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)) - (struct: #export _ (Functor Zipper) (def: (map f fa) {#parent (|> fa (get@ #parent) (M/map (map f))) @@ -211,7 +207,7 @@ ## (def: (split wa) ## (let [tree-splitter (function tree-splitter [tree] -## {#rose;value (from-tree tree) +## {#rose;value (zip tree) ## #rose;children (L/map tree-splitter ## (get@ #rose;children tree))})] ## {#parent (|> wa (get@ #parent) (M/map split)) diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux index b7936b140..9154459b9 100644 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux @@ -3,23 +3,23 @@ (lux [io] (control [monad #+ do Monad] pipe) - (data (coll [list "List/" Fold Functor] + (data (coll [list "L/" Fold Functor] (tree ["&" zipper] [rose])) - [text "Text/" Monoid] + [text] text/format [number]) - ["R" math/random]) + ["r" math/random]) lux/test) (def: gen-tree - (R;Random (rose;Tree Nat)) - (R;rec (function [gen-tree] - (do R;Monad + (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)))))) + [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))) @@ -28,35 +28,34 @@ zipper (recur (&;next zipper))))) -(context: "Zippers" +(context: "Zippers." [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)]] + 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 - &;from-tree &;to-tree - (Tree/= sample))) + &;zip &;unzip + (tree/= sample))) (test "Creating a zipper gives you a root node." - (|> sample &;from-tree &;root?)) + (|> sample &;zip &;root?)) (test "Can move down inside branches. Can move up from lower nodes." - (let [zipper (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (let [child (|> zipper &;down)] - (and (not (Tree/= sample (&;to-tree child))) - (|> child &;parent (default (undefined)) (is zipper)) + (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 (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (let [mid-val (|> zipper &;down &;value) zipper (|> zipper @@ -71,7 +70,7 @@ true))) (test "Can insert children around a node (unless it's root)." - (let [zipper (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (let [mid-val (|> zipper &;down &;value) zipper (|> zipper @@ -93,26 +92,26 @@ #;None true)))))) (test "Can set and update the value of a node." - (|> sample &;from-tree (&;set new-val) &;value (n.= new-val))) + (|> 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 (&;from-tree sample)] - (if (&;end? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;next zipper))))))) + (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." - (List/= (list;reverse (rose;flatten sample)) - (loop [zipper (to-end (&;from-tree sample))] - (if (&;root? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;prev zipper))))))) + (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 (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (and (|> zipper &;down &;root? not) (|> zipper &;down &;remove (case> #;None false diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 598c488fd..62683aea5 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -52,10 +52,10 @@ ["_;" seq] ["_;" priority-queue] ["_;" stream] - (tree ["_;" rose] - ["_;" zipper]) - (ordered ["_o;" dict] - ["_o;" set])) + (tree ["tree_;" rose] + ["tree_;" zipper]) + (ordered ["ordered_;" dict] + ["ordered_;" set])) (text ["_;" format] ["_;" lexer] ["_;" regex])) @@ -85,7 +85,8 @@ [tainted] (format [context] [html] - [css])) + [css]) + (coll (tree ["tree_;" parser]))) [macro] (math [random]) (type [unit]) -- cgit v1.2.3