aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/macro/syntax.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/macro/syntax.lux')
-rw-r--r--stdlib/source/lux/macro/syntax.lux166
1 files changed, 83 insertions, 83 deletions
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index c0fda8a62..53ec26009 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -12,7 +12,7 @@
[ident]
(coll [list #* "" Functor<List> Fold<List> "List/" Monoid<List>])
[product]
- [error #- fail]))
+ ["R" result]))
(.. [code "Code/" Eq<Code>]))
## [Utils]
@@ -25,38 +25,38 @@
## [Types]
(type: #export (Syntax a)
{#;doc "A Lux syntax parser."}
- (-> (List Code) (Error [(List Code) a])))
+ (-> (List Code) (R;Result [(List Code) a])))
## [Structures]
(struct: #export _ (Functor Syntax)
(def: (map f ma)
(function [tokens]
(case (ma tokens)
- (#;Left msg)
- (#;Left msg)
+ (#R;Error msg)
+ (#R;Error msg)
- (#;Right [tokens' a])
- (#;Right [tokens' (f a)])))))
+ (#R;Success [tokens' a])
+ (#R;Success [tokens' (f a)])))))
(struct: #export _ (Applicative Syntax)
(def: functor Functor<Syntax>)
(def: (wrap x tokens)
- (#;Right [tokens x]))
+ (#R;Success [tokens x]))
(def: (apply ff fa)
(function [tokens]
(case (ff tokens)
- (#;Right [tokens' f])
+ (#R;Success [tokens' f])
(case (fa tokens')
- (#;Right [tokens'' a])
- (#;Right [tokens'' (f a)])
+ (#R;Success [tokens'' a])
+ (#R;Success [tokens'' (f a)])
- (#;Left msg)
- (#;Left msg))
+ (#R;Error msg)
+ (#R;Error msg))
- (#;Left msg)
- (#;Left msg)))))
+ (#R;Error msg)
+ (#R;Error msg)))))
(struct: #export _ (Monad Syntax)
(def: applicative Applicative<Syntax>)
@@ -64,10 +64,10 @@
(def: (join mma)
(function [tokens]
(case (mma tokens)
- (#;Left msg)
- (#;Left msg)
+ (#R;Error msg)
+ (#R;Error msg)
- (#;Right [tokens' ma])
+ (#R;Success [tokens' ma])
(ma tokens')))))
## [Utils]
@@ -82,8 +82,8 @@
(Syntax Code)
(function [tokens]
(case tokens
- #;Nil (#;Left "There are no tokens to parse!")
- (#;Cons [t tokens']) (#;Right [tokens' t]))))
+ #;Nil (#R;Error "There are no tokens to parse!")
+ (#;Cons [t tokens']) (#R;Success [tokens' t]))))
(do-template [<get-name> <type> <tag> <eq> <desc>]
[(def: #export <get-name>
@@ -92,10 +92,10 @@
(function [tokens]
(case tokens
(#;Cons [[_ (<tag> x)] tokens'])
- (#;Right [tokens' x])
+ (#R;Success [tokens' x])
_
- (#;Left ($_ Text/append "Cannot parse " <desc> (remaining-inputs tokens))))))]
+ (#R;Error ($_ Text/append "Cannot parse " <desc> (remaining-inputs tokens))))))]
[ bool Bool #;Bool bool;Eq<Bool> "bool"]
[ nat Nat #;Nat number;Eq<Nat> "nat"]
@@ -118,10 +118,10 @@
remaining (if is-it?
tokens'
tokens)]
- (#;Right [remaining is-it?]))
+ (#R;Success [remaining is-it?]))
_
- (#;Right [tokens false]))))
+ (#R;Success [tokens false]))))
(def: #export (this! ast)
{#;doc "Ensures the given Code is the next input."}
@@ -130,20 +130,20 @@
(case tokens
(#;Cons [token tokens'])
(if (Code/= ast token)
- (#;Right [tokens' []])
- (#;Left ($_ Text/append "Expected a " (code;to-text ast) " but instead got " (code;to-text token)
- (remaining-inputs tokens))))
+ (#R;Success [tokens' []])
+ (#R;Error ($_ Text/append "Expected a " (code;to-text ast) " but instead got " (code;to-text token)
+ (remaining-inputs tokens))))
_
- (#;Left "There are no tokens to parse!"))))
+ (#R;Error "There are no tokens to parse!"))))
(def: #export (assert message test)
{#;doc "Fails with the given message if the test is false."}
(-> Text Bool (Syntax Unit))
(function [tokens]
(if test
- (#;Right [tokens []])
- (#;Left ($_ Text/append message (remaining-inputs tokens))))))
+ (#R;Success [tokens []])
+ (#R;Error ($_ Text/append message (remaining-inputs tokens))))))
(do-template [<name> <comp> <error>]
[(def: #export <name>
@@ -164,10 +164,10 @@
(function [tokens]
(case tokens
(#;Cons [[_ (<tag> ["" x])] tokens'])
- (#;Right [tokens' x])
+ (#R;Success [tokens' x])
_
- (#;Left ($_ Text/append "Cannot parse local " <desc> (remaining-inputs tokens))))))]
+ (#R;Error ($_ Text/append "Cannot parse local " <desc> (remaining-inputs tokens))))))]
[local-symbol #;Symbol "symbol"]
[ local-tag #;Tag "tag"]
@@ -182,11 +182,11 @@
(case tokens
(#;Cons [[_ (<tag> members)] tokens'])
(case (p members)
- (#;Right [#;Nil x]) (#;Right [tokens' x])
- _ (#;Left ($_ Text/append "Syntax was expected to fully consume " <desc> (remaining-inputs tokens))))
+ (#R;Success [#;Nil x]) (#R;Success [tokens' x])
+ _ (#R;Error ($_ Text/append "Syntax was expected to fully consume " <desc> (remaining-inputs tokens))))
_
- (#;Left ($_ Text/append "Cannot parse " <desc> (remaining-inputs tokens))))))]
+ (#R;Error ($_ Text/append "Cannot parse " <desc> (remaining-inputs tokens))))))]
[ form #;Form "form"]
[tuple #;Tuple "tuple"]
@@ -200,11 +200,11 @@
(case tokens
(#;Cons [[_ (#;Record pairs)] tokens'])
(case (p (join-pairs pairs))
- (#;Right [#;Nil x]) (#;Right [tokens' x])
- _ (#;Left ($_ Text/append "Syntax was expected to fully consume record" (remaining-inputs tokens))))
+ (#R;Success [#;Nil x]) (#R;Success [tokens' x])
+ _ (#R;Error ($_ Text/append "Syntax was expected to fully consume record" (remaining-inputs tokens))))
_
- (#;Left ($_ Text/append "Cannot parse record" (remaining-inputs tokens))))))
+ (#R;Error ($_ Text/append "Cannot parse record" (remaining-inputs tokens))))))
(def: #export (opt p)
{#;doc "Optionality combinator."}
@@ -212,12 +212,12 @@
(-> (Syntax a) (Syntax (Maybe a))))
(function [tokens]
(case (p tokens)
- (#;Left _) (#;Right [tokens #;None])
- (#;Right [tokens' x]) (#;Right [tokens' (#;Some x)]))))
+ (#R;Error _) (#R;Success [tokens #;None])
+ (#R;Success [tokens' x]) (#R;Success [tokens' (#;Some x)]))))
(def: #export (run tokens p)
(All [a]
- (-> (List Code) (Syntax a) (Error [(List Code) a])))
+ (-> (List Code) (Syntax a) (R;Result [(List Code) a])))
(p tokens))
(def: #export (some p)
@@ -226,12 +226,12 @@
(-> (Syntax a) (Syntax (List a))))
(function [tokens]
(case (p tokens)
- (#;Left _) (#;Right [tokens (list)])
- (#;Right [tokens' x]) (run tokens'
- (do Monad<Syntax>
- [xs (some p)]
- (wrap (list& x xs)))
- ))))
+ (#R;Error _) (#R;Success [tokens (list)])
+ (#R;Success [tokens' x]) (run tokens'
+ (do Monad<Syntax>
+ [xs (some p)]
+ (wrap (list& x xs)))
+ ))))
(def: #export (many p)
{#;doc "1-or-more combinator."}
@@ -257,11 +257,11 @@
(-> (Syntax a) (Syntax b) (Syntax (| a b))))
(function [tokens]
(case (p1 tokens)
- (#;Right [tokens' x1]) (#;Right [tokens' (+0 x1)])
- (#;Left _) (run tokens
- (do Monad<Syntax>
- [x2 p2]
- (wrap (+1 x2))))
+ (#R;Success [tokens' x1]) (#R;Success [tokens' (+0 x1)])
+ (#R;Error _) (run tokens
+ (do Monad<Syntax>
+ [x2 p2]
+ (wrap (+1 x2))))
)))
(def: #export (either pl pr)
@@ -270,7 +270,7 @@
(-> (Syntax a) (Syntax a) (Syntax a)))
(function [tokens]
(case (pl tokens)
- (#;Left _) (pr tokens)
+ (#R;Error _) (pr tokens)
output output
)))
@@ -279,16 +279,16 @@
(Syntax Unit)
(function [tokens]
(case tokens
- #;Nil (#;Right [tokens []])
- _ (#;Left ($_ Text/append "Expected list of tokens to be empty!" (remaining-inputs tokens))))))
+ #;Nil (#R;Success [tokens []])
+ _ (#R;Error ($_ Text/append "Expected list of tokens to be empty!" (remaining-inputs tokens))))))
(def: #export end?
{#;doc "Checks whether there are no more inputs."}
(Syntax Bool)
(function [tokens]
(case tokens
- #;Nil (#;Right [tokens true])
- _ (#;Right [tokens false]))))
+ #;Nil (#R;Success [tokens true])
+ _ (#R;Success [tokens false]))))
(def: #export (exactly n p)
{#;doc "Parse exactly N times."}
@@ -314,10 +314,10 @@
(if (n.> +0 n)
(function [input]
(case (p input)
- (#;Left msg)
- (#;Right [input (list)])
+ (#R;Error msg)
+ (#R;Success [input (list)])
- (#;Right [input' x])
+ (#R;Success [input' x])
(run input'
(do Monad<Syntax>
[xs (at-most (n.dec n) p)]
@@ -352,38 +352,38 @@
(All [a] (-> (Syntax a) (Syntax Unit)))
(function [input]
(case (p input)
- (#;Left msg)
- (#;Right [input []])
+ (#R;Error msg)
+ (#R;Success [input []])
_
- (#;Left "Expected to fail; yet succeeded."))))
+ (#R;Error "Expected to fail; yet succeeded."))))
(def: #export (fail message)
(All [a] (-> Text (Syntax a)))
(function [input]
- (#;Left message)))
+ (#R;Error message)))
(def: #export (default value parser)
{#;doc "If the given parser fails, returns the default value."}
(All [a] (-> a (Syntax a) (Syntax a)))
(function [input]
(case (parser input)
- (#;Left error)
- (#;Right [input value])
+ (#R;Error error)
+ (#R;Success [input value])
- (#;Right [input' output])
- (#;Right [input' output]))))
+ (#R;Success [input' output])
+ (#R;Success [input' output]))))
(def: #export (on compiler action)
{#;doc "Run a Lux operation as if it was a Syntax parser."}
(All [a] (-> Compiler (Lux a) (Syntax a)))
(function [input]
(case (macro;run compiler action)
- (#;Left error)
- (#;Left error)
+ (#R;Error error)
+ (#R;Error error)
- (#;Right value)
- (#;Right [input value])
+ (#R;Success value)
+ (#R;Success [input value])
)))
(def: #export (local local-inputs syntax)
@@ -391,18 +391,18 @@
(All [a] (-> (List Code) (Syntax a) (Syntax a)))
(function [real-inputs]
(case (syntax local-inputs)
- (#;Left error)
- (#;Left error)
+ (#R;Error error)
+ (#R;Error error)
- (#;Right [unconsumed-inputs value])
+ (#R;Success [unconsumed-inputs value])
(case unconsumed-inputs
#;Nil
- (#;Right [real-inputs value])
+ (#R;Success [real-inputs value])
_
- (#;Left (Text/append "Unconsumed inputs: "
- (|> (map code;to-text unconsumed-inputs)
- (text;join-with ", "))))))))
+ (#R;Error (Text/append "Unconsumed inputs: "
+ (|> (map code;to-text unconsumed-inputs)
+ (text;join-with ", "))))))))
(def: #export (rec syntax)
{#;doc "Combinator for recursive syntax."}
@@ -473,10 +473,10 @@
g!end (code;symbol ["" ""])
error-msg (code;text (Text/append "Wrong syntax for " name))
export-ast (: (List Code) (case exported?
- (#;Some #;Left)
+ (#;Some #R;Error)
(list (' #hidden))
- (#;Some #;Right)
+ (#;Some #R;Success)
(list (' #export))
_
@@ -492,11 +492,11 @@
((~' wrap) (do Monad<Lux>
[]
(~ body))))))
- (#;Right [(~ g!tokens) (~ g!body)])
+ (#R;Success [(~ g!tokens) (~ g!body)])
((~ g!body) (~ g!state))
- (#;Left (~ g!msg))
- (#;Left (text.join-with ": " (list (~ error-msg) (~ g!msg))))))))))))
+ (#R;Error (~ g!msg))
+ (#R;Error (text.join-with ": " (list (~ error-msg) (~ g!msg))))))))))))
_
(macro;fail "Wrong syntax for syntax:"))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-13 01:14:42 +0000