aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/parser
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/parser')
-rw-r--r--stdlib/source/parser/lux/data/text.lux406
-rw-r--r--stdlib/source/parser/lux/tool/compiler/language/lux/analysis.lux133
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))))