diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/control/parser/analysis.lux | 140 |
1 files changed, 140 insertions, 0 deletions
diff --git a/stdlib/source/lux/control/parser/analysis.lux b/stdlib/source/lux/control/parser/analysis.lux new file mode 100644 index 000000000..0cef19fd9 --- /dev/null +++ b/stdlib/source/lux/control/parser/analysis.lux @@ -0,0 +1,140 @@ +(.module: + [lux (#- nat int rev) + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]] + [data + ["." bit] + ["." name] + [number + ["." i64] + ["." nat] + ["." int] + ["." rev] + ["." frac]] + ["." text + ["%" format (#+ format)]] + [collection + ["." list ("#@." functor)]]] + [tool + [compiler + [reference (#+)] + [arity (#+ Arity)] + ["/" analysis (#+ Variant Tuple Environment Analysis)]]]] + ["." //]) + +(def: (remaining-inputs asts) + (-> (List Analysis) Text) + (format text.new-line "Remaining input: " + (|> asts + (list@map /.%analysis) + (list.interpose " ") + (text.join-with "")))) + +## TODO: Use "type:" ASAP. +(def: Input Type (type (List Analysis))) + +(exception: #export (cannot-parse {input ..Input}) + (exception.report + ["Input" (exception.enumerate /.%analysis input)])) + +(exception: #export (unconsumed-input {input ..Input}) + (exception.report + ["Input" (exception.enumerate /.%analysis input)])) + +(exception: #export (wrong-arity {expected Arity} {actual Arity}) + (exception.report + ["Expected" (%.nat expected)] + ["Actual" (%.nat actual)])) + +(exception: #export empty-input) + +(type: #export Parser + (//.Parser ..Input)) + +(def: #export (run parser input) + (All [a] (-> (Parser a) ..Input (Try a))) + (case (parser input) + (#try.Failure error) + (#try.Failure error) + + (#try.Success [#.Nil value]) + (#try.Success value) + + (#try.Success [unconsumed _]) + (exception.throw ..unconsumed-input unconsumed))) + +(def: #export any + (Parser Analysis) + (function (_ input) + (case input + #.Nil + (exception.throw ..empty-input []) + + (#.Cons [head tail]) + (#try.Success [tail head])))) + +(def: #export end! + {#.doc "Ensures there are no more inputs."} + (Parser Any) + (function (_ tokens) + (case tokens + #.Nil (#try.Success [tokens []]) + _ (#try.Failure (format "Expected list of tokens to be empty!" + (remaining-inputs tokens)))))) + +(def: #export end? + {#.doc "Checks whether there are no more inputs."} + (Parser Bit) + (function (_ tokens) + (#try.Success [tokens (case tokens + #.Nil true + _ false)]))) + +(template [<query> <assertion> <tag> <type> <eq>] + [(def: #export <query> + (Parser <type>) + (function (_ input) + (case input + (^ (list& (<tag> x) input')) + (#try.Success [input' x]) + + _ + (exception.throw ..cannot-parse input)))) + + (def: #export (<assertion> expected) + (-> <type> (Parser Any)) + (function (_ input) + (case input + (^ (list& (<tag> actual) input')) + (if (:: <eq> = expected actual) + (#try.Success [input' []]) + (exception.throw ..cannot-parse input)) + + _ + (exception.throw ..cannot-parse input))))] + + [bit bit! /.bit Bit bit.equivalence] + [nat nat! /.nat Nat nat.equivalence] + [int int! /.int Int int.equivalence] + [rev rev! /.rev Rev rev.equivalence] + [frac frac! /.frac Frac frac.equivalence] + [text text! /.text Text text.equivalence] + [local local! /.variable/local Nat nat.equivalence] + [foreign foreign! /.variable/foreign Nat nat.equivalence] + [constant constant! /.constant Name name.equivalence] + ) + +(def: #export (tuple parser) + (All [a] (-> (Parser a) (Parser a))) + (function (_ input) + (case input + (^ (list& (/.tuple head) tail)) + (do try.monad + [output (..run parser head)] + (#try.Success [tail output])) + + _ + (exception.throw ..cannot-parse input)))) |