diff options
Diffstat (limited to 'stdlib/source/parser')
-rw-r--r-- | stdlib/source/parser/lux/data/text.lux | 406 | ||||
-rw-r--r-- | stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux | 133 |
2 files changed, 539 insertions, 0 deletions
diff --git a/stdlib/source/parser/lux/data/text.lux b/stdlib/source/parser/lux/data/text.lux new file mode 100644 index 000000000..e02733f77 --- /dev/null +++ b/stdlib/source/parser/lux/data/text.lux @@ -0,0 +1,406 @@ +(.using + [library + [lux (.except and not local) + [abstract + [monad (.only Monad do)]] + [control + ["//" parser] + ["[0]" maybe] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception:)]] + [data + ["/" text (.only Char) (.open: "[1]#[0]" monoid)] + ["[0]" product] + [collection + ["[0]" list (.open: "[1]#[0]" mix)]]] + [macro + ["^" pattern] + ["[0]" code] + ["[0]" template]] + [math + [number + ["n" nat (.open: "[1]#[0]" decimal)]]]]]) + +(type: .public Offset + Nat) + +(def: beginning + Offset + 0) + +(exception: .public cannot_parse) +(exception: .public cannot_slice) + +(type: .public Parser + (//.Parser [Offset Text])) + +(type: .public Slice + (Record + [#basis Offset + #distance Offset])) + +(def: .public (slice parser) + (-> (Parser Slice) (Parser Text)) + (do //.monad + [[basis distance] parser] + (function (_ (^.let input [offset tape])) + (case (/.clip basis distance tape) + {.#Some output} + {try.#Success [input output]} + + {.#None} + (exception.except ..cannot_slice []))))) + +(def: (left_over offset tape) + (-> Offset Text Text) + (|> tape (/.clip_since offset) maybe.trusted)) + +(exception: .public (unconsumed_input [offset Offset + tape Text]) + (exception.report + "Offset" (n#encoded offset) + "Input size" (n#encoded (/.size tape)) + "Remaining input" (..left_over offset tape))) + +(exception: .public (expected_to_fail [offset Offset + tape Text]) + (exception.report + "Offset" (n#encoded offset) + "Input" (..left_over offset tape))) + +(def: .public (result parser input) + (All (_ a) (-> (Parser a) Text (Try a))) + (case (parser [..beginning input]) + {try.#Failure msg} + {try.#Failure msg} + + {try.#Success [[end_offset _] output]} + (if (n.= end_offset (/.size input)) + {try.#Success output} + (exception.except ..unconsumed_input [end_offset input])))) + +(def: .public offset + (Parser Offset) + (function (_ (^.let input [offset tape])) + {try.#Success [input offset]})) + +(def: (with_slices parser) + (-> (Parser (List Slice)) (Parser Slice)) + (do //.monad + [offset ..offset + slices parser] + (in (list#mix (function (_ [slice::basis slice::distance] + [total::basis total::distance]) + [total::basis ("lux i64 +" slice::distance total::distance)]) + [#basis offset + #distance 0] + slices)))) + +(def: .public any + (Parser Text) + (function (_ [offset tape]) + (case (/.char offset tape) + {.#Some output} + {try.#Success [[("lux i64 +" 1 offset) tape] (/.of_char output)]} + + _ + (exception.except ..cannot_parse [])))) + +(def: .public any! + (Parser Slice) + (function (_ [offset tape]) + (case (/.char offset tape) + {.#Some _} + {try.#Success [[("lux i64 +" 1 offset) tape] + [#basis offset + #distance 1]]} + + _ + (exception.except ..cannot_slice [])))) + +(with_template [<name> <type> <any>] + [(`` (def: .public (<name> parser) + (All (_ a) (-> (Parser a) (Parser <type>))) + (function (_ input) + (case (parser input) + {try.#Failure msg} + (<any> input) + + _ + (exception.except ..expected_to_fail input)))))] + + [not Text ..any] + [not! Slice ..any!] + ) + +(exception: .public (cannot_match [reference Text]) + (exception.report + "Reference" (/.format reference))) + +(def: .public (this reference) + (-> Text (Parser Any)) + (function (_ [offset tape]) + (case (/.index_since offset reference tape) + {.#Some where} + (if (n.= offset where) + {try.#Success [[("lux i64 +" (/.size reference) offset) tape] + []]} + (exception.except ..cannot_match [reference])) + + _ + (exception.except ..cannot_match [reference])))) + +(def: .public end + (Parser Any) + (function (_ (^.let input [offset tape])) + (if (n.= offset (/.size tape)) + {try.#Success [input []]} + (exception.except ..unconsumed_input input)))) + +(def: .public next + (Parser Text) + (function (_ (^.let input [offset tape])) + (case (/.char offset tape) + {.#Some output} + {try.#Success [input (/.of_char output)]} + + _ + (exception.except ..cannot_parse [])))) + +(def: .public remaining + (Parser Text) + (function (_ (^.let input [offset tape])) + {try.#Success [input (..left_over offset tape)]})) + +(def: .public (range bottom top) + (-> Nat Nat (Parser Text)) + (do //.monad + [char any + .let [char' (maybe.trusted (/.char 0 char))] + _ (//.assertion (all /#composite "Character is not within range: " (/.of_char bottom) "-" (/.of_char top)) + (.and (n.>= bottom char') + (n.<= top char')))] + (in char))) + +(def: .public (range! bottom top) + (-> Nat Nat (Parser Slice)) + (do //.monad + [it ..any! + char (..slice (in it)) + .let [char' (maybe.trusted (/.char 0 char))] + _ (//.assertion (all /#composite "Character is not within range: " (/.of_char bottom) "-" (/.of_char top)) + (.and (n.>= bottom char') + (n.<= top char')))] + (in it))) + +(with_template [<bottom> <top> <text> <slice>] + [(def: .public <text> + (Parser Text) + (..range (char <bottom>) (char <top>))) + + (def: .public <slice> + (Parser Slice) + (..range! (char <bottom>) (char <top>)))] + + ["A" "Z" upper upper!] + ["a" "z" lower lower!] + ["0" "9" decimal decimal!] + ["0" "7" octal octal!] + ) + +(def: .public alpha (Parser Text) (//.either ..lower ..upper)) +(def: .public alpha! (Parser Slice) (//.either ..lower! ..upper!)) + +(def: .public alpha_num (Parser Text) (//.either ..alpha ..decimal)) +(def: .public alpha_num! (Parser Slice) (//.either ..alpha! ..decimal!)) + +(def: .public hexadecimal + (Parser Text) + (all //.either + ..decimal + (..range (char "a") (char "f")) + (..range (char "A") (char "F")))) + +(def: .public hexadecimal! + (Parser Slice) + (all //.either + ..decimal! + (..range! (char "a") (char "f")) + (..range! (char "A") (char "F")))) + +(with_template [<name>] + [(exception: .public (<name> [options Text + character Char]) + (exception.report + "Options" (/.format options) + "Character" (/.format (/.of_char character))))] + + [character_should_be] + [character_should_not_be] + ) + +(with_template [<name> <modifier> <exception>] + [(def: .public (<name> options) + (-> Text (Parser Text)) + (function (_ [offset tape]) + (case (/.char offset tape) + {.#Some output} + (let [output' (/.of_char output)] + (if (<modifier> (/.contains? output' options)) + {try.#Success [[("lux i64 +" 1 offset) tape] output']} + (exception.except <exception> [options output]))) + + _ + (exception.except ..cannot_parse []))))] + + [one_of |> ..character_should_be] + [none_of .not ..character_should_not_be] + ) + +(with_template [<name> <modifier> <exception>] + [(def: .public (<name> options) + (-> Text (Parser Slice)) + (function (_ [offset tape]) + (case (/.char offset tape) + {.#Some output} + (let [output' (/.of_char output)] + (if (<modifier> (/.contains? output' options)) + {try.#Success [[("lux i64 +" 1 offset) tape] + [#basis offset + #distance 1]]} + (exception.except <exception> [options output]))) + + _ + (exception.except ..cannot_slice []))))] + + [one_of! |> ..character_should_be] + [none_of! .not ..character_should_not_be] + ) + +(exception: .public (character_does_not_satisfy_predicate [character Char]) + (exception.report + "Character" (/.format (/.of_char character)))) + +(def: .public (satisfies parser) + (-> (-> Char Bit) (Parser Text)) + (function (_ [offset tape]) + (case (/.char offset tape) + {.#Some output} + (if (parser output) + {try.#Success [[("lux i64 +" 1 offset) tape] (/.of_char output)]} + (exception.except ..character_does_not_satisfy_predicate [output])) + + _ + (exception.except ..cannot_parse [])))) + +(def: .public (satisfies! parser) + (-> (-> Char Bit) (Parser Slice)) + (function (_ [offset tape]) + (case (/.char offset tape) + {.#Some output} + (if (parser output) + {try.#Success [[("lux i64 +" 1 offset) tape] + [#basis offset #distance 1]]} + (exception.except ..character_does_not_satisfy_predicate [output])) + + _ + (exception.except ..cannot_parse [])))) + +(def: .public space + (Parser Text) + (..satisfies /.space?)) + +(def: .public space! + (Parser Slice) + (..satisfies! /.space?)) + +(def: .public (and left right) + (-> (Parser Text) (Parser Text) (Parser Text)) + (do //.monad + [=left left + =right right] + (in (all /#composite =left =right)))) + +(def: .public (and! left right) + (-> (Parser Slice) (Parser Slice) (Parser Slice)) + (do //.monad + [(open "left[0]") left + (open "right[0]") right] + (in [left#basis ("lux i64 +" left#distance right#distance)]))) + +(with_template [<name> <base> <doc_modifier>] + [(def: .public (<name> parser) + (-> (Parser Text) (Parser Text)) + (|> parser <base> (at //.monad each /.together)))] + + [some //.some "some"] + [many //.many "many"] + ) + +(with_template [<name> <base> <doc_modifier>] + [(def: .public (<name> parser) + (-> (Parser Slice) (Parser Slice)) + (with_slices (<base> parser)))] + + [some! //.some "some"] + [many! //.many "many"] + ) + +(with_template [<name> <base> <doc_modifier>] + [(def: .public (<name> amount parser) + (-> Nat (Parser Text) (Parser Text)) + (|> parser + (<base> amount) + (at //.monad each /.together)))] + + [exactly //.exactly "exactly"] + [at_most //.at_most "at most"] + [at_least //.at_least "at least"] + ) + +(with_template [<name> <base> <doc_modifier>] + [(def: .public (<name> amount parser) + (-> Nat (Parser Slice) (Parser Slice)) + (with_slices + (<base> amount parser)))] + + [exactly! //.exactly "exactly"] + [at_most! //.at_most "at most"] + [at_least! //.at_least "at least"] + ) + +(def: .public (between minimum additional parser) + (-> Nat Nat (Parser Text) (Parser Text)) + (|> parser + (//.between minimum additional) + (at //.monad each /.together))) + +(def: .public (between! minimum additional parser) + (-> Nat Nat (Parser Slice) (Parser Slice)) + (with_slices + (//.between minimum additional parser))) + +(def: .public (enclosed [start end] parser) + (All (_ a) (-> [Text Text] (Parser a) (Parser a))) + (|> parser + (//.before (this end)) + (//.after (this start)))) + +(def: .public (local local_input parser) + (All (_ a) (-> Text (Parser a) (Parser a))) + (function (_ real_input) + (case (..result parser local_input) + {try.#Failure error} + {try.#Failure error} + + {try.#Success value} + {try.#Success [real_input value]}))) + +(def: .public (then structured text) + (All (_ s a) + (-> (Parser a) + (//.Parser s Text) + (//.Parser s a))) + (do //.monad + [raw text] + (//.lifted (..result structured raw)))) diff --git a/stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux new file mode 100644 index 000000000..159c1c62e --- /dev/null +++ b/stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux @@ -0,0 +1,133 @@ +(.using + [library + [lux (.except nat int rev local) + [abstract + [monad (.only do)]] + [control + ["//" parser] + ["[0]" try (.only Try)] + ["[0]" exception (.only exception:)]] + [data + ["[0]" bit] + ["[0]" text (.only) + ["%" format (.only format)]] + [collection + ["[0]" list (.open: "[1]#[0]" functor)]]] + [macro + ["[0]" template]] + [math + [number + ["[0]" i64] + ["[0]" nat] + ["[0]" int] + ["[0]" rev] + ["[0]" frac]]] + [meta + ["[0]" symbol]] + [tool + [compiler + [arity (.only Arity)] + [reference (.only) + [variable (.only)]]]]]] + ["/" \\library (.only Environment Analysis)]) + +(def: (remaining_inputs asts) + (-> (List Analysis) Text) + (format text.new_line "Remaining input: " + (|> asts + (list#each /.format) + (text.interposed " ")))) + +(exception: .public (cannot_parse [input (List Analysis)]) + (exception.report + "Input" (exception.listing /.format input))) + +(exception: .public (unconsumed_input [input (List Analysis)]) + (exception.report + "Input" (exception.listing /.format input))) + +(type: .public Parser + (//.Parser (List Analysis))) + +(def: .public (result parser input) + (All (_ a) (-> (Parser a) (List Analysis) (Try a))) + (case (parser input) + {try.#Failure error} + {try.#Failure error} + + {try.#Success [{.#End} value]} + {try.#Success value} + + {try.#Success [unconsumed _]} + (exception.except ..unconsumed_input unconsumed))) + +(def: .public any + (Parser Analysis) + (function (_ input) + (case input + {.#End} + (exception.except ..cannot_parse input) + + {.#Item [head tail]} + {try.#Success [tail head]}))) + +(def: .public end + (Parser Any) + (function (_ tokens) + (case tokens + {.#End} {try.#Success [tokens []]} + _ {try.#Failure (format "Expected list of tokens to be empty!" + (remaining_inputs tokens))}))) + +(def: .public end? + (Parser Bit) + (function (_ tokens) + {try.#Success [tokens (case tokens + {.#End} true + _ false)]})) + +(with_template [<query> <assertion> <tag> <type> <eq>] + [(`` (these (def: .public <query> + (Parser <type>) + (function (_ input) + (case input + (pattern (partial_list (<tag> x) input')) + {try.#Success [input' x]} + + _ + (exception.except ..cannot_parse input)))) + + (def: .public (<assertion> expected) + (-> <type> (Parser Any)) + (function (_ input) + (case input + (pattern (partial_list (<tag> actual) input')) + (if (at <eq> = expected actual) + {try.#Success [input' []]} + (exception.except ..cannot_parse input)) + + _ + (exception.except ..cannot_parse input))))))] + + [bit this_bit /.bit Bit bit.equivalence] + [nat this_nat /.nat Nat nat.equivalence] + [int this_int /.int Int int.equivalence] + [rev this_rev /.rev Rev rev.equivalence] + [frac this_frac /.frac Frac frac.equivalence] + [text this_text /.text Text text.equivalence] + [local this_local /.local Nat nat.equivalence] + [foreign this_foreign /.foreign Nat nat.equivalence] + [constant this_constant /.constant Symbol symbol.equivalence] + ) + +(def: .public (tuple parser) + (All (_ a) (-> (Parser a) (Parser a))) + (function (_ input) + (case input + (pattern (partial_list (/.tuple head) tail)) + (do try.monad + [output (..result parser head)] + {try.#Success [tail output]}) + + _ + (exception.except ..cannot_parse input)))) |