From 9c21fd1f33eb52fb971d493ad21a67036d68b841 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 12 Jun 2022 02:29:28 -0400 Subject: Re-named the "poly" hierarchy to "polytypic". --- .../source/library/lux/control/parser/analysis.lux | 135 ------- stdlib/source/library/lux/control/parser/text.lux | 406 ------------------- stdlib/source/library/lux/data/format/json.lux | 4 +- stdlib/source/library/lux/data/format/xml.lux | 6 +- stdlib/source/library/lux/data/text/regex.lux | 3 +- stdlib/source/library/lux/extension.lux | 7 +- stdlib/source/library/lux/ffi/export.rb.lux | 8 +- stdlib/source/library/lux/math/modular.lux | 4 +- stdlib/source/library/lux/meta/configuration.lux | 4 +- .../source/library/lux/target/jvm/reflection.lux | 7 +- .../source/library/lux/target/jvm/type/alias.lux | 6 +- stdlib/source/library/lux/target/jvm/type/lux.lux | 6 +- .../source/library/lux/target/jvm/type/parser.lux | 10 +- stdlib/source/library/lux/time.lux | 8 +- stdlib/source/library/lux/time/date.lux | 8 +- stdlib/source/library/lux/time/duration.lux | 8 +- stdlib/source/library/lux/time/instant.lux | 8 +- stdlib/source/library/lux/time/year.lux | 8 +- .../language/lux/phase/extension/analysis/jvm.lux | 6 +- .../language/lux/phase/extension/directive/jvm.lux | 6 +- .../lux/phase/extension/generation/jvm/host.lux | 4 +- .../lux/tool/compiler/language/lux/syntax.lux | 2 +- .../source/library/lux/tool/compiler/meta/cli.lux | 6 +- .../lux/tool/compiler/meta/cli/compiler.lux | 6 +- stdlib/source/parser/lux/data/text.lux | 406 +++++++++++++++++++ .../lux/tool/compiler/language/lux/analysis.lux | 133 ++++++ stdlib/source/poly/lux/abstract/equivalence.lux | 167 -------- stdlib/source/poly/lux/abstract/functor.lux | 110 ----- stdlib/source/poly/lux/data/format/json.lux | 335 ---------------- .../source/polytypic/lux/abstract/equivalence.lux | 167 ++++++++ stdlib/source/polytypic/lux/abstract/functor.lux | 110 +++++ stdlib/source/polytypic/lux/data/format/json.lux | 335 ++++++++++++++++ .../source/program/aedifex/artifact/snapshot.lux | 5 +- .../program/aedifex/artifact/snapshot/build.lux | 8 +- .../program/aedifex/artifact/snapshot/stamp.lux | 5 +- .../program/aedifex/artifact/snapshot/time.lux | 6 +- .../program/aedifex/artifact/snapshot/version.lux | 6 +- stdlib/source/program/aedifex/artifact/time.lux | 10 +- .../source/program/aedifex/artifact/time/date.lux | 10 +- .../source/program/aedifex/artifact/time/time.lux | 8 +- .../source/program/aedifex/artifact/versioning.lux | 6 +- .../source/program/aedifex/metadata/artifact.lux | 4 +- .../source/program/aedifex/metadata/snapshot.lux | 4 +- .../source/test/aedifex/artifact/snapshot/time.lux | 7 +- .../aedifex/artifact/snapshot/version/value.lux | 7 +- stdlib/source/test/aedifex/artifact/time.lux | 7 +- stdlib/source/test/aedifex/artifact/time/date.lux | 7 +- stdlib/source/test/aedifex/artifact/time/time.lux | 7 +- stdlib/source/test/lux/abstract/equivalence.lux | 79 +++- stdlib/source/test/lux/abstract/functor.lux | 31 +- stdlib/source/test/lux/control/parser.lux | 4 - stdlib/source/test/lux/control/parser/analysis.lux | 156 -------- stdlib/source/test/lux/control/parser/text.lux | 444 --------------------- stdlib/source/test/lux/data/format/json.lux | 106 ++++- stdlib/source/test/lux/data/text.lux | 440 +++++++++++++++++++- stdlib/source/test/lux/data/text/regex.lux | 4 +- stdlib/source/test/lux/extension.lux | 4 +- stdlib/source/test/lux/meta/configuration.lux | 4 +- stdlib/source/test/lux/time.lux | 7 +- stdlib/source/test/lux/time/date.lux | 9 +- .../lux/tool/compiler/language/lux/analysis.lux | 162 +++++++- .../test/lux/tool/compiler/meta/cli/compiler.lux | 7 +- stdlib/source/test/lux/type.lux | 2 - stdlib/source/test/lux/type/poly.lux | 20 - stdlib/source/test/lux/type/poly/equivalence.lux | 89 ----- stdlib/source/test/lux/type/poly/functor.lux | 38 -- stdlib/source/test/lux/type/poly/json.lux | 124 ------ 67 files changed, 2084 insertions(+), 2192 deletions(-) delete mode 100644 stdlib/source/library/lux/control/parser/analysis.lux delete mode 100644 stdlib/source/library/lux/control/parser/text.lux create mode 100644 stdlib/source/parser/lux/data/text.lux create mode 100644 stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux delete mode 100644 stdlib/source/poly/lux/abstract/equivalence.lux delete mode 100644 stdlib/source/poly/lux/abstract/functor.lux delete mode 100644 stdlib/source/poly/lux/data/format/json.lux create mode 100644 stdlib/source/polytypic/lux/abstract/equivalence.lux create mode 100644 stdlib/source/polytypic/lux/abstract/functor.lux create mode 100644 stdlib/source/polytypic/lux/data/format/json.lux delete mode 100644 stdlib/source/test/lux/control/parser/analysis.lux delete mode 100644 stdlib/source/test/lux/control/parser/text.lux delete mode 100644 stdlib/source/test/lux/type/poly.lux delete mode 100644 stdlib/source/test/lux/type/poly/equivalence.lux delete mode 100644 stdlib/source/test/lux/type/poly/functor.lux delete mode 100644 stdlib/source/test/lux/type/poly/json.lux (limited to 'stdlib/source') diff --git a/stdlib/source/library/lux/control/parser/analysis.lux b/stdlib/source/library/lux/control/parser/analysis.lux deleted file mode 100644 index ebf4f2ec6..000000000 --- a/stdlib/source/library/lux/control/parser/analysis.lux +++ /dev/null @@ -1,135 +0,0 @@ -(.using - [library - [lux (.except nat int rev local) - [abstract - [monad (.only do)]] - [control - ["[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)]] - [language - [lux - ["/" analysis (.only Environment Analysis)]]]]]]] - ["[0]" //]) - -(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 [ ] - [(`` (these (def: .public - (Parser ) - (function (_ input) - (case input - (pattern (partial_list ( x) input')) - {try.#Success [input' x]} - - _ - (exception.except ..cannot_parse input)))) - - (def: .public ( expected) - (-> (Parser Any)) - (function (_ input) - (case input - (pattern (partial_list ( actual) input')) - (if (at = 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)))) diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux deleted file mode 100644 index fbe318d12..000000000 --- a/stdlib/source/library/lux/control/parser/text.lux +++ /dev/null @@ -1,406 +0,0 @@ -(.using - [library - [lux (.except and not local) - [abstract - [monad (.only Monad do)]] - [control - ["[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)]]]]] - ["[0]" //]) - -(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 [ ] - [(`` (def: .public ( parser) - (All (_ a) (-> (Parser a) (Parser ))) - (function (_ input) - (case (parser input) - {try.#Failure msg} - ( 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 [ ] - [(def: .public - (Parser Text) - (..range (char ) (char ))) - - (def: .public - (Parser Slice) - (..range! (char ) (char )))] - - ["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 [] - [(exception: .public ( [options Text - character Char]) - (exception.report - "Options" (/.format options) - "Character" (/.format (/.of_char character))))] - - [character_should_be] - [character_should_not_be] - ) - -(with_template [ ] - [(def: .public ( options) - (-> Text (Parser Text)) - (function (_ [offset tape]) - (case (/.char offset tape) - {.#Some output} - (let [output' (/.of_char output)] - (if ( (/.contains? output' options)) - {try.#Success [[("lux i64 +" 1 offset) tape] output']} - (exception.except [options output]))) - - _ - (exception.except ..cannot_parse []))))] - - [one_of |> ..character_should_be] - [none_of .not ..character_should_not_be] - ) - -(with_template [ ] - [(def: .public ( options) - (-> Text (Parser Slice)) - (function (_ [offset tape]) - (case (/.char offset tape) - {.#Some output} - (let [output' (/.of_char output)] - (if ( (/.contains? output' options)) - {try.#Success [[("lux i64 +" 1 offset) tape] - [#basis offset - #distance 1]]} - (exception.except [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 [ ] - [(def: .public ( parser) - (-> (Parser Text) (Parser Text)) - (|> parser (at //.monad each /.together)))] - - [some //.some "some"] - [many //.many "many"] - ) - -(with_template [ ] - [(def: .public ( parser) - (-> (Parser Slice) (Parser Slice)) - (with_slices ( parser)))] - - [some! //.some "some"] - [many! //.many "many"] - ) - -(with_template [ ] - [(def: .public ( amount parser) - (-> Nat (Parser Text) (Parser Text)) - (|> parser - ( amount) - (at //.monad each /.together)))] - - [exactly //.exactly "exactly"] - [at_most //.at_most "at most"] - [at_least //.at_least "at least"] - ) - -(with_template [ ] - [(def: .public ( amount parser) - (-> Nat (Parser Slice) (Parser Slice)) - (with_slices - ( 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/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 4f95615ed..3a0e69a6c 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -12,12 +12,12 @@ ["[0]" maybe] ["[0]" try (.only Try)] ["<>" parser (.open: "[1]#[0]" monad) - ["<[0]>" text (.only Parser)] ["<[0]>" code]]] [data ["[0]" bit] ["[0]" product] - ["[0]" text (.open: "[1]#[0]" equivalence monoid)] + ["[0]" text (.open: "[1]#[0]" equivalence monoid) + ["<[1]>" \\parser (.only Parser)]] [collection ["[0]" list (.open: "[1]#[0]" mix functor)] ["[0]" sequence (.only Sequence sequence) (.open: "[1]#[0]" monad)] diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index 1fa0a04ac..dfab48227 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -7,11 +7,11 @@ [codec (.only Codec)]] [control [try (.only Try)] - ["<>" parser (.open: "[1]#[0]" monad) - ["<[0]>" text (.only Parser Slice)]]] + ["<>" parser (.open: "[1]#[0]" monad)]] [data ["[0]" product] - ["[0]" text (.only \n) (.open: "[1]#[0]" equivalence monoid)] + ["[0]" text (.only \n) (.open: "[1]#[0]" equivalence monoid) + ["<[1]>" \\parser (.only Parser Slice)]] [collection ["[0]" list (.open: "[1]#[0]" functor)] ["[0]" dictionary (.only Dictionary)]]] diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index 8e48c00d4..38908a999 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -9,10 +9,11 @@ ["[0]" try] ["[0]" exception (.only exception:)] ["<>" parser (.open: "[1]#[0]" monad) - ["<[0]>" text (.only Parser)] ["<[0]>" code]]] [data ["[0]" product] + ["[0]" text + ["<[1]>" \\parser (.only Parser)]] [collection ["[0]" list (.open: "[1]#[0]" mix monad)]]] [macro (.only with_symbols) diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index ffe7a4a78..90033a988 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -6,7 +6,6 @@ [control ["<>" parser (.open: "[1]#[0]" monad) ["" code (.only Parser)] - ["" analysis] ["" synthesis]]] [data ["[0]" product] @@ -17,7 +16,11 @@ ["[0]" code]] [tool [compiler - ["[0]" phase]]]]]) + ["[0]" phase] + [language + [lux + [analysis + ["" \\parser]]]]]]]]) (type: Declaration (Record diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index 46c259fbe..00702d7cf 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -9,11 +9,11 @@ ["[0]" monad (.only do)]] [control ["<>" parser (.only) - ["<[0]>" code] - ["<[0]>" text (.only Parser)]]] + ["<[0]>" code]]] [data - [text - ["%" format]] + ["[0]" text + ["%" format] + ["<[1]>" \\parser (.only Parser)]] [collection ["[0]" list (.open: "[1]#[0]" monad mix)] ["[0]" set]]] diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index 09e1b6a31..a46f67418 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -11,11 +11,11 @@ ["[0]" try (.only Try)] ["[0]" exception (.only exception:)] ["<>" parser (.only) - ["<[0]>" text (.only Parser)] ["<[0]>" code]]] [data ["[0]" product] - ["[0]" text (.open: "[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]]] [macro ["[0]" code]] [math diff --git a/stdlib/source/library/lux/meta/configuration.lux b/stdlib/source/library/lux/meta/configuration.lux index cf6675195..6e6ed68bb 100644 --- a/stdlib/source/library/lux/meta/configuration.lux +++ b/stdlib/source/library/lux/meta/configuration.lux @@ -10,11 +10,11 @@ ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)] ["<>" parser (.only) - ["<[0]>" text (.only Parser)] ["<[0]>" code]]] [data ["[0]" text (.open: "[1]#[0]" equivalence) - ["%" format]] + ["%" format] + ["<[1]>" \\parser (.only Parser)]] [collection ["[0]" list (.open: "[1]#[0]" functor mix)] [dictionary diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index 5a76db47d..3548f5c19 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -7,12 +7,11 @@ ["[0]" monad (.only do)]] [control ["[0]" try (.only Try) (.open: "[1]#[0]" functor)] - ["[0]" exception (.only exception:)] - [parser - ["" text]]] + ["[0]" exception (.only exception:)]] [data ["[0]" text (.open: "[1]#[0]" equivalence) - ["%" format (.only format)]] + ["%" format (.only format)] + ["" \\parser]] [collection ["[0]" list (.open: "[1]#[0]" mix functor)] ["[0]" array] diff --git a/stdlib/source/library/lux/target/jvm/type/alias.lux b/stdlib/source/library/lux/target/jvm/type/alias.lux index 2d6cb7c49..eb1dc6341 100644 --- a/stdlib/source/library/lux/target/jvm/type/alias.lux +++ b/stdlib/source/library/lux/target/jvm/type/alias.lux @@ -7,11 +7,11 @@ ["[0]" maybe] ["[0]" try] ["[0]" exception (.only exception:)] - ["<>" parser (.only) - ["<[0]>" text (.only Parser)]]] + ["<>" parser (.only)]] [data ["[0]" text (.only) - ["%" format (.only format)]] + ["%" format (.only format)] + ["<[1]>" \\parser (.only Parser)]] [collection ["[0]" dictionary (.only Dictionary)]]]]] ["[0]" // (.only Type) diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux index 96fa31b11..351d9c490 100644 --- a/stdlib/source/library/lux/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/target/jvm/type/lux.lux @@ -6,12 +6,12 @@ [control ["[0]" try] ["[0]" exception (.only exception:)] - ["<>" parser (.open: "[1]#[0]" monad) - ["<[0]>" text (.only Parser)]]] + ["<>" parser (.open: "[1]#[0]" monad)]] [data ["[0]" product] ["[0]" text (.open: "[1]#[0]" equivalence) - ["%" format (.only format)]] + ["%" format (.only format)] + ["<[1]>" \\parser (.only Parser)]] [collection ["[0]" array] ["[0]" dictionary (.only Dictionary)]]] diff --git a/stdlib/source/library/lux/target/jvm/type/parser.lux b/stdlib/source/library/lux/target/jvm/type/parser.lux index 166b2d984..53bd29aa0 100644 --- a/stdlib/source/library/lux/target/jvm/type/parser.lux +++ b/stdlib/source/library/lux/target/jvm/type/parser.lux @@ -4,14 +4,14 @@ [abstract [monad (.only do)]] [control + ["<>" parser (.open: "[1]#[0]" monad)] ["[0]" try] - ["[0]" function] - ["<>" parser (.open: "[1]#[0]" monad) - ["<[0]>" text (.only Parser)]]] + ["[0]" function]] [data ["[0]" product] - [text - ["%" format (.only format)]] + ["[0]" text + ["%" format (.only format)] + ["<[1]>" \\parser (.only Parser)]] [collection ["[0]" list]]]]] ["[0]" // (.only Type) diff --git a/stdlib/source/library/lux/time.lux b/stdlib/source/library/lux/time.lux index 532961dcb..07f3dcb94 100644 --- a/stdlib/source/library/lux/time.lux +++ b/stdlib/source/library/lux/time.lux @@ -8,13 +8,13 @@ [codec (.only Codec)] [monad (.only Monad do)]] [control + ["<>" parser (.only)] ["[0]" pipe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception:)] - ["<>" parser (.only) - ["<[0]>" text (.only Parser)]]] + ["[0]" exception (.only exception:)]] [data - ["[0]" text (.open: "[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]]] [math [number ["n" nat (.open: "[1]#[0]" decimal)]]] diff --git a/stdlib/source/library/lux/time/date.lux b/stdlib/source/library/lux/time/date.lux index 54d7a90ff..3419b07ea 100644 --- a/stdlib/source/library/lux/time/date.lux +++ b/stdlib/source/library/lux/time/date.lux @@ -8,13 +8,13 @@ [codec (.only Codec)] [monad (.only do)]] [control + ["<>" parser (.only)] ["[0]" maybe] ["[0]" try (.only Try)] - ["[0]" exception (.only exception:)] - ["<>" parser (.only) - ["<[0]>" text (.only Parser)]]] + ["[0]" exception (.only exception:)]] [data - ["[0]" text (.open: "[1]#[0]" monoid)] + ["[0]" text (.open: "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]] [collection ["[0]" list (.open: "[1]#[0]" mix)] ["[0]" dictionary (.only Dictionary)]]] diff --git a/stdlib/source/library/lux/time/duration.lux b/stdlib/source/library/lux/time/duration.lux index c9869c08c..e59e4c9f2 100644 --- a/stdlib/source/library/lux/time/duration.lux +++ b/stdlib/source/library/lux/time/duration.lux @@ -9,11 +9,11 @@ [monoid (.only Monoid)] [monad (.only do)]] [control - ["[0]" try] - ["<>" parser (.only) - ["<[0]>" text (.only Parser)]]] + ["<>" parser (.only)] + ["[0]" try]] [data - ["[0]" text (.open: "[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]]] [math [number ["i" int] diff --git a/stdlib/source/library/lux/time/instant.lux b/stdlib/source/library/lux/time/instant.lux index 366bfe020..2f8bbd980 100644 --- a/stdlib/source/library/lux/time/instant.lux +++ b/stdlib/source/library/lux/time/instant.lux @@ -10,13 +10,13 @@ [monad (.only Monad do)]] [control [io (.only IO io)] + ["<>" parser (.only)] ["[0]" maybe] ["[0]" try] - ["[0]" exception (.only exception:)] - ["<>" parser (.only) - ["<[0]>" text (.only Parser)]]] + ["[0]" exception (.only exception:)]] [data - ["[0]" text (.open: "[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]]] [math [number ["i" int] diff --git a/stdlib/source/library/lux/time/year.lux b/stdlib/source/library/lux/time/year.lux index 135607980..a815cbd1c 100644 --- a/stdlib/source/library/lux/time/year.lux +++ b/stdlib/source/library/lux/time/year.lux @@ -7,12 +7,12 @@ [equivalence (.only Equivalence)] [order (.only Order)]] [control + ["<>" parser (.only)] ["[0]" try (.only Try)] - ["[0]" exception (.only exception:)] - ["<>" parser (.only) - ["<[0]>" text (.only Parser)]]] + ["[0]" exception (.only exception:)]] [data - ["[0]" text (.open: "[1]#[0]" monoid)]] + ["[0]" text (.open: "[1]#[0]" monoid) + ["<[1]>" \\parser (.only Parser)]]] [math [number ["n" nat (.open: "[1]#[0]" decimal)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index c5044dba6..7835a454b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -12,13 +12,13 @@ ["[0]" try (.only Try) (.open: "[1]#[0]" monad)] ["[0]" exception (.only exception:)] ["<>" parser (.only) - ["<[0]>" code (.only Parser)] - ["<[0]>" text]]] + ["<[0]>" code (.only Parser)]]] [data [binary (.only Binary)] ["[0]" product] ["[0]" text (.open: "[1]#[0]" equivalence) - ["%" format (.only format)]] + ["%" format (.only format)] + ["<[1]>" \\parser]] [collection ["[0]" list (.open: "[1]#[0]" mix monad monoid)] ["[0]" array] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index e6c308b21..ff87daec1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -10,13 +10,13 @@ ["[0]" exception] ["<>" parser (.open: "[1]#[0]" monad) ["<[0]>" code (.only Parser)] - ["<[0]>" text] ["<[0]>" synthesis]]] [data [binary (.only Binary)] ["[0]" product] - [text - ["%" format (.only format)]] + ["[0]" text + ["%" format (.only format)] + ["<[1]>" \\parser]] [collection ["[0]" list (.open: "[1]#[0]" functor mix)] ["[0]" dictionary] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index 202f4b5e0..3bb78789c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -7,12 +7,12 @@ ["[0]" maybe (.open: "[1]#[0]" functor)] ["[0]" exception (.only exception:)] ["<>" parser (.only) - ["<[0]>" text] ["<[0]>" synthesis (.only Parser)]]] [data ["[0]" product] ["[0]" text (.open: "[1]#[0]" equivalence) - ["%" format]] + ["%" format] + ["<[1]>" \\parser]] [collection ["[0]" list (.open: "[1]#[0]" monad mix monoid)] ["[0]" dictionary (.only Dictionary)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux index d0bc4dbdc..6bde519da 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux @@ -34,10 +34,10 @@ ["[0]" maybe] ["[0]" exception (.only exception:)] ["<>" parser (.only) - [text (.only Offset)] ["<[0]>" code]]] [data ["[0]" text (.only) + [\\parser (.only Offset)] ["%" format (.only format)]] [collection ["[0]" list] diff --git a/stdlib/source/library/lux/tool/compiler/meta/cli.lux b/stdlib/source/library/lux/tool/compiler/meta/cli.lux index 40ae2eb84..d8ea47bf1 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cli.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cli.lux @@ -7,12 +7,12 @@ [control ["[0]" pipe] ["<>" parser (.only) - ["<[0]>" cli (.only Parser)] - ["<[0]>" text]]] + ["<[0]>" cli (.only Parser)]]] [data ["[0]" product] ["[0]" text (.only) - ["%" format]] + ["%" format] + ["<[1]>" \\parser]] [collection ["[0]" list (.open: "[1]#[0]" functor)]]] [macro diff --git a/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux b/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux index 84107e91d..317506075 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux @@ -5,12 +5,12 @@ [monad (.only do)] [equivalence (.only Equivalence)]] [control - ["<>" parser (.only) - ["<[0]>" text (.only Parser)]]] + ["<>" parser (.only)]] [data ["[0]" product] ["[0]" text (.only) - ["%" format]] + ["%" format] + ["<[1]>" \\parser (.only Parser)]] [collection ["[0]" list (.open: "[1]#[0]" functor)]]] [math 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 [ ] + [(`` (def: .public ( parser) + (All (_ a) (-> (Parser a) (Parser ))) + (function (_ input) + (case (parser input) + {try.#Failure msg} + ( 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 [ ] + [(def: .public + (Parser Text) + (..range (char ) (char ))) + + (def: .public + (Parser Slice) + (..range! (char ) (char )))] + + ["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 [] + [(exception: .public ( [options Text + character Char]) + (exception.report + "Options" (/.format options) + "Character" (/.format (/.of_char character))))] + + [character_should_be] + [character_should_not_be] + ) + +(with_template [ ] + [(def: .public ( options) + (-> Text (Parser Text)) + (function (_ [offset tape]) + (case (/.char offset tape) + {.#Some output} + (let [output' (/.of_char output)] + (if ( (/.contains? output' options)) + {try.#Success [[("lux i64 +" 1 offset) tape] output']} + (exception.except [options output]))) + + _ + (exception.except ..cannot_parse []))))] + + [one_of |> ..character_should_be] + [none_of .not ..character_should_not_be] + ) + +(with_template [ ] + [(def: .public ( options) + (-> Text (Parser Slice)) + (function (_ [offset tape]) + (case (/.char offset tape) + {.#Some output} + (let [output' (/.of_char output)] + (if ( (/.contains? output' options)) + {try.#Success [[("lux i64 +" 1 offset) tape] + [#basis offset + #distance 1]]} + (exception.except [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 [ ] + [(def: .public ( parser) + (-> (Parser Text) (Parser Text)) + (|> parser (at //.monad each /.together)))] + + [some //.some "some"] + [many //.many "many"] + ) + +(with_template [ ] + [(def: .public ( parser) + (-> (Parser Slice) (Parser Slice)) + (with_slices ( parser)))] + + [some! //.some "some"] + [many! //.many "many"] + ) + +(with_template [ ] + [(def: .public ( amount parser) + (-> Nat (Parser Text) (Parser Text)) + (|> parser + ( amount) + (at //.monad each /.together)))] + + [exactly //.exactly "exactly"] + [at_most //.at_most "at most"] + [at_least //.at_least "at least"] + ) + +(with_template [ ] + [(def: .public ( amount parser) + (-> Nat (Parser Slice) (Parser Slice)) + (with_slices + ( 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 [ ] + [(`` (these (def: .public + (Parser ) + (function (_ input) + (case input + (pattern (partial_list ( x) input')) + {try.#Success [input' x]} + + _ + (exception.except ..cannot_parse input)))) + + (def: .public ( expected) + (-> (Parser Any)) + (function (_ input) + (case input + (pattern (partial_list ( actual) input')) + (if (at = 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)))) diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux deleted file mode 100644 index 1e882e32d..000000000 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ /dev/null @@ -1,167 +0,0 @@ -(.using - [library - [lux (.except) - [abstract - [monad (.only Monad do)]] - [control - ["[0]" maybe] - ["<>" parser (.only) - ["<[0]>" type]]] - [data - ["[0]" product] - ["[0]" bit] - ["[0]" text (.open: "[1]#[0]" monoid) - ["%" format (.only format)]] - [collection - ["[0]" list (.open: "[1]#[0]" monad)] - ["[0]" sequence] - ["[0]" array] - ["[0]" queue] - ["[0]" set] - ["[0]" dictionary (.only Dictionary)] - ["[0]" tree]]] - [macro - ["[0]" code]] - [math - [number - ["[0]" nat (.open: "[1]#[0]" decimal)] - ["[0]" int] - ["[0]" rev] - ["[0]" frac]]] - [time - ["[0]" duration] - ["[0]" date] - ["[0]" instant] - ["[0]" day] - ["[0]" month]] - ["[0]" type (.only) - ["[0]" poly (.only poly:)] - ["[0]" unit]]]] - [\\library - ["[0]" /]]) - -(poly: .public equivalence - (`` (do [! <>.monad] - [.let [g!_ (code.local "_____________")] - *env* .env - inputT .next - .let [@Equivalence (is (-> Type Code) - (function (_ type) - (` ((~! /.Equivalence) (~ (poly.code *env* type))))))]] - (all <>.either - ... Basic types - (~~ (with_template [ ] - [(do ! - [_ ] - (in (` (is (~ (@Equivalence inputT)) - ))))] - - [(.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)] - [(.sub Bit) (~! bit.equivalence)] - [(.sub Nat) (~! nat.equivalence)] - [(.sub Int) (~! int.equivalence)] - [(.sub Rev) (~! rev.equivalence)] - [(.sub Frac) (~! frac.equivalence)] - [(.sub Text) (~! text.equivalence)])) - ... Composite types - (~~ (with_template [ ] - [(do ! - [[_ argC] (.applied (<>.and (.exactly ) - equivalence))] - (in (` (is (~ (@Equivalence inputT)) - ( (~ argC))))))] - - [.Maybe (~! maybe.equivalence)] - [.List (~! list.equivalence)] - [sequence.Sequence (~! sequence.equivalence)] - [array.Array (~! array.equivalence)] - [queue.Queue (~! queue.equivalence)] - [set.Set (~! set.equivalence)] - [tree.Tree (~! tree.equivalence)] - )) - (do ! - [[_ _ valC] (.applied (all <>.and - (.exactly dictionary.Dictionary) - .any - equivalence))] - (in (` (is (~ (@Equivalence inputT)) - ((~! dictionary.equivalence) (~ valC)))))) - ... Models - (~~ (with_template [ ] - [(do ! - [_ (.exactly )] - (in (` (is (~ (@Equivalence inputT)) - ))))] - - [duration.Duration duration.equivalence] - [instant.Instant instant.equivalence] - [date.Date date.equivalence] - [day.Day day.equivalence] - [month.Month month.equivalence] - )) - (do ! - [_ (.applied (<>.and (.exactly unit.Qty) - .any))] - (in (` (is (~ (@Equivalence inputT)) - unit.equivalence)))) - ... Variants - (do ! - [members (.variant (<>.many equivalence)) - .let [last (-- (list.size members)) - g!_ (code.local "_____________") - g!left (code.local "_____________left") - g!right (code.local "_____________right")]] - (in (` (is (~ (@Equivalence inputT)) - (function ((~ g!_) (~ g!left) (~ g!right)) - (case [(~ g!left) (~ g!right)] - (~+ (list#conjoint (list#each (function (_ [tag g!eq]) - (if (nat.= last tag) - (list (` [{(~ (code.nat (-- tag))) #1 (~ g!left)} - {(~ (code.nat (-- tag))) #1 (~ g!right)}]) - (` ((~ g!eq) (~ g!left) (~ g!right)))) - (list (` [{(~ (code.nat tag)) #0 (~ g!left)} - {(~ (code.nat tag)) #0 (~ g!right)}]) - (` ((~ g!eq) (~ g!left) (~ g!right)))))) - (list.enumeration members)))) - (~ g!_) - #0)))))) - ... Tuples - (do ! - [g!eqs (.tuple (<>.many equivalence)) - .let [g!_ (code.local "_____________") - indices (list.indices (list.size g!eqs)) - g!lefts (list#each (|>> nat#encoded (text#composite "left") code.local) indices) - g!rights (list#each (|>> nat#encoded (text#composite "right") code.local) indices)]] - (in (` (is (~ (@Equivalence inputT)) - (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) - (and (~+ (|> (list.zipped_3 g!eqs g!lefts g!rights) - (list#each (function (_ [g!eq g!left g!right]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) - ... Type recursion - (do ! - [[g!self bodyC] (.recursive equivalence) - .let [g!_ (code.local "_____________")]] - (in (` (is (~ (@Equivalence inputT)) - ((~! /.rec) (.function ((~ g!_) (~ g!self)) - (~ bodyC))))))) - .recursive_self - ... Type applications - (do ! - [[funcC argsC] (.applied (<>.and equivalence (<>.many equivalence)))] - (in (` ((~ funcC) (~+ argsC))))) - ... Parameters - .parameter - ... Polymorphism - (do ! - [[funcC varsC bodyC] (.polymorphic equivalence)] - (in (` (is (All ((~ g!_) (~+ varsC)) - (-> (~+ (list#each (|>> (~) ((~! /.Equivalence)) (`)) varsC)) - ((~! /.Equivalence) ((~ (poly.code *env* inputT)) (~+ varsC))))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) - .recursive_call - ... If all else fails... - (|> .any - (at ! each (|>> %.type (format "Cannot create Equivalence for: ") <>.failure)) - (at ! conjoint)) - )))) diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux deleted file mode 100644 index 310c3ff9a..000000000 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ /dev/null @@ -1,110 +0,0 @@ -(.using - [library - [lux (.except) - [abstract - [monad (.only Monad do)]] - [control - ["p" parser (.only) - ["<[0]>" type] - ["s" code (.only Parser)]]] - [data - ["[0]" product] - ["[0]" text (.only) - ["%" format (.only format)]] - [collection - ["[0]" list (.open: "[1]#[0]" monad monoid)]]] - [macro - ["[0]" code]] - [math - [number - ["n" nat]]] - ["[0]" type (.only) - ["[0]" poly (.only poly:)]]]] - [\\library - ["[0]" /]]) - -(poly: .public functor - (do [! p.monad] - [.let [g!_ (code.local "____________") - type_funcC (code.local "____________type_funcC") - funcC (code.local "____________funcC") - inputC (code.local "____________inputC")] - *env* .env - inputT .next - [polyC varsC non_functorT] (.local (list inputT) - (.polymorphic .any)) - .let [num_vars (list.size varsC)] - .let [@Functor (is (-> Type Code) - (function (_ unwrappedT) - (if (n.= 1 num_vars) - (` ((~! /.Functor) (~ (poly.code *env* unwrappedT)))) - (let [paramsC (|> num_vars -- list.indices (list#each (|>> %.nat code.local)))] - (` (All ((~ g!_) (~+ paramsC)) - ((~! /.Functor) ((~ (poly.code *env* unwrappedT)) (~+ paramsC))))))))) - Arg (is (-> Code (.Parser Code)) - (function (Arg valueC) - (all p.either - ... Type-var - (do p.monad - [.let [varI (|> num_vars (n.* 2) --)] - _ (.this_parameter varI)] - (in (` ((~ funcC) (~ valueC))))) - ... Variants - (do ! - [_ (in []) - membersC (.variant (p.many (Arg valueC))) - .let [last (-- (list.size membersC))]] - (in (` (case (~ valueC) - (~+ (list#conjoint (list#each (function (_ [tag memberC]) - (if (n.= last tag) - (list (` {(~ (code.nat (-- tag))) #1 (~ valueC)}) - (` {(~ (code.nat (-- tag))) #1 (~ memberC)})) - (list (` {(~ (code.nat tag)) #0 (~ valueC)}) - (` {(~ (code.nat tag)) #0 (~ memberC)})))) - (list.enumeration membersC)))))))) - ... Tuples - (do p.monad - [pairsCC (is (.Parser (List [Code Code])) - (.tuple (loop (again [idx 0 - pairsCC (is (List [Code Code]) - (list))]) - (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local)] - (do ! - [_ (in []) - memberC (Arg slotC)] - (again (++ idx) - (list#composite pairsCC (list [slotC memberC]))))) - (in pairsCC)))))] - (in (` (case (~ valueC) - [(~+ (list#each product.left pairsCC))] - [(~+ (list#each product.right pairsCC))])))) - ... Functions - (do ! - [_ (in []) - .let [g! (code.local "____________") - outL (code.local "____________outL")] - [inT+ outC] (.function (p.many .any) - (Arg outL)) - .let [inC+ (|> (list.size inT+) - list.indices - (list#each (|>> %.nat (format "____________inC") code.local)))]] - (in (` (function ((~ g!) (~+ inC+)) - (let [(~ outL) ((~ valueC) (~+ inC+))] - (~ outC)))))) - ... Recursion - (do p.monad - [_ .recursive_call] - (in (` ((~' each) (~ funcC) (~ valueC))))) - ... Parameters - (do p.monad - [_ .any] - (in valueC)) - )))] - [_ _ outputC] (is (.Parser [Code (List Code) Code]) - (p.either (.polymorphic - (Arg inputC)) - (p.failure (format "Cannot create Functor for: " (%.type inputT)))))] - (in (` (is (~ (@Functor inputT)) - (implementation - (def: ((~' each) (~ funcC) (~ inputC)) - (~ outputC)))))))) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux deleted file mode 100644 index 391556a50..000000000 --- a/stdlib/source/poly/lux/data/format/json.lux +++ /dev/null @@ -1,335 +0,0 @@ -(.using - [library - [lux (.except) - ["[0]" debug] - [abstract - [monad (.only do)] - ["[0]" codec]] - [control - ["[0]" try] - ["<>" parser (.only) - ["" json] - ["<[0]>" type] - ["<[0]>" code]]] - [data - ["[0]" text (.only) - ["%" format (.only format)]] - [collection - ["[0]" list (.open: "[1]#[0]" monad)] - ["[0]" sequence (.only sequence)] - ["[0]" dictionary]]] - [macro - [syntax (.only syntax)] - ["[0]" code]] - [math - [number - ["n" nat (.open: "[1]#[0]" decimal)] - ["[0]" i64] - ["[0]" int] - ["[0]" frac]]] - [time - ... ["[0]" instant] - ... ["[0]" duration] - ["[0]" date] - ["[0]" day] - ["[0]" month]] - ["[0]" type (.only) - ["[0]" unit] - ["[0]" poly (.only poly:)]]]] - [\\library - ["[0]" / (.only JSON)]]) - -(def: tag - (-> Nat Frac) - (|>> .int int.frac)) - -(def: (rec_encoded non_rec) - (All (_ a) (-> (-> (-> a JSON) - (-> a JSON)) - (-> a JSON))) - (function (_ input) - (non_rec (rec_encoded non_rec) input))) - -(def: low_mask Nat (|> 1 (i64.left_shifted 32) --)) -(def: high_mask Nat (|> low_mask (i64.left_shifted 32))) - -(implementation: nat_codec - (codec.Codec JSON Nat) - - (def: (encoded input) - (let [high (|> input (i64.and high_mask) (i64.right_shifted 32)) - low (i64.and low_mask input)] - {/.#Array (sequence (|> high .int int.frac {/.#Number}) - (|> low .int int.frac {/.#Number}))})) - (def: decoded - (.result (.array - (do <>.monad - [high .number - low .number] - (in (n.+ (|> high frac.int .nat (i64.left_shifted 32)) - (|> low frac.int .nat)))))))) - -(implementation: int_codec - (codec.Codec JSON Int) - - (def: encoded - (|>> .nat (at nat_codec encoded))) - (def: decoded - (|>> (at nat_codec decoded) (at try.functor each (|>> .int))))) - -... Builds a JSON generator for potentially inexistent values. -(def: (nullable writer) - (All (_ a) (-> (-> a JSON) (-> (Maybe a) JSON))) - (function (_ elem) - (case elem - {.#None} {/.#Null} - {.#Some value} (writer value)))) - -(implementation: qty_codec - (All (_ unit) - (codec.Codec JSON (unit.Qty unit))) - - (def: encoded - (|>> ((debug.private unit.out')) - (at ..int_codec encoded))) - (def: decoded - (|>> (at ..int_codec decoded) - (at try.functor each (debug.private unit.in'))))) - -(poly: encoded - (with_expansions - [ (with_template [ ] - [(do ! - [.let [g!_ (code.local "_______")] - _ ] - (in (` (is (~ (@JSON#encoded inputT)) - ))))] - - [(.exactly Any) (function ((~ g!_) (~ (code.symbol ["" "0"]))) {/.#Null})] - [(.sub Bit) (|>> {/.#Boolean})] - [(.sub Nat) (at (~! ..nat_codec) (~' encoded))] - [(.sub Int) (at (~! ..int_codec) (~' encoded))] - [(.sub Frac) (|>> {/.#Number})] - [(.sub Text) (|>> {/.#String})]) -