From 8414d27d33ed37bad685ebca3bbb96a9baef6ea3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 19 Apr 2019 19:00:56 -0400 Subject: Moved the (rose) tree parser under "lux/control/parser/". --- stdlib/source/lux/control/parser/tree.lux | 53 ++++++ .../lux/data/collection/tree/rose/parser.lux | 52 ------ stdlib/source/test/lux/control.lux | 3 +- stdlib/source/test/lux/control/pipe.lux | 193 ++++++++++----------- 4 files changed, 147 insertions(+), 154 deletions(-) create mode 100644 stdlib/source/lux/control/parser/tree.lux delete mode 100644 stdlib/source/lux/data/collection/tree/rose/parser.lux diff --git a/stdlib/source/lux/control/parser/tree.lux b/stdlib/source/lux/control/parser/tree.lux new file mode 100644 index 000000000..1c6e21f43 --- /dev/null +++ b/stdlib/source/lux/control/parser/tree.lux @@ -0,0 +1,53 @@ +(.module: + [lux #* + [control + ["ex" exception (#+ exception:)]] + [data + ["." error (#+ Error)] + [tree + [rose (#+ Tree) + ["." zipper (#+ Zipper)]]]]] + ["." //]) + +(type: #export (Parser t a) + (//.Parser (Zipper t) a)) + +(def: #export (run-zipper zipper parser) + (All [t a] (-> (Zipper t) (Parser t a) (Error a))) + (case (//.run zipper parser) + (#error.Success [zipper output]) + (#error.Success output) + + (#error.Failure error) + (#error.Failure error))) + +(def: #export (run tree parser) + (All [t a] (-> (Tree t) (Parser t a) (Error a))) + (run-zipper (zipper.zip tree) parser)) + +(def: #export value + (All [t] (Parser t t)) + (function (_ zipper) + (#error.Success [zipper (zipper.value zipper)]))) + +(exception: #export cannot-move-further) + +(template [ ] + [(def: #export + (All [t] (Parser t [])) + (function (_ zipper) + (let [next ( zipper)] + (if (is? zipper next) + (ex.throw cannot-move-further []) + (#error.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/collection/tree/rose/parser.lux b/stdlib/source/lux/data/collection/tree/rose/parser.lux deleted file mode 100644 index 17cee8931..000000000 --- a/stdlib/source/lux/data/collection/tree/rose/parser.lux +++ /dev/null @@ -1,52 +0,0 @@ -(.module: - [lux #* - [control - ["p" parser] - ["ex" exception (#+ exception:)]] - [data - ["." error (#+ 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) (Error a))) - (case (p.run zipper parser) - (#error.Success [zipper output]) - (#error.Success output) - - (#error.Failure error) - (#error.Failure error))) - -(def: #export (run tree parser) - (All [t a] (-> (Tree t) (Parser t a) (Error a))) - (run-zipper (zipper.zip tree) parser)) - -(def: #export value - (All [t] (Parser t t)) - (function (_ zipper) - (#error.Success [zipper (zipper.value zipper)]))) - -(exception: #export cannot-move-further) - -(template [ ] - [(def: #export - (All [t] (Parser t [])) - (function (_ zipper) - (let [next ( zipper)] - (if (is? zipper next) - (ex.throw cannot-move-further []) - (#error.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/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 61d69459f..ae2455e84 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -57,8 +57,7 @@ /exception.test /io.test /parser.test - (<| (_.context "/pipe") - /pipe.test) + /pipe.test /reader.test /region.test /state.test diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index 6f7b65a53..9b4110a39 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -5,111 +5,104 @@ [monad (#+ do)]] [data ["." identity] - ["." text ("#;." equivalence) + ["." name] + ["." text ("#@." equivalence) format]] [math ["r" random]]] {1 - /}) + ["." / #*]}) (def: #export test Test - (do r.monad - [sample r.nat] - ($_ _.and - (do @ - [another r.nat] - (_.test "Can dismiss previous pipeline results and begin a new one." - (n/= (inc another) - (|> sample - (n/* 3) - (n/+ 4) - (new> another [inc]))))) - - (_.test "Let-binding" - (n/= (n/+ sample sample) - (|> sample - (let> x [(n/+ x x)])))) - - (_.test "'Conditional' branching." - (text;= (cond (n/= 0 sample) "zero" - (n/even? sample) "even" + (<| (_.context (name.module (name-of /._))) + (do r.monad + [sample r.nat] + ($_ _.and + (do @ + [another r.nat] + (_.test "Can dismiss previous pipeline results and begin a new one." + (n/= (inc another) + (|> sample + (n/* 3) + (n/+ 4) + (new> another [inc]))))) + (_.test "Let-binding" + (n/= (n/+ sample sample) + (|> sample + (let> x [(n/+ x x)])))) + (_.test "'Conditional' branching." + (text@= (cond (n/= 0 sample) "zero" + (n/even? sample) "even" + "odd") + (|> sample + (cond> [(n/= 0)] [(new> "zero" [])] + [n/even?] [(new> "even" [])] + [(new> "odd" [])])))) + (_.test "'If' branching." + (text@= (if (n/even? sample) + "even" "odd") - (|> sample - (cond> [(n/= 0)] [(new> "zero" [])] - [n/even?] [(new> "even" [])] - [(new> "odd" [])])))) - - (_.test "'If' branching." - (text;= (if (n/even? sample) - "even" - "odd") - (|> sample - (if> [n/even?] - [(new> "even" [])] - [(new> "odd" [])])))) - - (_.test "'When' branching." - (n/= (if (n/even? sample) - (n/* 2 sample) - sample) - (|> sample - (when> [n/even?] - [(n/* 2)])))) - - (_.test "Can loop." - (n/= (n/* 10 sample) - (|> sample - (loop> [(n/= (n/* 10 sample)) not] - [(n/+ sample)])))) - - (_.test "Monads." - (n/= (inc (n/+ 4 (n/* 3 sample))) - (|> sample - (do> identity.monad - [(n/* 3)] - [(n/+ 4)] - [inc])))) - - (_.test "Execution." - (n/= (n/* 10 sample) - (|> sample - (exec> [%n (format "sample = ") log!]) - (n/* 10)))) - - (_.test "Tuple." - (let [[left middle right] (|> sample - (tuple> [inc] - [dec] - [%n]))] - (and (n/= (inc sample) left) - (n/= (dec sample) middle) - (text;= (%n sample) right)))) - - (_.test "Pattern-matching." - (text;= (case (n/% 10 sample) - 0 "zero" - 1 "one" - 2 "two" - 3 "three" - 4 "four" - 5 "five" - 6 "six" - 7 "seven" - 8 "eight" - 9 "nine" - _ "???") - (|> sample - (n/% 10) - (case> 0 "zero" - 1 "one" - 2 "two" - 3 "three" - 4 "four" - 5 "five" - 6 "six" - 7 "seven" - 8 "eight" - 9 "nine" - _ "???")))) - ))) + (|> sample + (if> [n/even?] + [(new> "even" [])] + [(new> "odd" [])])))) + (_.test "'When' branching." + (n/= (if (n/even? sample) + (n/* 2 sample) + sample) + (|> sample + (when> [n/even?] + [(n/* 2)])))) + (_.test "Can loop." + (n/= (n/* 10 sample) + (|> sample + (loop> [(n/= (n/* 10 sample)) not] + [(n/+ sample)])))) + (_.test "Monads." + (n/= (inc (n/+ 4 (n/* 3 sample))) + (|> sample + (do> identity.monad + [(n/* 3)] + [(n/+ 4)] + [inc])))) + (_.test "Execution." + (n/= (n/* 10 sample) + (|> sample + (exec> [%n (format "sample = ") log!]) + (n/* 10)))) + (_.test "Tuple." + (let [[left middle right] (|> sample + (tuple> [inc] + [dec] + [%n]))] + (and (n/= (inc sample) left) + (n/= (dec sample) middle) + (text@= (%n sample) right)))) + (_.test "Pattern-matching." + (text@= (case (n/% 10 sample) + 0 "zero" + 1 "one" + 2 "two" + 3 "three" + 4 "four" + 5 "five" + 6 "six" + 7 "seven" + 8 "eight" + 9 "nine" + _ "???") + (|> sample + (n/% 10) + (case> 0 "zero" + 1 "one" + 2 "two" + 3 "three" + 4 "four" + 5 "five" + 6 "six" + 7 "seven" + 8 "eight" + 9 "nine" + _ "???")))) + )))) -- cgit v1.2.3