aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/control/parser
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/parser/analysis.lux140
-rw-r--r--stdlib/source/lux/control/parser/code.lux6
-rw-r--r--stdlib/source/lux/control/parser/synthesis.lux39
3 files changed, 177 insertions, 8 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))))
diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux
index 5ea2247d6..30344aaa0 100644
--- a/stdlib/source/lux/control/parser/code.lux
+++ b/stdlib/source/lux/control/parser/code.lux
@@ -152,9 +152,9 @@
{#.doc "Checks whether there are no more inputs."}
(Parser Bit)
(function (_ tokens)
- (case tokens
- #.Nil (#try.Success [tokens #1])
- _ (#try.Success [tokens #0]))))
+ (#try.Success [tokens (case tokens
+ #.Nil true
+ _ false)])))
(def: #export (run syntax inputs)
(All [a] (-> (Parser a) (List Code) (Try a)))
diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux
index 8fdeb4911..0c52b878c 100644
--- a/stdlib/source/lux/control/parser/synthesis.lux
+++ b/stdlib/source/lux/control/parser/synthesis.lux
@@ -13,14 +13,26 @@
["n" nat]
["." frac]]
["." text
- ["%" format (#+ format)]]]
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#@." functor)]]]
[tool
[compiler
+ [reference (#+)]
[arity (#+ Arity)]
[analysis (#+ Variant Tuple Environment)]
["/" synthesis (#+ Synthesis Abstraction)]]]]
["." //])
+(def: (remaining-inputs asts)
+ (-> (List Synthesis) Text)
+ (format text.new-line "Remaining input: "
+ (|> asts
+ (list@map /.%synthesis)
+ (list.interpose " ")
+ (text.join-with ""))))
+
+## TODO: Use "type:" ASAP.
(def: Input Type (type (List Synthesis)))
(exception: #export (cannot-parse {input ..Input})
@@ -41,8 +53,8 @@
(type: #export Parser
(//.Parser ..Input))
-(def: #export (run input parser)
- (All [a] (-> ..Input (Parser a) (Try a)))
+(def: #export (run parser input)
+ (All [a] (-> (Parser a) ..Input (Try a)))
(case (parser input)
(#try.Failure error)
(#try.Failure error)
@@ -63,6 +75,23 @@
(#.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>)
@@ -101,7 +130,7 @@
(case input
(^ (list& (/.tuple head) tail))
(do try.monad
- [output (..run head parser)]
+ [output (..run parser head)]
(#try.Success [tail output]))
_
@@ -114,7 +143,7 @@
(^ (list& (/.function/abstraction [environment actual body]) tail))
(if (n.= expected actual)
(do try.monad
- [output (..run (list body) parser)]
+ [output (..run parser (list body))]
(#try.Success [tail [environment output]]))
(exception.throw ..wrong-arity [expected actual]))
generated by cgit v1.2.3 (git 2.25.1) at 2025-07-04 06:29:37 +0000