aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/cli.lux114
-rw-r--r--stdlib/source/lux/concurrency/actor.lux6
-rw-r--r--stdlib/source/lux/concurrency/promise.lux3
-rw-r--r--stdlib/source/lux/control/codec.lux6
-rw-r--r--stdlib/source/lux/control/effect.lux1
-rw-r--r--stdlib/source/lux/control/exception.lux18
-rw-r--r--stdlib/source/lux/data/coll/array.lux3
-rw-r--r--stdlib/source/lux/data/format/json.lux218
-rw-r--r--stdlib/source/lux/data/format/xml.lux14
-rw-r--r--stdlib/source/lux/data/number.lux76
-rw-r--r--stdlib/source/lux/data/number/complex.lux4
-rw-r--r--stdlib/source/lux/data/number/ratio.lux6
-rw-r--r--stdlib/source/lux/data/result.lux (renamed from stdlib/source/lux/data/error.lux)30
-rw-r--r--stdlib/source/lux/data/text/lexer.lux174
-rw-r--r--stdlib/source/lux/macro.lux122
-rw-r--r--stdlib/source/lux/macro/poly/functor.lux3
-rw-r--r--stdlib/source/lux/macro/poly/text-encoder.lux3
-rw-r--r--stdlib/source/lux/macro/syntax.lux166
-rw-r--r--stdlib/source/lux/test.lux106
-rw-r--r--stdlib/source/lux/type/check.lux130
20 files changed, 599 insertions, 604 deletions
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux
index fd20a208b..6883811a6 100644
--- a/stdlib/source/lux/cli.lux
+++ b/stdlib/source/lux/cli.lux
@@ -5,7 +5,7 @@
monad)
(data (coll (list #as list #open ("List/" Monoid<List> Monad<List>)))
(text #as text #open ("Text/" Monoid<Text>))
- error
+ ["R" result]
(sum #as sum))
[io]
[macro #+ with-gensyms Functor<Lux> Monad<Lux>]
@@ -15,38 +15,38 @@
## [Types]
(type: #export (CLI a)
{#;doc "A command-line interface parser."}
- (-> (List Text) (Error [(List Text) a])))
+ (-> (List Text) (R;Result [(List Text) a])))
## [Utils]
(def: (run' opt inputs)
- (All [a] (-> (CLI a) (List Text) (Error [(List Text) a])))
+ (All [a] (-> (CLI a) (List Text) (R;Result [(List Text) a])))
(opt inputs))
## [Structures]
(struct: #export _ (Functor CLI)
(def: (map f ma inputs)
(case (ma inputs)
- (#;Left msg) (#;Left msg)
- (#;Right [inputs' datum]) (#;Right [inputs' (f datum)]))))
+ (#R;Error msg) (#R;Error msg)
+ (#R;Success [inputs' datum]) (#R;Success [inputs' (f datum)]))))
(struct: #export _ (Applicative CLI)
(def: functor Functor<CLI>)
(def: (wrap a inputs)
- (#;Right [inputs a]))
+ (#R;Success [inputs a]))
(def: (apply ff fa inputs)
(case (ff inputs)
- (#;Right [inputs' f])
+ (#R;Success [inputs' f])
(case (fa inputs')
- (#;Right [inputs'' a])
- (#;Right [inputs'' (f a)])
+ (#R;Success [inputs'' a])
+ (#R;Success [inputs'' (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 CLI)
@@ -54,8 +54,8 @@
(def: (join mma inputs)
(case (mma inputs)
- (#;Left msg) (#;Left msg)
- (#;Right [inputs' ma]) (ma inputs'))))
+ (#R;Error msg) (#R;Error msg)
+ (#R;Success [inputs' ma]) (ma inputs'))))
## [Combinators]
(def: #export any
@@ -64,26 +64,26 @@
(function [inputs]
(case inputs
(#;Cons arg inputs')
- (#;Right [inputs' arg])
+ (#R;Success [inputs' arg])
_
- (#;Left "Cannot parse empty arguments."))))
+ (#R;Error "Cannot parse empty arguments."))))
(def: #export (parse parser)
{#;doc "Parses the next input with a parsing function."}
- (All [a] (-> (-> Text (Error a)) (CLI a)))
+ (All [a] (-> (-> Text (R;Result a)) (CLI a)))
(function [inputs]
(case inputs
(#;Cons arg inputs')
(case (parser arg)
- (#;Right value)
- (#;Right [inputs' value])
+ (#R;Success value)
+ (#R;Success [inputs' value])
- (#;Left parser-error)
- (#;Left parser-error))
+ (#R;Error parser-error)
+ (#R;Error parser-error))
_
- (#;Left "Cannot parse empty arguments."))))
+ (#R;Error "Cannot parse empty arguments."))))
(def: #export (option names)
{#;doc "Checks that a given option (with multiple possible names) has a value."}
@@ -92,13 +92,13 @@
(let [[pre post] (list;split-with (. ;not (list;member? text;Eq<Text> names)) inputs)]
(case post
#;Nil
- (#;Left ($_ Text/append "Missing option (" (text;join-with " " names) ")"))
+ (#R;Error ($_ Text/append "Missing option (" (text;join-with " " names) ")"))
(^ (list& _ value post'))
- (#;Right [(List/append pre post') value])
+ (#R;Success [(List/append pre post') value])
_
- (#;Left ($_ Text/append "Option lacks value (" (text;join-with " " names) ")"))
+ (#R;Error ($_ Text/append "Option lacks value (" (text;join-with " " names) ")"))
))))
(def: #export (flag names)
@@ -108,18 +108,18 @@
(let [[pre post] (list;split-with (. ;not (list;member? text;Eq<Text> names)) inputs)]
(case post
#;Nil
- (#;Right [pre false])
+ (#R;Success [pre false])
(#;Cons _ post')
- (#;Right [(List/append pre post') true])))))
+ (#R;Success [(List/append pre post') true])))))
(def: #export end
{#;doc "Ensures there are no more inputs."}
(CLI Unit)
(function [inputs]
(case inputs
- #;Nil (#;Right [inputs []])
- _ (#;Left (Text/append "Unknown parameters: " (text;join-with " " inputs))))))
+ #;Nil (#R;Success [inputs []])
+ _ (#R;Error (Text/append "Unknown parameters: " (text;join-with " " inputs))))))
(def: #export (after param subject)
(All [p s] (-> (CLI p) (CLI s) (CLI s)))
@@ -139,8 +139,8 @@
(-> Text Bool (CLI Unit))
(function [inputs]
(if test
- (#;Right [inputs []])
- (#;Left message))))
+ (#R;Success [inputs []])
+ (#R;Error message))))
(def: #export (opt opt)
{#;doc "Optionality combinator."}
@@ -148,8 +148,8 @@
(-> (CLI a) (CLI (Maybe a))))
(function [inputs]
(case (opt inputs)
- (#;Left _) (#;Right [inputs #;None])
- (#;Right [inputs' x]) (#;Right [inputs' (#;Some x)]))))
+ (#R;Error _) (#R;Success [inputs #;None])
+ (#R;Success [inputs' x]) (#R;Success [inputs' (#;Some x)]))))
(def: #export (seq optL optR)
{#;doc "Sequencing combinator."}
@@ -164,27 +164,27 @@
(All [a b] (-> (CLI a) (CLI b) (CLI (| a b))))
(function [inputs]
(case (optL inputs)
- (#;Left msg)
+ (#R;Error msg)
(case (optR inputs)
- (#;Left _)
- (#;Left msg)
+ (#R;Error _)
+ (#R;Error msg)
- (#;Right [inputs' r])
- (#;Right [inputs' (sum;right r)]))
+ (#R;Success [inputs' r])
+ (#R;Success [inputs' (sum;right r)]))
- (#;Right [inputs' l])
- (#;Right [inputs' (sum;left l)]))))
+ (#R;Success [inputs' l])
+ (#R;Success [inputs' (sum;left l)]))))
(def: #export (not opt)
{#;doc "The opposite of the given CLI."}
(All [a] (-> (CLI a) (CLI Unit)))
(function [inputs]
(case (opt inputs)
- (#;Left msg)
- (#;Right [inputs []])
+ (#R;Error msg)
+ (#R;Success [inputs []])
_
- (#;Left "Expected to fail; yet succeeded."))))
+ (#R;Error "Expected to fail; yet succeeded."))))
(def: #export (some opt)
{#;doc "0-or-more combinator."}
@@ -192,11 +192,11 @@
(-> (CLI a) (CLI (List a))))
(function [inputs]
(case (opt inputs)
- (#;Left _) (#;Right [inputs (list)])
- (#;Right [inputs' x]) (run' (do Monad<CLI>
- [xs (some opt)]
- (wrap (list& x xs)))
- inputs'))))
+ (#R;Error _) (#R;Success [inputs (list)])
+ (#R;Success [inputs' x]) (run' (do Monad<CLI>
+ [xs (some opt)]
+ (wrap (list& x xs)))
+ inputs'))))
(def: #export (many opt)
{#;doc "1-or-more combinator."}
@@ -213,17 +213,17 @@
(-> (CLI a) (CLI a) (CLI a)))
(function [inputs]
(case (pl inputs)
- (#;Left _) (pr inputs)
+ (#R;Error _) (pr inputs)
output output)))
(def: #export (run opt inputs)
- (All [a] (-> (CLI a) (List Text) (Error a)))
+ (All [a] (-> (CLI a) (List Text) (R;Result a)))
(case (opt inputs)
- (#;Left msg)
- (#;Left msg)
+ (#R;Error msg)
+ (#R;Error msg)
- (#;Right [_ value])
- (#;Right value)))
+ (#R;Success [_ value])
+ (#R;Success value)))
## [Syntax]
(type: Program-Args
@@ -271,10 +271,10 @@
(~ g!_) ;;end]
((~' wrap) (~ body))))
(~ g!args))
- (#;Right [(~ g!_) (~ g!output)])
+ (#R;Success [(~ g!_) (~ g!output)])
(~ g!output)
- (#;Left (~ g!message))
+ (#R;Error (~ g!message))
(error! (~ g!message))
)))
)))
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index 42b8908f9..de1c9d745 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -3,7 +3,7 @@
(lux (control monad)
[io #- run]
function
- (data [error #- fail]
+ (data ["R" result]
text/format
(coll [list "List/" Monoid<List> Monad<List>])
[product]
@@ -26,7 +26,7 @@
(type: #export (Behavior s m)
{#;doc "An actor's behavior when messages are received."}
- {#step (-> (Actor s m) (-> m s (P;Promise (Error s))))
+ {#step (-> (Actor s m) (-> m s (P;Promise (R;Result s))))
#end (-> (Maybe Text) s (P;Promise Unit))})
## [Values]
@@ -225,7 +225,7 @@
protocol-pm (List/map (: (-> Method [Code Code])
(function [(^slots [#name #vars #args #return #body])]
(let [arg-names (|> (list;size args) (list;n.range +1) (List/map (|>. Nat/encode [""] code;symbol)))
- body-func (` (: (-> (~ g!state-name) (~@ (List/map product;right args)) (P;Promise (Error [(~ g!state-name) (~ return)])))
+ body-func (` (: (-> (~ g!state-name) (~@ (List/map product;right args)) (P;Promise (R;Result [(~ g!state-name) (~ return)])))
(function (~ (code;symbol ["" _name])) [(~ g!state) (~@ (List/map (|>. product;left [""] code;symbol) args))]
(do P;Monad<Promise>
[]
diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux
index edca7d05a..a6c814c5a 100644
--- a/stdlib/source/lux/concurrency/promise.lux
+++ b/stdlib/source/lux/concurrency/promise.lux
@@ -2,8 +2,7 @@
lux
(lux (data (coll [list #* "" Functor<List>])
number
- text/format
- error)
+ text/format)
[io #- run]
function
(control functor
diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux
index 18937ede1..63ef0526b 100644
--- a/stdlib/source/lux/control/codec.lux
+++ b/stdlib/source/lux/control/codec.lux
@@ -1,14 +1,14 @@
(;module:
lux
(lux control/monad
- data/error))
+ data/result))
## [Signatures]
(sig: #export (Codec m a)
{#;doc "A way to move back-and-forth between a type and an alternative representation for it."}
(: (-> a m)
encode)
- (: (-> m (Error a))
+ (: (-> m (Result a))
decode))
## [Values]
@@ -18,7 +18,7 @@
(def: encode (|>. (:: Codec<b,a> encode) (:: Codec<c,b> encode)))
(def: (decode cy)
- (do Monad<Error>
+ (do Monad<Result>
[by (:: Codec<c,b> decode cy)]
(:: Codec<b,a> decode by)))
)
diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux
index 0c867f4be..447012689 100644
--- a/stdlib/source/lux/control/effect.lux
+++ b/stdlib/source/lux/control/effect.lux
@@ -7,7 +7,6 @@
(data (coll [list "List/" Monad<List> Monoid<List>])
[number "Nat/" Codec<Text,Nat>]
text/format
- error
[ident "Ident/" Eq<Ident>]
[text])
[macro]
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 66214f90c..fc5cf9c64 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -1,7 +1,7 @@
-(;module: {#;doc "Exception-handling functionality built on top of the Error type."}
+(;module: {#;doc "Exception-handling functionality built on top of the Result type."}
lux
(lux (control monad)
- (data [error #- fail]
+ (data [result #- fail]
[text])
[macro]
(macro [code]
@@ -23,8 +23,8 @@
If no exception was detected, or a different one from the one being checked, then pass along the original value."}
(All [a]
- (-> Exception (-> Text a) (Error a)
- (Error a)))
+ (-> Exception (-> Text a) (Result a)
+ (Result a)))
(case try
(#;Right output)
(#;Right output)
@@ -37,7 +37,7 @@
(def: #export (otherwise to-do try)
{#;doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."}
(All [a]
- (-> (-> Text a) (Error a) a))
+ (-> (-> Text a) (Result a) a))
(case try
(#;Right output)
output
@@ -46,13 +46,13 @@
(to-do error)))
(def: #export (return value)
- {#;doc "A way to lift normal values into the error-handling context."}
- (All [a] (-> a (Error a)))
+ {#;doc "A way to lift normal values into the result-handling context."}
+ (All [a] (-> a (Result a)))
(#;Right value))
(def: #export (throw exception message)
- {#;doc "Decorate an error message with an Exception and lift it into the error-handling context."}
- (All [a] (-> Exception Text (Error a)))
+ {#;doc "Decorate an error message with an Exception and lift it into the result-handling context."}
+ (All [a] (-> Exception Text (Result a)))
(#;Left (exception message)))
(syntax: #export (exception: [_ex-lev common;export-level] [name s;local-symbol])
diff --git a/stdlib/source/lux/data/coll/array.lux b/stdlib/source/lux/data/coll/array.lux
index 8631f154d..a8f8d9f00 100644
--- a/stdlib/source/lux/data/coll/array.lux
+++ b/stdlib/source/lux/data/coll/array.lux
@@ -6,8 +6,7 @@
monad
eq
fold)
- (data error
- (coll [list "List/" Fold<List>])
+ (data (coll [list "List/" Fold<List>])
[product])
))
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index b75b9dbf7..0919f305f 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -14,7 +14,7 @@
[number #* "Real/" Codec<Text,Real>]
maybe
[char "Char/" Eq<Char> Codec<Text,Char>]
- [error #- fail]
+ ["R" result #- fail]
[sum]
[product]
(coll [list "" Fold<List> "List/" Monad<List>]
@@ -54,7 +54,7 @@
(type: #export (Parser a)
{#;doc "JSON parsers."}
- (-> JSON (Error a)))
+ (-> JSON (Result a)))
(type: #export (Gen a)
{#;doc "JSON generators."}
@@ -150,52 +150,52 @@
(def: #export (fields json)
{#;doc "Get all the fields in a JSON object."}
- (-> JSON (Error (List String)))
+ (-> JSON (Result (List String)))
(case json
(#Object obj)
- (#;Right (dict;keys obj))
+ (#R;Success (dict;keys obj))
_
- (#;Left (format "Cannot get the fields of a non-object."))))
+ (#R;Error (format "Cannot get the fields of a non-object."))))
(def: #export (get key json)
{#;doc "A JSON object field getter."}
- (-> String JSON (Error JSON))
+ (-> String JSON (Result JSON))
(case json
(#Object obj)
(case (dict;get key obj)
(#;Some value)
- (#;Right value)
+ (#R;Success value)
#;None
- (#;Left (format "Missing field " (show-string key) " on object.")))
+ (#R;Error (format "Missing field " (show-string key) " on object.")))
_
- (#;Left (format "Cannot get field " (show-string key) " of a non-object."))))
+ (#R;Error (format "Cannot get field " (show-string key) " of a non-object."))))
(def: #export (set key value json)
{#;doc "A JSON object field setter."}
- (-> String JSON JSON (Error JSON))
+ (-> String JSON JSON (Result JSON))
(case json
(#Object obj)
- (#;Right (#Object (dict;put key value obj)))
+ (#R;Success (#Object (dict;put key value obj)))
_
- (#;Left (format "Cannot set field " (show-string key) " of a non-object."))))
+ (#R;Error (format "Cannot set field " (show-string key) " of a non-object."))))
(do-template [<name> <tag> <type> <desc>]
[(def: #export (<name> key json)
{#;doc (#;TextA (format "A JSON object field getter for " <desc> "."))}
- (-> Text JSON (Error <type>))
+ (-> Text JSON (Result <type>))
(case (get key json)
- (#;Right (<tag> value))
- (#;Right value)
+ (#R;Success (<tag> value))
+ (#R;Success value)
- (#;Right _)
- (#;Left (format "Wrong value type at key " (show-string key)))
+ (#R;Success _)
+ (#R;Error (format "Wrong value type at key " (show-string key)))
- (#;Left error)
- (#;Left error)))]
+ (#R;Error error)
+ (#R;Error error)))]
[get-boolean #Boolean Boolean "booleans"]
[get-number #Number Number "numbers"]
@@ -275,12 +275,12 @@
sign (lexer;default "" (lexer;text "-"))
offset (lexer;many' lexer;digit)]
(wrap (format mark sign offset)))))]
- (case (: (Error Real)
+ (case (: (Result Real)
(Real/decode (format ?sign digits "." decimals exp)))
- (#;Left message)
+ (#R;Error message)
(lexer;fail message)
- (#;Right value)
+ (#R;Success value)
(wrap value))))
(def: (un-escape escaped)
@@ -351,31 +351,31 @@
(def: (map f ma)
(function [json]
(case (ma json)
- (#;Left msg)
- (#;Left msg)
+ (#R;Error msg)
+ (#R;Error msg)
- (#;Right a)
- (#;Right (f a))))))
+ (#R;Success a)
+ (#R;Success (f a))))))
(struct: #export _ (Applicative Parser)
(def: functor Functor<Parser>)
(def: (wrap x json)
- (#;Right x))
+ (#R;Success x))
(def: (apply ff fa)
(function [json]
(case (ff json)
- (#;Right f)
+ (#R;Success f)
(case (fa json)
- (#;Right a)
- (#;Right (f a))
+ (#R;Success a)
+ (#R;Success (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 Parser)
(def: applicative Applicative<Parser>)
@@ -383,10 +383,10 @@
(def: (join mma)
(function [json]
(case (mma json)
- (#;Left msg)
- (#;Left msg)
+ (#R;Error msg)
+ (#R;Error msg)
- (#;Right ma)
+ (#R;Success ma)
(ma json)))))
## [Values]
@@ -397,10 +397,10 @@
(Parser <type>)
(case json
(<tag> value)
- (#;Right (<pre> value))
+ (#R;Success (<pre> value))
_
- (#;Left (format "JSON value is not " <desc> ": " (show-json json)))))]
+ (#R;Error (format "JSON value is not " <desc> ": " (show-json json)))))]
[unit Unit #Null "unit" id]
[bool Bool #Boolean "bool" id]
@@ -415,10 +415,10 @@
(-> <type> (Parser Bool))
(case json
(<tag> value)
- (#;Right (:: <eq> = test (<pre> value)))
+ (#R;Success (:: <eq> = test (<pre> value)))
_
- (#;Left (format "JSON value is not a " <desc> ": " (show-json json)))))
+ (#R;Error (format "JSON value is not a " <desc> ": " (show-json json)))))
(def: #export (<check> test json)
{#;doc (#;TextA (format "Ensures a JSON value is a " <desc> "."))}
@@ -427,12 +427,12 @@
(<tag> value)
(let [value (<pre> value)]
(if (:: <eq> = test value)
- (#;Right [])
- (#;Left (format "Value mismatch: "
- (:: <codec> encode test) "=/=" (:: <codec> encode value)))))
+ (#R;Success [])
+ (#R;Error (format "Value mismatch: "
+ (:: <codec> encode test) "=/=" (:: <codec> encode value)))))
_
- (#;Left (format "JSON value is not a " <desc> ": " (show-json json)))))]
+ (#R;Error (format "JSON value is not a " <desc> ": " (show-json json)))))]
[bool? bool! Bool bool;Eq<Bool> bool;Codec<Text,Bool> #Boolean "boolean" id]
[int? int! Int number;Eq<Int> number;Codec<Text,Int> #Number "number" real-to-int]
@@ -446,14 +446,14 @@
(case json
(#String input)
(case (Char/decode (format "#\"" input "\""))
- (#;Right value)
- (#;Right value)
+ (#R;Success value)
+ (#R;Success value)
- (#;Left _)
- (#;Left (format "Invalid format for char: " input)))
+ (#R;Error _)
+ (#R;Error (format "Invalid format for char: " input)))
_
- (#;Left (format "JSON value is not a " "string" ": " (show-json json)))))
+ (#R;Error (format "JSON value is not a " "string" ": " (show-json json)))))
(def: #export (char? test json)
{#;doc "Asks whether a JSON value is a single-character string with the specified character."}
@@ -461,17 +461,17 @@
(case json
(#String input)
(case (Char/decode (format "#\"" input "\""))
- (#;Right value)
+ (#R;Success value)
(if (:: char;Eq<Char> = test value)
- (#;Right true)
- (#;Left (format "Value mismatch: "
- (:: char;Codec<Text,Char> encode test) "=/=" (:: char;Codec<Text,Char> encode value))))
+ (#R;Success true)
+ (#R;Error (format "Value mismatch: "
+ (:: char;Codec<Text,Char> encode test) "=/=" (:: char;Codec<Text,Char> encode value))))
- (#;Left _)
- (#;Left (format "Invalid format for char: " input)))
+ (#R;Error _)
+ (#R;Error (format "Invalid format for char: " input)))
_
- (#;Left (format "JSON value is not a " "string" ": " (show-json json)))))
+ (#R;Error (format "JSON value is not a " "string" ": " (show-json json)))))
(def: #export (char! test json)
{#;doc "Ensures a JSON value is a single-character string with the specified character."}
@@ -479,17 +479,17 @@
(case json
(#String input)
(case (Char/decode (format "#\"" input "\""))
- (#;Right value)
+ (#R;Success value)
(if (:: char;Eq<Char> = test value)
- (#;Right [])
- (#;Left (format "Value mismatch: "
- (:: char;Codec<Text,Char> encode test) "=/=" (:: char;Codec<Text,Char> encode value))))
+ (#R;Success [])
+ (#R;Error (format "Value mismatch: "
+ (:: char;Codec<Text,Char> encode test) "=/=" (:: char;Codec<Text,Char> encode value))))
- (#;Left _)
- (#;Left (format "Invalid format for char: " input)))
+ (#R;Error _)
+ (#R;Error (format "Invalid format for char: " input)))
_
- (#;Left (format "JSON value is not a " "string" ": " (show-json json)))))
+ (#R;Error (format "JSON value is not a " "string" ": " (show-json json)))))
(def: #export (nullable parser)
{#;doc "A parser that can handle the presence of null values."}
@@ -497,15 +497,15 @@
(function [json]
(case json
#Null
- (#;Right #;None)
+ (#R;Success #;None)
_
(case (parser json)
- (#;Left error)
- (#;Left error)
+ (#R;Error error)
+ (#R;Error error)
- (#;Right value)
- (#;Right (#;Some value)))
+ (#R;Success value)
+ (#R;Success (#;Some value)))
)))
(def: #export (array parser)
@@ -514,12 +514,12 @@
(function [json]
(case json
(#Array values)
- (do Monad<Error>
+ (do Monad<Result>
[elems (mapM @ parser (vector;to-list values))]
(wrap elems))
_
- (#;Left (format "JSON value is not an array: " (show-json json))))))
+ (#R;Error (format "JSON value is not an array: " (show-json json))))))
(def: #export (object parser)
{#;doc "Parses a JSON object, assuming that every field's value can be parsed the same way."}
@@ -527,7 +527,7 @@
(function [json]
(case json
(#Object fields)
- (do Monad<Error>
+ (do Monad<Result>
[kvs (mapM @
(function [[key val']]
(do @
@@ -537,7 +537,7 @@
(wrap (dict;from-list text;Hash<Text> kvs)))
_
- (#;Left (format "JSON value is not an object: " (show-json json))))))
+ (#R;Error (format "JSON value is not an object: " (show-json json))))))
(def: #export (nth idx parser)
{#;doc "Parses an element inside a JSON array."}
@@ -548,17 +548,17 @@
(case (vector;nth idx values)
(#;Some value)
(case (parser value)
- (#;Right output)
- (#;Right output)
+ (#R;Success output)
+ (#R;Success output)
- (#;Left error)
- (#;Left (format "JSON array index [" (%n idx) "]: (" error ") @ " (show-json json))))
+ (#R;Error error)
+ (#R;Error (format "JSON array index [" (%n idx) "]: (" error ") @ " (show-json json))))
#;None
- (#;Left (format "JSON array does not have index " (%n idx) " @ " (show-json json))))
+ (#R;Error (format "JSON array does not have index " (%n idx) " @ " (show-json json))))
_
- (#;Left (format "JSON value is not an array: " (show-json json))))))
+ (#R;Error (format "JSON value is not an array: " (show-json json))))))
(def: #export (field field-name parser)
{#;doc "Parses a field inside a JSON object."}
@@ -567,20 +567,20 @@
(case (get field-name json)
(#;Some value)
(case (parser value)
- (#;Right output)
- (#;Right output)
+ (#R;Success output)
+ (#R;Success output)
- (#;Left error)
- (#;Left (format "Failed to get JSON object field " (show-string field-name) ": (" error ") @ " (show-json json))))
+ (#R;Error error)
+ (#R;Error (format "Failed to get JSON object field " (show-string field-name) ": (" error ") @ " (show-json json))))
- (#;Left _)
- (#;Left (format "JSON object does not have field " (show-string field-name) " @ " (show-json json))))))
+ (#R;Error _)
+ (#R;Error (format "JSON object does not have field " (show-string field-name) " @ " (show-json json))))))
(def: #export any
{#;doc "Just returns the JSON input without applying any logic."}
(Parser JSON)
(function [json]
- (#;Right json)))
+ (#R;Success json)))
(def: #export (seq pa pb)
{#;doc "Sequencing combinator."}
@@ -594,23 +594,23 @@
{#;doc "Heterogeneous alternative combinator."}
(All [a b] (-> (Parser a) (Parser b) (Parser (| a b))))
(case (pa json)
- (#;Right a)
+ (#R;Success a)
(sum;right (sum;left a))
- (#;Left message0)
+ (#R;Error message0)
(case (pb json)
- (#;Right b)
+ (#R;Success b)
(sum;right (sum;right b))
- (#;Left message1)
- (#;Left message0))))
+ (#R;Error message1)
+ (#R;Error message0))))
(def: #export (either pl pr json)
{#;doc "Homogeneous alternative combinator."}
(All [a] (-> (Parser a) (Parser a) (Parser a)))
(case (pl json)
- (#;Right x)
- (#;Right x)
+ (#R;Success x)
+ (#R;Success x)
_
(pr json)))
@@ -620,22 +620,22 @@
(All [a]
(-> (Parser a) (Parser (Maybe a))))
(case (p json)
- (#;Left _) (#;Right #;None)
- (#;Right x) (#;Right (#;Some x))))
+ (#R;Error _) (#R;Success #;None)
+ (#R;Success x) (#R;Success (#;Some x))))
(def: #export (run json parser)
- (All [a] (-> JSON (Parser a) (Error a)))
+ (All [a] (-> JSON (Parser a) (Result a)))
(parser json))
(def: #export (ensure test parser json)
{#;doc "Only parses a JSON if it passes a test (which is also a parser)."}
(All [a] (-> (Parser Unit) (Parser a) (Parser a)))
(case (test json)
- (#;Right _)
+ (#R;Success _)
(parser json)
- (#;Left error)
- (#;Left error)))
+ (#R;Error error)
+ (#R;Error error)))
(def: #export (array-size! size json)
{#;doc "Ensures a JSON array has the specified size."}
@@ -643,11 +643,11 @@
(case json
(#Array parts)
(if (n.= size (vector;size parts))
- (#;Right [])
- (#;Left (format "JSON array does no have size " (%n size) " " (show-json json))))
+ (#R;Success [])
+ (#R;Error (format "JSON array does no have size " (%n size) " " (show-json json))))
_
- (#;Left (format "JSON value is not an array: " (show-json json)))))
+ (#R;Error (format "JSON value is not an array: " (show-json json)))))
(def: #export (object-fields! wanted-fields json)
{#;doc "Ensures that every field in the list of wanted-fields is present in a JSON object."}
@@ -658,11 +658,11 @@
(if (and (n.= (list;size wanted-fields) (list;size actual-fields))
(list;every? (list;member? text;Eq<Text> wanted-fields)
actual-fields))
- (#;Right [])
- (#;Left (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]"))))
+ (#R;Success [])
+ (#R;Error (format "JSON object has wrong field-set. Expected: [" (text;join-with ", " wanted-fields) "]. Actual: [" (text;join-with ", " actual-fields) "]"))))
_
- (#;Left (format "JSON value is not an object: " (show-json json)))))
+ (#R;Error (format "JSON value is not an object: " (show-json json)))))
## [Structures]
(struct: #export _ (Eq JSON)
@@ -924,7 +924,7 @@
(poly: #hidden (Codec<JSON,?>//decode *env* :x:)
(let [->Codec//decode (: (-> Code Code)
- (function [.type.] (` (-> JSON (Error (~ .type.))))))]
+ (function [.type.] (` (-> JSON (Result (~ .type.))))))]
(with-expansions
[<basic> (do-template [<type> <matcher> <decoder>]
[(do @ [_ (<matcher> :x:)] (wrap (` (: (~ (->Codec//decode (` <type>))) <decoder>))))]
@@ -971,11 +971,11 @@
(~ (->Codec//decode (` ((~ (type;to-ast :x:)) (~@ g!vars)))))))))]]
(wrap (` (: (~ :x:+)
(function [(~@ g!vars) (~ g!input)]
- (do Monad<Error>
+ (do Monad<Result>
[(~ g!key) (;;fields (~ g!input))]
(mapM (~ (' %))
(function [(~ g!key)]
- (do Monad<Error>
+ (do Monad<Result>
[(~ g!val) (;;get (~ g!key) (~ g!input))
(~ g!val) (;;run (~ g!val) (~ .val.))]
((~ (' wrap)) [(~ g!key) (~ g!val)])))
@@ -1043,7 +1043,7 @@
(~ (->Codec//decode (` ((~ (type;to-ast :x:)) (~@ g!vars)))))))))]]
(wrap (` (: (~ :x:+)
(function [(~@ g!vars) (~ g!input)]
- (do Monad<Error>
+ (do Monad<Result>
[(~@ (List/join extraction))]
((~ (' wrap)) (~ (code;record (List/map (function [[name :slot:]]
[(code;tag name) (code;symbol ["" (product;right name)])])
diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux
index 2494fa1b8..db68fbf29 100644
--- a/stdlib/source/lux/data/format/xml.lux
+++ b/stdlib/source/lux/data/format/xml.lux
@@ -7,7 +7,7 @@
text/format
(text ["l" lexer "lex/" Monad<Lexer>])
[number]
- error
+ ["R" result]
[char "c/" Eq<Char>]
[product]
[maybe "m/" Monad<Maybe>]
@@ -180,16 +180,16 @@
(l;after (l;opt xml-header^))))
(def: #export (read-xml input)
- (-> Text (Error XML))
+ (-> Text (R;Result XML))
(case (l;run' input xml^)
- (#;Right ["" output])
- (#;Right output)
+ (#R;Success ["" output])
+ (#R;Success output)
(#;Some [input-left output])
- (#;Left (format "Unconsumed input: " (%t input-left)))
+ (#R;Error (format "Unconsumed input: " (%t input-left)))
- (#;Left error)
- (#;Left error)))
+ (#R;Error error)
+ (#R;Error error)))
## [Generation]
(def: (sanitize-value input)
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index cb98f5624..ad37a01ca 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -8,7 +8,7 @@
enum
interval
codec)
- (data ["E" error])))
+ (data ["R" result])))
(def: (clean-separators input)
(-> Text Text)
@@ -159,10 +159,10 @@
(def: (decode input)
(case (_lux_proc <decoder> [input])
(#;Some value)
- (#;Right value)
+ (#R;Success value)
#;None
- (#;Left <error>))))]
+ (#R;Error <error>))))]
[Real ["real" "encode"] ["real" "decode"] "Could not decode Real"]
)
@@ -214,16 +214,16 @@
(_lux_proc ["char" "to-text"] [digit])
+0])
#;None
- (#;Left (_lux_proc ["text" "append"] [<error> repr]))
+ (#R;Error (_lux_proc ["text" "append"] [<error> repr]))
(#;Some index)
(recur (n.inc idx)
(|> output (n.* <base>) (n.+ index)))))
- (#;Right output))))
+ (#R;Success output))))
_
- (#;Left (_lux_proc ["text" "append"] [<error> repr])))
- (#;Left (_lux_proc ["text" "append"] [<error> repr]))))))]
+ (#R;Error (_lux_proc ["text" "append"] [<error> repr])))
+ (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))))]
[Binary@Codec<Text,Nat> +2 "01" "Invalid binary syntax for Nat: "]
[Octal@Codec<Text,Nat> +8 "01234567" "Invalid octal syntax for Nat: "]
@@ -271,13 +271,13 @@
(_lux_proc ["char" "to-text"] [digit])
+0])
#;None
- (#;Left <error>)
+ (#R;Error <error>)
(#;Some index)
(recur (n.inc idx)
(|> output (i.* <base>) (i.+ (:! Int index))))))
- (#;Right (i.* sign output)))))
- (#;Left <error>)))))]
+ (#R;Success (i.* sign output)))))
+ (#R;Error <error>)))))]
[Binary@Codec<Text,Int> 2 "01" "Invalid binary syntax for Int: "]
[Octal@Codec<Text,Int> 8 "01234567" "Invalid octal syntax for Int: "]
@@ -311,11 +311,11 @@
(^=> (#;Some #".")
[(:: <nat> decode (_lux_proc ["text" "append"] ["+" (de-prefix repr)]))
(#;Some output)])
- (#;Right (:! Deg output))
+ (#R;Success (:! Deg output))
_
- (#;Left (_lux_proc ["text" "append"] [<error> repr])))
- (#;Left (_lux_proc ["text" "append"] [<error> repr]))))))]
+ (#R;Error (_lux_proc ["text" "append"] [<error> repr])))
+ (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))))]
[Binary@Codec<Text,Deg> Binary@Codec<Text,Nat> +1 "Invalid binary syntax: "]
[Octal@Codec<Text,Deg> Octal@Codec<Text,Nat> +3 "Invalid octal syntax: "]
@@ -362,19 +362,19 @@
(r.* <base> output))))
adjusted-decimal (|> decimal int-to-real (r./ div-power))
dec-deg (case (:: Hex@Codec<Text,Deg> decode (_lux_proc ["text" "append"] ["." decimal-part]))
- (#;Right dec-deg)
+ (#R;Success dec-deg)
dec-deg
- (#;Left error)
+ (#R;Error error)
(error! error))]
- (#;Right (r.+ (int-to-real whole)
- (r.* sign adjusted-decimal))))
+ (#R;Success (r.+ (int-to-real whole)
+ (r.* sign adjusted-decimal))))
_
- (#;Left (_lux_proc ["text" "append"] [<error> repr]))))
+ (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))
_
- (#;Left (_lux_proc ["text" "append"] [<error> repr])))))]
+ (#R;Error (_lux_proc ["text" "append"] [<error> repr])))))]
[Binary@Codec<Text,Real> Binary@Codec<Text,Int> 2.0 "01" "Invalid binary syntax: "]
)
@@ -552,14 +552,14 @@
[(if (r.= -1.0 sign) "-" "")]
(_lux_proc ["text" "append"]))]
(case (:: Binary@Codec<Text,Real> decode as-binary)
- (#;Left _)
- (#;Left (_lux_proc ["text" "append"] [<error> repr]))
+ (#R;Error _)
+ (#R;Error (_lux_proc ["text" "append"] [<error> repr]))
output
output))
_
- (#;Left (_lux_proc ["text" "append"] [<error> repr]))))))]
+ (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))))]
[Octal@Codec<Text,Real> "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary]
[Hex@Codec<Text,Real> "Invalid hexadecimal syntax: " binary-to-hex hex-to-binary]
@@ -571,26 +571,26 @@
(case tokens
(#;Cons [meta (#;Text repr)] #;Nil)
(case (:: <nat> decode repr)
- (#;Right value)
- (#;Right [state (list [meta (#;Nat value)])])
+ (#R;Success value)
+ (#R;Success [state (list [meta (#;Nat value)])])
- (^=> (#;Left _)
- [(:: <int> decode repr) (#;Right value)])
- (#;Right [state (list [meta (#;Int value)])])
+ (^=> (#R;Error _)
+ [(:: <int> decode repr) (#R;Success value)])
+ (#R;Success [state (list [meta (#;Int value)])])
- (^=> (#;Left _)
- [(:: <deg> decode repr) (#;Right value)])
- (#;Right [state (list [meta (#;Deg value)])])
+ (^=> (#R;Error _)
+ [(:: <deg> decode repr) (#R;Success value)])
+ (#R;Success [state (list [meta (#;Deg value)])])
- (^=> (#;Left _)
- [(:: <real> decode repr) (#;Right value)])
- (#;Right [state (list [meta (#;Real value)])])
+ (^=> (#R;Error _)
+ [(:: <real> decode repr) (#R;Success value)])
+ (#R;Success [state (list [meta (#;Real value)])])
_
- (#;Left <error>))
+ (#R;Error <error>))
_
- (#;Left <error>)))]
+ (#R;Error <error>)))]
[bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Deg> Binary@Codec<Text,Real>
"Invalid binary syntax."
@@ -811,9 +811,9 @@
(recur (digits-sub! power digits)
(n.inc idx)
(bit-set (n.- idx (n.dec deg-bits)) output))))
- (#E;Success (:! Deg output))))
+ (#R;Success (:! Deg output))))
#;None
- (#E;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input])))
- (#E;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input]))))
+ (#R;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input])))
+ (#R;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input]))))
))
diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux
index 5f002e9df..94276e5f8 100644
--- a/stdlib/source/lux/data/number/complex.lux
+++ b/stdlib/source/lux/data/number/complex.lux
@@ -8,7 +8,7 @@
(data [number "r/" Number<Real> Codec<Text,Real>]
[text "Text/" Monoid<Text>]
text/format
- error
+ ["R" result]
maybe
(coll [list "List/" Monad<List>]))
[macro]
@@ -322,7 +322,7 @@
(#;Left (Text/append "Wrong syntax for complex numbers: " input))
(#;Some [r' i'])
- (do Monad<Error>
+ (do R;Monad<Result>
[r (r/decode (text;trim r'))
i (r/decode (text;trim i'))]
(wrap {#real r
diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux
index b5cc0e4b2..8497b3c5d 100644
--- a/stdlib/source/lux/data/number/ratio.lux
+++ b/stdlib/source/lux/data/number/ratio.lux
@@ -9,7 +9,7 @@
(data [number "n/" Number<Nat> Codec<Text,Nat>]
[text "Text/" Monoid<Text>]
text/format
- error
+ ["R" result]
[product])
[macro]
(macro [code]
@@ -129,7 +129,7 @@
(|>. n/encode (text;split +1) (default (undefined)) product;right))
(def: part-decode
- (-> Text (Error Nat))
+ (-> Text (R;Result Nat))
(|>. (format "+") n/decode))
(struct: #export _ (Codec Text Ratio)
@@ -139,7 +139,7 @@
(def: (decode input)
(case (text;split-with separator input)
(#;Some [num denom])
- (do Monad<Error>
+ (do R;Monad<Result>
[numerator (part-decode num)
denominator (part-decode denom)]
(wrap (normalize {#numerator numerator
diff --git a/stdlib/source/lux/data/error.lux b/stdlib/source/lux/data/result.lux
index f614305e0..3a713a174 100644
--- a/stdlib/source/lux/data/error.lux
+++ b/stdlib/source/lux/data/result.lux
@@ -5,19 +5,19 @@
["M" monad #*])))
## [Types]
-(type: #export (Error a)
+(type: #export (Result a)
(#Error Text)
(#Success a))
## [Structures]
-(struct: #export _ (Functor Error)
+(struct: #export _ (Functor Result)
(def: (map f ma)
(case ma
- (#Error msg) (#Error msg)
+ (#Error msg) (#Error msg)
(#Success datum) (#Success (f datum)))))
-(struct: #export _ (Applicative Error)
- (def: functor Functor<Error>)
+(struct: #export _ (Applicative Result)
+ (def: functor Functor<Result>)
(def: (wrap a)
(#Success a))
@@ -36,17 +36,17 @@
(#Error msg))
))
-(struct: #export _ (Monad Error)
- (def: applicative Applicative<Error>)
+(struct: #export _ (Monad Result)
+ (def: applicative Applicative<Result>)
(def: (join mma)
(case mma
(#Error msg) (#Error msg)
(#Success ma) ma)))
-(struct: #export (ErrorT Monad<M>)
- (All [M] (-> (Monad M) (Monad (All [a] (M (Error a))))))
- (def: applicative (compA (get@ #M;applicative Monad<M>) Applicative<Error>))
+(struct: #export (ResultT Monad<M>)
+ (All [M] (-> (Monad M) (Monad (All [a] (M (Result a))))))
+ (def: applicative (compA (get@ #M;applicative Monad<M>) Applicative<Result>))
(def: (join MeMea)
(do Monad<M>
[eMea MeMea]
@@ -57,14 +57,14 @@
(#Success Mea)
Mea))))
-(def: #export (lift-error Monad<M>)
- (All [M a] (-> (Monad M) (-> (M a) (M (Error a)))))
- (liftM Monad<M> (:: Monad<Error> wrap)))
+(def: #export (lift-result Monad<M>)
+ (All [M a] (-> (Monad M) (-> (M a) (M (Result a)))))
+ (liftM Monad<M> (:: Monad<Result> wrap)))
(def: #export (succeed value)
- (All [a] (-> a (Error a)))
+ (All [a] (-> a (Result a)))
(#Success value))
(def: #export (fail message)
- (All [a] (-> Text (Error a)))
+ (All [a] (-> Text (Result a)))
(#Error message))
diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux
index 34614c545..58e636b53 100644
--- a/stdlib/source/lux/data/text/lexer.lux
+++ b/stdlib/source/lux/data/text/lexer.lux
@@ -9,41 +9,41 @@
[product]
[char "Char/" Order<Char>]
maybe
- ["E" error #- fail]
+ ["R" result]
(coll [list "" Functor<List>]))))
## [Types]
(type: #export (Lexer a)
- (-> Text (Error [Text a])))
+ (-> Text (R;Result [Text a])))
## [Structures]
(struct: #export _ (Functor Lexer)
(def: (map f fa)
(function [input]
(case (fa input)
- (#E;Error msg) (#E;Error msg)
- (#E;Success [input' output]) (#E;Success [input' (f output)])))))
+ (#R;Error msg) (#R;Error msg)
+ (#R;Success [input' output]) (#R;Success [input' (f output)])))))
(struct: #export _ (Applicative Lexer)
(def: functor Functor<Lexer>)
(def: (wrap a)
(function [input]
- (#E;Success [input a])))
+ (#R;Success [input a])))
(def: (apply ff fa)
(function [input]
(case (ff input)
- (#E;Success [input' f])
+ (#R;Success [input' f])
(case (fa input')
- (#E;Success [input'' a])
- (#E;Success [input'' (f a)])
+ (#R;Success [input'' a])
+ (#R;Success [input'' (f a)])
- (#E;Error msg)
- (#E;Error msg))
+ (#R;Error msg)
+ (#R;Error msg))
- (#E;Error msg)
- (#E;Error msg)))))
+ (#R;Error msg)
+ (#R;Error msg)))))
(struct: #export _ (Monad Lexer)
(def: applicative Applicative<Lexer>)
@@ -51,31 +51,31 @@
(def: (join mma)
(function [input]
(case (mma input)
- (#E;Error msg) (#E;Error msg)
- (#E;Success [input' ma]) (ma input'))))
+ (#R;Error msg) (#R;Error msg)
+ (#R;Success [input' ma]) (ma input'))))
)
## [Values]
## Runner
(def: #export (run' input lexer)
- (All [a] (-> Text (Lexer a) (Error [Text a])))
+ (All [a] (-> Text (Lexer a) (R;Result [Text a])))
(lexer input))
(def: #export (run input lexer)
- (All [a] (-> Text (Lexer a) (Error a)))
+ (All [a] (-> Text (Lexer a) (R;Result a)))
(case (lexer input)
- (#E;Error msg)
- (#E;Error msg)
+ (#R;Error msg)
+ (#R;Error msg)
- (#E;Success [input' output])
- (#E;Success output)
+ (#R;Success [input' output])
+ (#R;Success output)
))
## Combinators
(def: #export (fail message)
(All [a] (-> Text (Lexer a)))
(function [input]
- (#E;Error message)))
+ (#R;Error message)))
(def: #export any
{#;doc "Just returns the next character without applying any logic."}
@@ -83,10 +83,10 @@
(function [input]
(case [(text;nth +0 input) (text;split +1 input)]
[(#;Some output) (#;Some [_ input'])]
- (#E;Success [input' output])
+ (#R;Success [input' output])
_
- (#E;Error "Cannot parse character from empty text."))
+ (#R;Error "Cannot parse character from empty text."))
))
(def: #export (seq left right)
@@ -102,45 +102,45 @@
(All [a b] (-> (Lexer a) (Lexer b) (Lexer (| a b))))
(function [input]
(case (left input)
- (#E;Error msg)
+ (#R;Error msg)
(case (right input)
- (#E;Error msg)
- (#E;Error msg)
+ (#R;Error msg)
+ (#R;Error msg)
- (#E;Success [input' output])
- (#E;Success [input' (+1 output)]))
+ (#R;Success [input' output])
+ (#R;Success [input' (+1 output)]))
- (#E;Success [input' output])
- (#E;Success [input' (+0 output)]))))
+ (#R;Success [input' output])
+ (#R;Success [input' (+0 output)]))))
(def: #export (not! p)
{#;doc "Ensure a lexer fails."}
(All [a] (-> (Lexer a) (Lexer Unit)))
(function [input]
(case (p input)
- (#E;Error msg)
- (#E;Success [input []])
+ (#R;Error msg)
+ (#R;Success [input []])
_
- (#E;Error "Expected to fail; yet succeeded."))))
+ (#R;Error "Expected to fail; yet succeeded."))))
(def: #export (not p)
{#;doc "Produce a character if the lexer fails."}
(All [a] (-> (Lexer a) (Lexer Char)))
(function [input]
(case (p input)
- (#E;Error msg)
+ (#R;Error msg)
(any input)
_
- (#E;Error "Expected to fail; yet succeeded."))))
+ (#R;Error "Expected to fail; yet succeeded."))))
(def: #export (either left right)
{#;doc "Homogeneous alternative combinator."}
(All [a] (-> (Lexer a) (Lexer a) (Lexer a)))
(function [input]
(case (left input)
- (#E;Error msg)
+ (#R;Error msg)
(right input)
output
@@ -151,18 +151,18 @@
(-> Text Bool (Lexer Unit))
(function [input]
(if test
- (#E;Success [input []])
- (#E;Error message))))
+ (#R;Success [input []])
+ (#R;Error message))))
(def: #export (some p)
{#;doc "0-or-more combinator."}
(All [a] (-> (Lexer a) (Lexer (List a))))
(function [input]
(case (p input)
- (#E;Error msg)
- (#E;Success [input (list)])
+ (#R;Error msg)
+ (#R;Success [input (list)])
- (#E;Success [input' x])
+ (#R;Success [input' x])
(run' input'
(do Monad<Lexer>
[xs (some p)]
@@ -193,10 +193,10 @@
(if (n.> +0 n)
(function [input]
(case (p input)
- (#E;Error msg)
- (#E;Success [input (list)])
+ (#R;Error msg)
+ (#R;Success [input (list)])
- (#E;Success [input' x])
+ (#R;Success [input' x])
(run' input'
(do Monad<Lexer>
[xs (at-most (n.dec n) p)]
@@ -225,11 +225,11 @@
(All [a] (-> (Lexer a) (Lexer (Maybe a))))
(function [input]
(case (p input)
- (#E;Error msg)
- (#E;Success [input #;None])
+ (#R;Error msg)
+ (#R;Success [input #;None])
- (#E;Success [input value])
- (#E;Success [input (#;Some value)])
+ (#R;Success [input value])
+ (#R;Success [input (#;Some value)])
)))
(def: #export (text test)
@@ -238,10 +238,10 @@
(function [input]
(if (text;starts-with? test input)
(case (text;split (text;size test) input)
- #;None (#E;Error "")
- (#;Some [_ input']) (#E;Success [input' test]))
+ #;None (#R;Error "")
+ (#;Some [_ input']) (#R;Success [input' test]))
(let [(^open "T/") text;Codec<Text,Text>]
- (#E;Error ($_ Text/append "Invalid match: " (T/encode test) " @ " (T/encode input)))))
+ (#R;Error ($_ Text/append "Invalid match: " (T/encode test) " @ " (T/encode input)))))
))
(def: #export (sep-by sep lexer)
@@ -264,8 +264,8 @@
(Lexer Unit)
(function [input]
(case input
- "" (#E;Success [input []])
- _ (#E;Error ($_ Text/append "The text input has not been fully consumed @ " (:: text;Codec<Text,Text> encode input)))
+ "" (#R;Success [input []])
+ _ (#R;Error ($_ Text/append "The text input has not been fully consumed @ " (:: text;Codec<Text,Text> encode input)))
)))
(def: #export peek
@@ -274,10 +274,10 @@
(function [input]
(case (text;nth +0 input)
(#;Some output)
- (#E;Success [input output])
+ (#R;Success [input output])
_
- (#E;Error "Cannot peek character from empty text."))
+ (#R;Error "Cannot peek character from empty text."))
))
(def: #export (char test)
@@ -287,18 +287,18 @@
(case [(text;nth +0 input) (text;split +1 input)]
[(#;Some char') (#;Some [_ input'])]
(if (Char/= test char')
- (#E;Success [input' test])
- (#E;Error ($_ Text/append "Expected " (:: char;Codec<Text,Char> encode test) " @ " (:: text;Codec<Text,Text> encode input))))
+ (#R;Success [input' test])
+ (#R;Error ($_ Text/append "Expected " (:: char;Codec<Text,Char> encode test) " @ " (:: text;Codec<Text,Text> encode input))))
_
- (#E;Error "Cannot parse character from empty text."))
+ (#R;Error "Cannot parse character from empty text."))
))
(def: #export get-input
{#;doc "Get all of the remaining input (without consuming it)."}
(Lexer Text)
(function [input]
- (#E;Success [input input])))
+ (#R;Success [input input])))
(def: #export (char-range bottom top)
{#;doc "Only lex characters within a range."}
@@ -350,14 +350,14 @@
(if (text;contains? init options)
(case (text;nth +0 init)
(#;Some output)
- (#E;Success [input' output])
+ (#R;Success [input' output])
_
- (#E;Error ""))
- (#E;Error ($_ Text/append "Character (" init ") is not one of: " options " @ " (:: text;Codec<Text,Text> encode input))))
+ (#R;Error ""))
+ (#R;Error ($_ Text/append "Character (" init ") is not one of: " options " @ " (:: text;Codec<Text,Text> encode input))))
_
- (#E;Error "Cannot parse character from empty text."))))
+ (#R;Error "Cannot parse character from empty text."))))
(def: #export (none-of options)
{#;doc "Only lex characters that are not part of a piece of text."}
@@ -368,14 +368,14 @@
(if (;not (text;contains? init options))
(case (text;nth +0 init)
(#;Some output)
- (#E;Success [input' output])
+ (#R;Success [input' output])
_
- (#E;Error ""))
- (#E;Error ($_ Text/append "Character (" init ") is one of: " options " @ " (:: text;Codec<Text,Text> encode input))))
+ (#R;Error ""))
+ (#R;Error ($_ Text/append "Character (" init ") is one of: " options " @ " (:: text;Codec<Text,Text> encode input))))
_
- (#E;Error "Cannot parse character from empty text."))))
+ (#R;Error "Cannot parse character from empty text."))))
(def: #export (satisfies p)
{#;doc "Only lex characters that satisfy a predicate."}
@@ -388,11 +388,11 @@
(wrap [input' output])))
(#;Some [input' output])
(if (p output)
- (#E;Success [input' output])
- (#E;Error ($_ Text/append "Character does not satisfy predicate: " (:: text;Codec<Text,Text> encode input))))
+ (#R;Success [input' output])
+ (#R;Error ($_ Text/append "Character does not satisfy predicate: " (:: text;Codec<Text,Text> encode input))))
_
- (#E;Error "Cannot parse character from empty text."))))
+ (#R;Error "Cannot parse character from empty text."))))
(def: #export space
{#;doc "Only lex white-space."}
@@ -445,7 +445,7 @@
{#;doc "Ask if the lexer's input is empty."}
(Lexer Bool)
(function [input]
- (#E;Success [input (text;empty? input)])))
+ (#R;Success [input (text;empty? input)])))
(def: #export (after param subject)
(All [p s] (-> (Lexer p) (Lexer s) (Lexer s)))
@@ -465,27 +465,27 @@
(All [a] (-> a (Lexer a) (Lexer a)))
(function [input]
(case (lexer input)
- (#E;Error error)
- (#E;Success [input value])
+ (#R;Error error)
+ (#R;Success [input value])
- (#E;Success input'+value)
- (#E;Success input'+value))))
+ (#R;Success input'+value)
+ (#R;Success input'+value))))
(def: #export (codec codec lexer)
{#;doc "Lex a token by means of a codec."}
(All [a] (-> (Codec Text a) (Lexer Text) (Lexer a)))
(function [input]
(case (lexer input)
- (#E;Error error)
- (#E;Error error)
+ (#R;Error error)
+ (#R;Error error)
- (#E;Success [input' to-decode])
+ (#R;Success [input' to-decode])
(case (:: codec decode to-decode)
- (#E;Error error)
- (#E;Error error)
+ (#R;Error error)
+ (#R;Error error)
- (#E;Success value)
- (#E;Success [input' value])))))
+ (#R;Success value)
+ (#R;Success [input' value])))))
(def: #export (enclosed [start end] lexer)
(All [a] (-> [Text Text] (Lexer a) (Lexer a)))
@@ -504,13 +504,13 @@
(All [a] (-> Text (Lexer a) (Lexer a)))
(function [real-input]
(case (run' local-input lexer)
- (#E;Error error)
- (#E;Error error)
+ (#R;Error error)
+ (#R;Error error)
- (#E;Success [unconsumed value])
+ (#R;Success [unconsumed value])
(if (Text/= "" unconsumed)
- (#E;Success [real-input value])
- (#E;Error ($_ Text/append "Unconsumed input: " unconsumed))))))
+ (#R;Success [real-input value])
+ (#R;Error ($_ Text/append "Unconsumed input: " unconsumed))))))
(def: #export (seq' left right)
(-> (Lexer Text) (Lexer Text) (Lexer Text))
diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux
index 5ff8b5073..75ba9d587 100644
--- a/stdlib/source/lux/macro.lux
+++ b/stdlib/source/lux/macro.lux
@@ -10,41 +10,41 @@
[product]
[ident "Ident/" Codec<Text,Ident>]
maybe
- ["E" error #- fail])))
+ ["R" result])))
## (type: (Lux a)
-## (-> Compiler (Error [Compiler a])))
+## (-> Compiler (R;Result [Compiler a])))
(struct: #export _ (Functor Lux)
(def: (map f fa)
(function [state]
(case (fa state)
- (#;Left msg)
- (#;Left msg)
+ (#R;Error msg)
+ (#R;Error msg)
- (#;Right [state' a])
- (#;Right [state' (f a)])))))
+ (#R;Success [state' a])
+ (#R;Success [state' (f a)])))))
(struct: #export _ (Applicative Lux)
(def: functor Functor<Lux>)
(def: (wrap x)
(function [state]
- (#;Right [state x])))
+ (#R;Success [state x])))
(def: (apply ff fa)
(function [state]
(case (ff state)
- (#;Right [state' f])
+ (#R;Success [state' f])
(case (fa state')
- (#;Right [state'' a])
- (#;Right [state'' (f a)])
+ (#R;Success [state'' a])
+ (#R;Success [state'' (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 Lux)
(def: applicative Applicative<Lux>)
@@ -52,10 +52,10 @@
(def: (join mma)
(function [state]
(case (mma state)
- (#;Left msg)
- (#;Left msg)
+ (#R;Error msg)
+ (#R;Error msg)
- (#;Right [state' ma])
+ (#R;Success [state' ma])
(ma state')))))
(def: (get k plist)
@@ -71,53 +71,53 @@
(get k plist'))))
(def: #export (run' compiler action)
- (All [a] (-> Compiler (Lux a) (Error [Compiler a])))
+ (All [a] (-> Compiler (Lux a) (R;Result [Compiler a])))
(action compiler))
(def: #export (run compiler action)
- (All [a] (-> Compiler (Lux a) (Error a)))
+ (All [a] (-> Compiler (Lux a) (R;Result a)))
(case (action compiler)
- (#;Left error)
- (#;Left error)
+ (#R;Error error)
+ (#R;Error error)
- (#;Right [_ output])
- (#;Right output)))
+ (#R;Success [_ output])
+ (#R;Success output)))
(def: #export (either left right)
{#;doc "Pick whichever computation succeeds."}
(All [a] (-> (Lux a) (Lux a) (Lux a)))
(function [compiler]
(case (left compiler)
- (#;Left error)
+ (#R;Error error)
(right compiler)
- (#;Right [compiler' output])
- (#;Right [compiler' output]))))
+ (#R;Success [compiler' output])
+ (#R;Success [compiler' output]))))
(def: #export (assert message test)
{#;doc "Fails with the given message if the test is false."}
(-> Text Bool (Lux Unit))
(function [compiler]
(if test
- (#;Right [compiler []])
- (#;Left message))))
+ (#R;Success [compiler []])
+ (#R;Error message))))
(def: #export (fail msg)
{#;doc "Fails with the given message."}
(All [a]
(-> Text (Lux a)))
(function [_]
- (#;Left msg)))
+ (#R;Error msg)))
(def: #export (find-module name)
(-> Text (Lux Module))
(function [state]
(case (get name (get@ #;modules state))
(#;Some module)
- (#;Right [state module])
+ (#R;Success [state module])
_
- (#;Left ($_ Text/append "Unknown module: " name)))))
+ (#R;Error ($_ Text/append "Unknown module: " name)))))
(def: #export current-module-name
(Lux Text)
@@ -126,13 +126,13 @@
(#;Some scope)
(case (get@ #;name scope)
(#;Cons m-name #;Nil)
- (#;Right [state m-name])
+ (#R;Success [state m-name])
_
- (#;Left "Improper name for scope."))
+ (#R;Error "Improper name for scope."))
_
- (#;Left "Empty environment!")
+ (#R;Error "Empty environment!")
)))
(def: #export current-module
@@ -256,7 +256,7 @@
(let [[module name] ident]
(: (Lux (Maybe Macro))
(function [state]
- (#;Right [state (find-macro' (get@ #;modules state) this-module module name)]))))))
+ (#R;Success [state (find-macro' (get@ #;modules state) this-module module name)]))))))
(def: #export (normalize ident)
{#;doc "If given an identifier without a module prefix, gives it the current module's name as prefix.
@@ -355,8 +355,8 @@
A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."}
(-> Text (Lux Code))
(function [state]
- (#;Right [(update@ #;seed n.inc state)
- (code;symbol ["" ($_ Text/append "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])])))
+ (#R;Success [(update@ #;seed n.inc state)
+ (code;symbol ["" ($_ Text/append "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])])))
(def: (get-local-symbol ast)
(-> Code (Lux Text))
@@ -406,12 +406,12 @@
(def: #export (module-exists? module)
(-> Text (Lux Bool))
(function [state]
- (#;Right [state (case (get module (get@ #;modules state))
- (#;Some _)
- true
-
- #;None
- false)])))
+ (#R;Success [state (case (get module (get@ #;modules state))
+ (#;Some _)
+ true
+
+ #;None
+ false)])))
(def: (try-both f x1 x2)
(All [a b]
@@ -440,10 +440,10 @@
(get@ [#;captured #;mappings] scope)))]
(wrap type))
(#;Some var-type)
- (#;Right [state var-type])
+ (#R;Success [state var-type])
#;None
- (#;Left ($_ Text/append "Unknown variable: " name))))))
+ (#R;Error ($_ Text/append "Unknown variable: " name))))))
(def: #export (find-def name)
{#;doc "Looks-up a definition's whole data in the available modules (including the current one)."}
@@ -455,10 +455,10 @@
(^slots [#;defs]) (get v-prefix (get@ #;modules state))]
(get v-name defs)))
(#;Some _anns)
- (#;Right [state _anns])
+ (#R;Success [state _anns])
_
- (#;Left ($_ Text/append "Unknown definition: " (Ident/encode name))))))
+ (#R;Error ($_ Text/append "Unknown definition: " (Ident/encode name))))))
(def: #export (find-def-type name)
{#;doc "Looks-up a definition's type in the available modules (including the current one)."}
@@ -489,8 +489,8 @@
(-> Text (Lux (List [Text Def])))
(function [state]
(case (get module-name (get@ #;modules state))
- #;None (#;Left ($_ Text/append "Unknown module: " module-name))
- (#;Some module) (#;Right [state (get@ #;defs module)])
+ #;None (#R;Error ($_ Text/append "Unknown module: " module-name))
+ (#;Some module) (#R;Success [state (get@ #;defs module)])
)))
(def: #export (exports module-name)
@@ -510,7 +510,7 @@
(|> state
(get@ #;modules)
[state]
- #;Right)))
+ #R;Success)))
(def: #export (tags-of type-name)
{#;doc "All the tags associated with a type definition."}
@@ -529,7 +529,7 @@
{#;doc "The cursor of the current expression being analyzed."}
(Lux Cursor)
(function [state]
- (#;Right [state (get@ #;cursor state)])))
+ (#R;Success [state (get@ #;cursor state)])))
(def: #export expected-type
{#;doc "The expected type of the current expression being analyzed."}
@@ -537,10 +537,10 @@
(function [state]
(case (get@ #;expected state)
(#;Some type)
- (#;Right [state type])
+ (#R;Success [state type])
#;None
- (#;Left "Not expecting any type."))))
+ (#R;Error "Not expecting any type."))))
(def: #export (imported-modules module-name)
{#;doc "All the modules imported by a specified module."}
@@ -585,14 +585,14 @@
(function [state]
(case (list;inits (get@ #;scopes state))
#;None
- (#;Left "No local environment")
+ (#R;Error "No local environment")
(#;Some scopes)
- (#;Right [state
- (List/map (|>. (get@ [#;locals #;mappings])
- (List/map (function [[name [type _]]]
- [name type])))
- scopes)]))))
+ (#R;Success [state
+ (List/map (|>. (get@ [#;locals #;mappings])
+ (List/map (function [[name [type _]]]
+ [name type])))
+ scopes)]))))
(def: #export (un-alias def-name)
{#;doc "Given an aliased definition's name, returns the original definition being referenced."}
@@ -611,12 +611,12 @@
{#;doc "Obtains the current state of the compiler."}
(Lux Compiler)
(function [compiler]
- (#;Right [compiler compiler])))
+ (#R;Success [compiler compiler])))
(def: #export type-context
(Lux Type-Context)
(function [compiler]
- (#;Right [compiler (get@ #;type-context compiler)])))
+ (#R;Success [compiler (get@ #;type-context compiler)])))
(do-template [<macro> <func> <desc>]
[(macro: #export (<macro> tokens)
diff --git a/stdlib/source/lux/macro/poly/functor.lux b/stdlib/source/lux/macro/poly/functor.lux
index 06ebe60e4..136080fa7 100644
--- a/stdlib/source/lux/macro/poly/functor.lux
+++ b/stdlib/source/lux/macro/poly/functor.lux
@@ -11,8 +11,7 @@
[bool]
[char]
[maybe]
- [ident "Ident/" Codec<Text,Ident>]
- error)
+ [ident "Ident/" Codec<Text,Ident>])
[macro #+ Monad<Lux> with-gensyms]
(macro [code]
[syntax #+ syntax: Syntax]
diff --git a/stdlib/source/lux/macro/poly/text-encoder.lux b/stdlib/source/lux/macro/poly/text-encoder.lux
index 2dde16640..e1250c9e7 100644
--- a/stdlib/source/lux/macro/poly/text-encoder.lux
+++ b/stdlib/source/lux/macro/poly/text-encoder.lux
@@ -11,8 +11,7 @@
[bool]
[char]
[maybe]
- [ident "Ident/" Codec<Text,Ident>]
- error)
+ [ident "Ident/" Codec<Text,Ident>])
[macro #+ Monad<Lux> with-gensyms]
(macro [code]
[syntax #+ syntax: Syntax]
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:"))))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index e9e979ad2..4e63a8b28 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -7,11 +7,11 @@
applicative
monad)
(concurrency [promise #+ Promise Monad<Promise>])
- (data (coll [list "List/" Monad<List> Fold<List>])
+ (data (coll [list "L/" Monad<List> Fold<List>])
[product]
[text]
text/format
- [error #- fail "Error/" Monad<Error>])
+ ["E" result])
[io #- run]
["R" math/random]))
@@ -31,41 +31,41 @@
## [Types]
(type: #export Test
{#;doc "Tests are asynchronous process which may fail."}
- (Promise (Error Unit)))
+ (Promise (E;Result Unit)))
## [Values]
(def: #export (fail message)
(All [a] (-> Text Test))
- (:: Monad<Promise> wrap (#;Left message)))
+ (:: Monad<Promise> wrap (#E;Error message)))
(def: #export (assert message condition)
{#;doc "Check that a condition is true, and fail with the given message otherwise."}
(-> Text Bool Test)
(if condition
- (:: Monad<Promise> wrap (#;Right []))
+ (:: Monad<Promise> wrap (#E;Success []))
(fail message)))
(def: #hidden (run' tests)
(-> (List [Text (IO Test) Text]) (Promise Nat))
(do Monad<Promise>
- [#let [test-runs (List/map (: (-> [Text (IO Test) Text] (Promise Nat))
- (function [[module test description]]
- (do @
- [#let [pre (io;run now)]
- outcome (io;run test)
- #let [post (io;run now)
- description+ (:: text;Codec<Text,Text> encode description)]]
- (case outcome
- (#;Left error)
- (exec (log! (format "Error: " description+ " @ " module "\n" error "\n"))
- (wrap +0))
-
- _
- (exec (log! (format "Success: " description+ " @ " module " in " (%i (i.- pre post)) "ms"))
- (wrap +1))))))
- tests)]
+ [#let [test-runs (L/map (: (-> [Text (IO Test) Text] (Promise Nat))
+ (function [[module test description]]
+ (do @
+ [#let [pre (io;run now)]
+ outcome (io;run test)
+ #let [post (io;run now)
+ description+ (:: text;Codec<Text,Text> encode description)]]
+ (case outcome
+ (#E;Error error)
+ (exec (log! (format "Error: " description+ " @ " module "\n" error "\n"))
+ (wrap +0))
+
+ _
+ (exec (log! (format "Success: " description+ " @ " module " in " (%i (i.- pre post)) "ms"))
+ (wrap +1))))))
+ tests)]
test-runs (seqM @ test-runs)]
- (wrap (List/fold n.+ +0 test-runs))))
+ (wrap (L/fold n.+ +0 test-runs))))
(def: pcg-32-magic-inc Nat +12345)
@@ -74,7 +74,7 @@
Nat)
(def: (try seed random-test)
- (-> Seed (R;Random Test) (Promise (Error Seed)))
+ (-> Seed (R;Random Test) (Promise (E;Result Seed)))
(let [[prng [new-seed test]] (R;run (R;pcg-32 [pcg-32-magic-inc seed])
(do R;Monad<Random>
[test random-test
@@ -83,11 +83,11 @@
(do Monad<Promise>
[result test]
(case result
- (#;Left error)
- (wrap (#;Left error))
+ (#E;Error error)
+ (wrap (#E;Error error))
- (#;Right _)
- (wrap (#;Right new-seed))))))
+ (#E;Success _)
+ (wrap (#E;Success new-seed))))))
(def: (repeat' seed times random-test)
(-> Seed Nat (R;Random Test) Test)
@@ -96,12 +96,12 @@
(do Monad<Promise>
[output (try seed random-test)]
(case output
- (#;Left error)
+ (#E;Error error)
(fail (format "Test failed with this seed: " (%n seed) "\n" error))
- (#;Right seed')
+ (#E;Success seed')
(if (n.= +1 times)
- (wrap (#;Right []))
+ (wrap (#E;Success []))
(repeat' seed' (n.dec times) random-test))
))))
@@ -156,10 +156,10 @@
(def: #hidden (try-body lazy-body)
(-> (IO Test) Test)
(case (_lux_proc ["lux" "try"] [lazy-body])
- (#;Right output)
+ (#E;Success output)
output
- (#;Left error)
+ (#E;Error error)
(assert error false)))
(syntax: #export (test: description [body test^])
@@ -231,7 +231,7 @@
(#;Some (#Times value))
[(` #;None) value])
- bindings' (|> bindings (List/map pair-to-list) List/join)]
+ bindings' (|> bindings (L/map pair-to-list) L/join)]
(` (repeat (~ =seed)
(~ (code;nat =times))
(do R;Monad<Random>
@@ -251,15 +251,15 @@
(do Monad<Lux>
[defs (macro;exports module-name)]
(wrap (|> defs
- (List/map (function [[def-name [_ def-anns _]]]
- (case (macro;get-text-ann (ident-for #;;test) def-anns)
- (#;Some description)
- [true module-name def-name description]
+ (L/map (function [[def-name [_ def-anns _]]]
+ (case (macro;get-text-ann (ident-for #;;test) def-anns)
+ (#;Some description)
+ [true module-name def-name description]
- _
- [false module-name def-name ""])))
+ _
+ [false module-name def-name ""])))
(list;filter product;left)
- (List/map product;right)))))
+ (L/map product;right)))))
(def: #hidden _appendT_ (-> Text Text Text) (:: text;Monoid<Text> append))
(def: #hidden _%i_ (-> Int Text) %i)
@@ -275,19 +275,19 @@
(|> (#;Cons current-module modules)
list;reverse
(mapM @ exported-tests)
- (:: @ map List/join)))
- #let [tests+ (List/map (function [[module-name test desc]]
- (` [(~ (code;text module-name)) (~ (code;symbol [module-name test])) (~ (code;text desc))]))
- tests)
+ (:: @ map L/join)))
+ #let [tests+ (L/map (function [[module-name test desc]]
+ (` [(~ (code;text module-name)) (~ (code;symbol [module-name test])) (~ (code;text desc))]))
+ tests)
num-tests (list;size tests+)
groups (list;split-all promise;concurrency-level tests+)]]
(wrap (list (` (: (IO Unit)
(io (exec (do Monad<Promise>
[(~' #let) [(~ g!accum) +0]
- (~@ (List/join (List/map (function [group]
- (list g!_ (` (run' (list (~@ group))))
- (' #let) (` [(~ g!accum) (n.+ (~ g!_) (~ g!accum))])))
- groups)))
+ (~@ (L/join (L/map (function [group]
+ (list g!_ (` (run' (list (~@ group))))
+ (' #let) (` [(~ g!accum) (n.+ (~ g!_) (~ g!accum))])))
+ groups)))
(~' #let) [(~ g!_) (n.- (~ g!accum) (~ (code;nat num-tests)))]]
(exec (log! ($_ _appendT_
"Test-suite finished."
@@ -310,12 +310,12 @@
[=left left
=right right]
(case [=left =right]
- (^or [(#;Left error) _]
- [_ (#;Left error)])
- (wrap (#;Left error))
+ (^or [(#E;Error error) _]
+ [_ (#E;Error error)])
+ (wrap (#E;Error error))
_
- (wrap (#;Right [])))))
+ (wrap (#E;Success [])))))
(def: #export (alt left right)
{#;doc "Alternative combinator."}
@@ -324,7 +324,7 @@
[=left left
=right right]
(case =left
- (#;Right _)
+ (#E;Success _)
(wrap =left)
_
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 56198f5ab..e8f24102c 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -10,14 +10,14 @@
maybe
[product]
(coll [list])
- [error #- fail])
+ ["R" result])
[type "Type/" Eq<Type>]
))
(type: #export Fixed (List [[Type Type] Bool]))
(type: #export (Check a)
- (-> Type-Context (Error [Type-Context a])))
+ (-> Type-Context (R;Result [Type-Context a])))
(type: #export Type-Vars
(List [Nat (Maybe Type)]))
@@ -26,11 +26,11 @@
(def: (map f fa)
(function [context]
(case (fa context)
- (#;Left error)
- (#;Left error)
+ (#R;Error error)
+ (#R;Error error)
- (#;Right [context' output])
- (#;Right [context' (f output)])
+ (#R;Success [context' output])
+ (#R;Success [context' (f output)])
))))
(struct: #export _ (Applicative Check)
@@ -38,21 +38,21 @@
(def: (wrap x)
(function [context]
- (#;Right [context x])))
+ (#R;Success [context x])))
(def: (apply ff fa)
(function [context]
(case (ff context)
- (#;Right [context' f])
+ (#R;Success [context' f])
(case (fa context')
- (#;Right [context'' a])
- (#;Right [context'' (f a)])
+ (#R;Success [context'' a])
+ (#R;Success [context'' (f a)])
- (#;Left error)
- (#;Left error))
+ (#R;Error error)
+ (#R;Error error))
- (#;Left error)
- (#;Left error)
+ (#R;Error error)
+ (#R;Error error)
)))
)
@@ -62,16 +62,16 @@
(def: (join ffa)
(function [context]
(case (ffa context)
- (#;Right [context' fa])
+ (#R;Success [context' fa])
(case (fa context')
- (#;Right [context'' a])
- (#;Right [context'' a])
+ (#R;Success [context'' a])
+ (#R;Success [context'' a])
- (#;Left error)
- (#;Left error))
+ (#R;Error error)
+ (#R;Error error))
- (#;Left error)
- (#;Left error)
+ (#R;Error error)
+ (#R;Error error)
)))
)
@@ -121,93 +121,93 @@
## [[Logic]]
(def: #export (run context proc)
- (All [a] (-> Type-Context (Check a) (Error a)))
+ (All [a] (-> Type-Context (Check a) (R;Result a)))
(case (proc context)
- (#;Left error)
- (#;Left error)
+ (#R;Error error)
+ (#R;Error error)
- (#;Right [context' output])
- (#;Right output)))
+ (#R;Success [context' output])
+ (#R;Success output)))
(def: (apply-type! t-func t-arg)
(-> Type Type (Check Type))
(function [context]
(case (type;apply-type t-func t-arg)
#;None
- (#;Left (format "Invalid type application: " (%type t-func) " on " (%type t-arg)))
+ (#R;Error (format "Invalid type application: " (%type t-func) " on " (%type t-arg)))
(#;Some output)
- (#;Right [context output]))))
+ (#R;Success [context output]))))
(def: #export existential
{#;doc "A producer of existential types."}
(Check [Nat Type])
(function [context]
(let [id (get@ #;ex-counter context)]
- (#;Right [(update@ #;ex-counter n.inc context)
- [id (#;Ex id)]]))))
+ (#R;Success [(update@ #;ex-counter n.inc context)
+ [id (#;Ex id)]]))))
(def: #export (bound? id)
(-> Nat (Check Bool))
(function [context]
(case (|> context (get@ #;var-bindings) (var::get id))
(#;Some (#;Some _))
- (#;Right [context true])
+ (#R;Success [context true])
(#;Some #;None)
- (#;Right [context false])
+ (#R;Success [context false])
#;None
- (#;Left (format "Unknown type-var: " (%n id))))))
+ (#R;Error (format "Unknown type-var: " (%n id))))))
(def: #export (read-var id)
(-> Nat (Check Type))
(function [context]
(case (|> context (get@ #;var-bindings) (var::get id))
(#;Some (#;Some type))
- (#;Right [context type])
+ (#R;Success [context type])
(#;Some #;None)
- (#;Left (format "Unbound type-var: " (%n id)))
+ (#R;Error (format "Unbound type-var: " (%n id)))
#;None
- (#;Left (format "Unknown type-var: " (%n id))))))
+ (#R;Error (format "Unknown type-var: " (%n id))))))
(def: #export (write-var id type)
(-> Nat Type (Check Unit))
(function [context]
(case (|> context (get@ #;var-bindings) (var::get id))
(#;Some (#;Some bound))
- (#;Left (format "Cannot rebind type-var: " (%n id) " | Current type: " (%type bound)))
+ (#R;Error (format "Cannot rebind type-var: " (%n id) " | Current type: " (%type bound)))
(#;Some #;None)
- (#;Right [(update@ #;var-bindings (var::put id (#;Some type)) context)
- []])
+ (#R;Success [(update@ #;var-bindings (var::put id (#;Some type)) context)
+ []])
#;None
- (#;Left (format "Unknown type-var: " (%n id))))))
+ (#R;Error (format "Unknown type-var: " (%n id))))))
(def: (rewrite-var id type)
(-> Nat Type (Check Unit))
(function [context]
(case (|> context (get@ #;var-bindings) (var::get id))
(#;Some _)
- (#;Right [(update@ #;var-bindings (var::put id (#;Some type)) context)
- []])
+ (#R;Success [(update@ #;var-bindings (var::put id (#;Some type)) context)
+ []])
#;None
- (#;Left (format "Unknown type-var: " (%n id))))))
+ (#R;Error (format "Unknown type-var: " (%n id))))))
(def: #export (clear-var id)
(-> Nat (Check Unit))
(function [context]
(case (|> context (get@ #;var-bindings) (var::get id))
(#;Some _)
- (#;Right [(update@ #;var-bindings (var::put id #;None) context)
- []])
+ (#R;Success [(update@ #;var-bindings (var::put id #;None) context)
+ []])
#;None
- (#;Left (format "Unknown type-var: " (%n id))))))
+ (#R;Error (format "Unknown type-var: " (%n id))))))
(def: #export (clean t-id type)
(-> Nat Type (Check Type))
@@ -274,22 +274,22 @@
(Check [Nat Type])
(function [context]
(let [id (get@ #;var-counter context)]
- (#;Right [(|> context
- (update@ #;var-counter n.inc)
- (update@ #;var-bindings (var::put id #;None)))
- [id (#;Var id)]]))))
+ (#R;Success [(|> context
+ (update@ #;var-counter n.inc)
+ (update@ #;var-bindings (var::put id #;None)))
+ [id (#;Var id)]]))))
(def: get-bindings
(Check (List [Nat (Maybe Type)]))
(function [context]
- (#;Right [context
- (get@ #;var-bindings context)])))
+ (#R;Success [context
+ (get@ #;var-bindings context)])))
(def: (set-bindings value)
(-> (List [Nat (Maybe Type)]) (Check Unit))
(function [context]
- (#;Right [(set@ #;var-bindings value context)
- []])))
+ (#R;Success [(set@ #;var-bindings value context)
+ []])))
(def: #export (delete-var id)
(-> Nat (Check Unit))
@@ -343,16 +343,16 @@
(All [a] (-> (Check a) (Check (Maybe a))))
(function [context]
(case (op context)
- (#;Right [context' output])
- (#;Right [context' (#;Some output)])
+ (#R;Success [context' output])
+ (#R;Success [context' (#;Some output)])
- (#;Left _)
- (#;Right [context #;None]))))
+ (#R;Error _)
+ (#R;Success [context #;None]))))
(def: #export (fail message)
(All [a] (-> Text (Check a)))
(function [context]
- (#;Left message)))
+ (#R;Error message)))
(def: (fail-check expected actual)
(All [a] (-> Type Type (Check a)))
@@ -363,10 +363,10 @@
(All [a] (-> (Check a) (Check a) (Check a)))
(function [context]
(case (left context)
- (#;Right [context' output])
- (#;Right [context' output])
+ (#R;Success [context' output])
+ (#R;Success [context' output])
- (#;Left _)
+ (#R;Error _)
(right context))))
(def: (fx-get [e a] fixed)
@@ -555,13 +555,13 @@
{#;doc "A simple type-checking function that just returns a yes/no answer."}
(-> Type Type Bool)
(case (run fresh-context (check expected actual))
- (#;Left error)
+ (#R;Error error)
false
- (#;Right _)
+ (#R;Success _)
true))
(def: #export get-context
(Check Type-Context)
(function [context]
- (#;Right [context context])))
+ (#R;Success [context context])))