diff options
Diffstat (limited to 'stdlib/source/lux/control/parser.lux')
| -rw-r--r-- | stdlib/source/lux/control/parser.lux | 46 |
1 files changed, 22 insertions, 24 deletions
diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 4b4ef0d34..4ea39a006 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -3,11 +3,11 @@ [control [functor (#+ Functor)] [apply (#+ Apply)] - [monad (#+ do Monad)] + [monad (#+ Monad do)] [codec (#+ Codec)]] [data [collection - ["." list ("list/." Functor<List> Monoid<List>)]] + ["." list ("list/." functor monoid)]] ["." product] ["." error (#+ Error)]]]) @@ -15,8 +15,7 @@ {#.doc "A generic parser."} (-> s (Error [s a]))) -## [Structures] -(structure: #export Functor<Parser> (All [s] (Functor (Parser s))) +(structure: #export functor (All [s] (Functor (Parser s))) (def: (map f ma) (function (_ input) (case (ma input) @@ -26,8 +25,8 @@ (#error.Success [input' a]) (#error.Success [input' (f a)]))))) -(structure: #export Apply<Parser> (All [s] (Apply (Parser s))) - (def: functor Functor<Parser>) +(structure: #export apply (All [s] (Apply (Parser s))) + (def: &functor ..functor) (def: (apply ff fa) (function (_ input) @@ -43,8 +42,8 @@ (#error.Failure msg) (#error.Failure msg))))) -(structure: #export Monad<Parser> (All [s] (Monad (Parser s))) - (def: functor Functor<Parser>) +(structure: #export monad (All [s] (Monad (Parser s))) + (def: &functor ..functor) (def: (wrap x) (function (_ input) @@ -59,7 +58,6 @@ (#error.Success [input' ma]) (ma input'))))) -## [Parsers] (def: #export (assert message test) {#.doc "Fails with the given message if the test is #0."} (All [s] (-> Text Bit (Parser s Any))) @@ -96,7 +94,7 @@ (#error.Success [input' x]) (run input' - (do Monad<Parser> + (do ..monad [xs (some p)] (wrap (list& x xs))) )))) @@ -105,7 +103,7 @@ {#.doc "1-or-more combinator."} (All [s a] (-> (Parser s a) (Parser s (List a)))) - (do Monad<Parser> + (do ..monad [x p xs (some p)] (wrap (list& x xs)))) @@ -114,7 +112,7 @@ {#.doc "Sequencing combinator."} (All [s a b] (-> (Parser s a) (Parser s b) (Parser s [a b]))) - (do Monad<Parser> + (do ..monad [x1 p1 x2 p2] (wrap [x1 x2]))) @@ -130,7 +128,7 @@ (#error.Failure _) (run tokens - (do Monad<Parser> + (do ..monad [x2 p2] (wrap (1 x2)))) ))) @@ -152,16 +150,16 @@ {#.doc "Parse exactly N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) (if (n/> 0 n) - (do Monad<Parser> + (do ..monad [x p xs (exactly (dec n) p)] (wrap (#.Cons x xs))) - (:: Monad<Parser> wrap (list)))) + (:: ..monad wrap (list)))) (def: #export (at-least n p) {#.doc "Parse at least N times."} (All [s a] (-> Nat (Parser s a) (Parser s (List a)))) - (do Monad<Parser> + (do ..monad [min (exactly n p) extra (some p)] (wrap (list/compose min extra)))) @@ -177,24 +175,24 @@ (#error.Success [input' x]) (run input' - (do Monad<Parser> + (do ..monad [xs (at-most (dec n) p)] (wrap (#.Cons x xs)))) )) - (:: Monad<Parser> wrap (list)))) + (:: ..monad wrap (list)))) (def: #export (between from to p) {#.doc "Parse between N and M times."} (All [s a] (-> Nat Nat (Parser s a) (Parser s (List a)))) - (do Monad<Parser> + (do ..monad [min-xs (exactly from p) max-xs (at-most (n/- from to) p)] - (wrap (:: list.Monad<List> join (list min-xs max-xs))))) + (wrap (:: list.monad join (list min-xs max-xs))))) (def: #export (sep-by sep p) {#.doc "Parsers instances of 'p' that are separated by instances of 'sep'."} (All [s a b] (-> (Parser s b) (Parser s a) (Parser s (List a)))) - (do Monad<Parser> + (do ..monad [?x (maybe p)] (case ?x #.None @@ -255,20 +253,20 @@ (def: #export (after param subject) (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a))) - (do Monad<Parser> + (do ..monad [_ param] subject)) (def: #export (before param subject) (All [s _ a] (-> (Parser s _) (Parser s a) (Parser s a))) - (do Monad<Parser> + (do ..monad [output subject _ param] (wrap output))) (def: #export (filter test parser) (All [s a] (-> (-> a Bit) (Parser s a) (Parser s a))) - (do Monad<Parser> + (do ..monad [output parser _ (assert "Constraint failed." (test output))] (wrap output))) |