diff options
Diffstat (limited to '')
29 files changed, 552 insertions, 552 deletions
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index ba0689e89..ef8b05e41 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -5,7 +5,7 @@ (data (coll [list "L/" Monoid<List> Monad<List>]) [text "T/" Monoid<Text>] text/format - ["R" result] + ["E" error] [sum]) [io] [macro #+ with-gensyms Functor<Lux> Monad<Lux>] @@ -19,18 +19,18 @@ ## [Combinators] (def: #export (run inputs parser) - (All [a] (-> (List Text) (CLI a) (R;Result a))) + (All [a] (-> (List Text) (CLI a) (E;Error a))) (case (p;run inputs parser) - (#R;Success [remaining output]) + (#E;Success [remaining output]) (case remaining #;Nil - (#R;Success output) + (#E;Success output) _ - (#R;Error (format "Remaining CLI inputs: " (text;join-with " " remaining)))) + (#E;Error (format "Remaining CLI inputs: " (text;join-with " " remaining)))) - (#R;Error error) - (#R;Error error))) + (#E;Error error) + (#E;Error error))) (def: #export any {#;doc "Just returns the next input without applying any logic."} @@ -38,26 +38,26 @@ (function [inputs] (case inputs (#;Cons arg inputs') - (#R;Success [inputs' arg]) + (#E;Success [inputs' arg]) _ - (#R;Error "Cannot parse empty arguments.")))) + (#E;Error "Cannot parse empty arguments.")))) (def: #export (parse parser) {#;doc "Parses the next input with a parsing function."} - (All [a] (-> (-> Text (R;Result a)) (CLI a))) + (All [a] (-> (-> Text (E;Error a)) (CLI a))) (function [inputs] (case inputs (#;Cons arg inputs') (case (parser arg) - (#R;Success value) - (#R;Success [inputs' value]) + (#E;Success value) + (#E;Success [inputs' value]) - (#R;Error parser-error) - (#R;Error parser-error)) + (#E;Error parser-error) + (#E;Error parser-error)) _ - (#R;Error "Cannot parse empty arguments.")))) + (#E;Error "Cannot parse empty arguments.")))) (def: #export (option names) {#;doc "Checks that a given option (with multiple possible names) has a value."} @@ -66,13 +66,13 @@ (let [[pre post] (list;split-with (. ;not (list;member? text;Eq<Text> names)) inputs)] (case post #;Nil - (#R;Error ($_ T/compose "Missing option (" (text;join-with " " names) ")")) + (#E;Error ($_ T/compose "Missing option (" (text;join-with " " names) ")")) (^ (list& _ value post')) - (#R;Success [(L/compose pre post') value]) + (#E;Success [(L/compose pre post') value]) _ - (#R;Error ($_ T/compose "Option lacks value (" (text;join-with " " names) ")")) + (#E;Error ($_ T/compose "Option lacks value (" (text;join-with " " names) ")")) )))) (def: #export (flag names) @@ -82,18 +82,18 @@ (let [[pre post] (list;split-with (. ;not (list;member? text;Eq<Text> names)) inputs)] (case post #;Nil - (#R;Success [pre false]) + (#E;Success [pre false]) (#;Cons _ post') - (#R;Success [(L/compose pre post') true]))))) + (#E;Success [(L/compose pre post') true]))))) (def: #export end {#;doc "Ensures there are no more inputs."} (CLI Unit) (function [inputs] (case inputs - #;Nil (#R;Success [inputs []]) - _ (#R;Error (T/compose "Unknown parameters: " (text;join-with " " inputs)))))) + #;Nil (#E;Success [inputs []]) + _ (#E;Error (T/compose "Unknown parameters: " (text;join-with " " inputs)))))) ## [Syntax] (type: Program-Args @@ -145,10 +145,10 @@ [] (~ body))))) (~ g!args)) - (#R;Success [(~ g!_) (~ g!output)]) + (#E;Success [(~ g!_) (~ g!output)]) (~ g!output) - (#R;Error (~ g!message)) + (#E;Error (~ g!message)) (error! (~ g!message)) ))) ))) diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux index 4be7ead9d..374acee46 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/concurrency/task.lux @@ -1,6 +1,6 @@ (;module: lux - (lux (data ["R" result]) + (lux (data ["E" error]) (control ["F" functor] ["A" applicative] monad @@ -11,11 +11,11 @@ )) (type: #export (Task a) - (P;Promise (R;Result a))) + (P;Promise (E;Error a))) (def: #export (fail error) (All [a] (-> Text (Task a))) - (:: P;Applicative<Promise> wrap (#R;Error error))) + (:: P;Applicative<Promise> wrap (#E;Error error))) (def: #export (throw exception message) (All [a] (-> Exception Text (Task a))) @@ -23,22 +23,22 @@ (def: #export (return value) (All [a] (-> a (Task a))) - (:: P;Applicative<Promise> wrap (#R;Success value))) + (:: P;Applicative<Promise> wrap (#E;Success value))) (def: #export (try computation) - (All [a] (-> (Task a) (Task (R;Result a)))) - (:: P;Functor<Promise> map (|>. #R;Success) computation)) + (All [a] (-> (Task a) (Task (E;Error a)))) + (:: P;Functor<Promise> map (|>. #E;Success) computation)) (struct: #export _ (F;Functor Task) (def: (map f fa) (:: P;Functor<Promise> map (function [fa'] (case fa' - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success a) - (#R;Success (f a)))) + (#E;Success a) + (#E;Success (f a)))) fa))) (struct: #export _ (A;Applicative Task) @@ -50,7 +50,7 @@ (do P;Monad<Promise> [ff' ff fa' fa] - (wrap (do R;Monad<Result> + (wrap (do E;Monad<Error> [f ff' a fa'] (wrap (f a))))))) @@ -62,10 +62,10 @@ (do P;Monad<Promise> [mma' mma] (case mma' - (#R;Error error) - (wrap (#R;Error error)) + (#E;Error error) + (wrap (#E;Error error)) - (#R;Success ma) + (#E;Success ma) ma)))) (syntax: #export (task [type s;any]) @@ -76,4 +76,4 @@ (def: #export (from-promise promise) (All [a] (-> (P;Promise a) (Task a))) - (:: P;Functor<Promise> map (|>. #R;Success) promise)) + (:: P;Functor<Promise> map (|>. #E;Success) promise)) diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux index e11f08016..55095ee3c 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 ["R" result]))) + (data ["E" error]))) ## [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 (R;Result a)) + (: (-> m (E;Error a)) decode)) ## [Values] @@ -22,7 +22,7 @@ (:: Codec<c,b> encode))) (def: (decode cy) - (do R;Monad<Result> + (do E;Monad<Error> [by (:: Codec<c,b> decode cy)] (:: Codec<b,a> decode by))) ) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index fda8103f2..b8be7b70d 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 Result type."} +(;module: {#;doc "Exception-handling functionality built on top of the Error type."} lux (lux (control monad) - (data ["R" result] + (data ["E" error] [maybe] [text "text/" Monoid<Text>]) [macro] @@ -30,41 +30,41 @@ 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) (R;Result a) - (R;Result a))) + (-> Exception (-> Text a) (E;Error a) + (E;Error a))) (case try - (#R;Success output) - (#R;Success output) + (#E;Success output) + (#E;Success output) - (#R;Error error) + (#E;Error error) (let [reference (exception "")] (if (text;starts-with? reference error) - (#R;Success (|> error + (#E;Success (|> error (text;clip (text;size reference) (text;size error)) maybe;assume then)) - (#R;Error error))))) + (#E;Error error))))) (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) (R;Result a) a)) + (-> (-> Text a) (E;Error a) a)) (case try - (#R;Success output) + (#E;Success output) output - (#R;Error error) + (#E;Error error) (to-do error))) (def: #export (return value) - {#;doc "A way to lift normal values into the result-handling context."} - (All [a] (-> a (R;Result a))) - (#R;Success value)) + {#;doc "A way to lift normal values into the error-handling context."} + (All [a] (-> a (E;Error a))) + (#E;Success value)) (def: #export (throw exception message) - {#;doc "Decorate an error message with an Exception and lift it into the result-handling context."} - (All [a] (-> Exception Text (R;Result a))) - (#R;Error (exception message))) + {#;doc "Decorate an error message with an Exception and lift it into the error-handling context."} + (All [a] (-> Exception Text (E;Error a))) + (#E;Error (exception message))) (syntax: #export (exception: [_ex-lev csr;export] [name s;local-symbol]) {#;doc (doc "Define a new exception type." diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index 606d8d448..166826519 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -6,43 +6,43 @@ [codec]) (data (coll [list "list/" Functor<List> Monoid<List>]) [product] - ["R" result]))) + ["E" error]))) (type: #export (Parser s a) {#;doc "A generic parser."} - (-> s (R;Result [s a]))) + (-> s (E;Error [s a]))) ## [Structures] (struct: #export Functor<Parser> (All [s] (Functor (Parser s))) (def: (map f ma) (function [input] (case (ma input) - (#R;Error msg) - (#R;Error msg) + (#E;Error msg) + (#E;Error msg) - (#R;Success [input' a]) - (#R;Success [input' (f a)]))))) + (#E;Success [input' a]) + (#E;Success [input' (f a)]))))) (struct: #export Applicative<Parser> (All [s] (Applicative (Parser s))) (def: functor Functor<Parser>) (def: (wrap x) (function [input] - (#R;Success [input x]))) + (#E;Success [input x]))) (def: (apply ff fa) (function [input] (case (ff input) - (#R;Success [input' f]) + (#E;Success [input' f]) (case (fa input') - (#R;Success [input'' a]) - (#R;Success [input'' (f a)]) + (#E;Success [input'' a]) + (#E;Success [input'' (f a)]) - (#R;Error msg) - (#R;Error msg)) + (#E;Error msg) + (#E;Error msg)) - (#R;Error msg) - (#R;Error msg))))) + (#E;Error msg) + (#E;Error msg))))) (struct: #export Monad<Parser> (All [s] (Monad (Parser s))) (def: applicative Applicative<Parser>) @@ -50,10 +50,10 @@ (def: (join mma) (function [input] (case (mma input) - (#R;Error msg) - (#R;Error msg) + (#E;Error msg) + (#E;Error msg) - (#R;Success [input' ma]) + (#E;Success [input' ma]) (ma input'))))) ## [Parsers] @@ -62,8 +62,8 @@ (All [s] (-> Text Bool (Parser s Unit))) (function [input] (if test - (#R;Success [input []]) - (#R;Error message)))) + (#E;Success [input []]) + (#E;Error message)))) (def: #export (maybe p) {#;doc "Optionality combinator."} @@ -71,12 +71,12 @@ (-> (Parser s a) (Parser s (Maybe a)))) (function [input] (case (p input) - (#R;Error _) (#R;Success [input #;None]) - (#R;Success [input' x]) (#R;Success [input' (#;Some x)])))) + (#E;Error _) (#E;Success [input #;None]) + (#E;Success [input' x]) (#E;Success [input' (#;Some x)])))) (def: #export (run input p) (All [s a] - (-> s (Parser s a) (R;Result [s a]))) + (-> s (Parser s a) (E;Error [s a]))) (p input)) (def: #export (some p) @@ -85,8 +85,8 @@ (-> (Parser s a) (Parser s (List a)))) (function [input] (case (p input) - (#R;Error _) (#R;Success [input (list)]) - (#R;Success [input' x]) (run input' + (#E;Error _) (#E;Success [input (list)]) + (#E;Success [input' x]) (run input' (do Monad<Parser> [xs (some p)] (wrap (list& x xs))) @@ -116,8 +116,8 @@ (-> (Parser s a) (Parser s b) (Parser s (| a b)))) (function [tokens] (case (p1 tokens) - (#R;Success [tokens' x1]) (#R;Success [tokens' (+0 x1)]) - (#R;Error _) (run tokens + (#E;Success [tokens' x1]) (#E;Success [tokens' (+0 x1)]) + (#E;Error _) (run tokens (do Monad<Parser> [x2 p2] (wrap (+1 x2)))) @@ -129,7 +129,7 @@ (-> (Parser s a) (Parser s a) (Parser s a))) (function [tokens] (case (pl tokens) - (#R;Error _) (pr tokens) + (#E;Error _) (pr tokens) output output ))) @@ -157,10 +157,10 @@ (if (n.> +0 n) (function [input] (case (p input) - (#R;Error msg) - (#R;Success [input (list)]) + (#E;Error msg) + (#E;Success [input (list)]) - (#R;Success [input' x]) + (#E;Success [input' x]) (run input' (do Monad<Parser> [xs (at-most (n.dec n) p)] @@ -195,32 +195,32 @@ (All [s a] (-> (Parser s a) (Parser s Unit))) (function [input] (case (p input) - (#R;Error msg) - (#R;Success [input []]) + (#E;Error msg) + (#E;Success [input []]) _ - (#R;Error "Expected to fail; yet succeeded.")))) + (#E;Error "Expected to fail; yet succeeded.")))) (def: #export (fail message) (All [s a] (-> Text (Parser s a))) (function [input] - (#R;Error message))) + (#E;Error message))) (def: #export (default value parser) {#;doc "If the given parser fails, returns the default value."} (All [s a] (-> a (Parser s a) (Parser s a))) (function [input] (case (parser input) - (#R;Error error) - (#R;Success [input value]) + (#E;Error error) + (#E;Success [input value]) - (#R;Success [input' output]) - (#R;Success [input' output])))) + (#E;Success [input' output]) + (#E;Success [input' output])))) (def: #export remaining (All [s] (Parser s s)) (function [inputs] - (#R;Success [inputs inputs]))) + (#E;Success [inputs inputs]))) (def: #export (rec parser) {#;doc "Combinator for recursive parser."} @@ -252,13 +252,13 @@ (All [s a z] (-> (codec;Codec a z) (Parser s a) (Parser s z))) (function [input] (case (parser input) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success [input' to-decode]) + (#E;Success [input' to-decode]) (case (:: Codec<a,z> decode to-decode) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success value) - (#R;Success [input' value]))))) + (#E;Success value) + (#E;Success [input' value]))))) diff --git a/stdlib/source/lux/data/coll/tree/parser.lux b/stdlib/source/lux/data/coll/tree/parser.lux index 203f55b16..3b2400b92 100644 --- a/stdlib/source/lux/data/coll/tree/parser.lux +++ b/stdlib/source/lux/data/coll/tree/parser.lux @@ -2,7 +2,7 @@ lux (lux (control ["p" parser] ["ex" exception #+ exception:]) - (data ["R" result])) + (data ["E" error])) (.. ["T" rose] ["Z" zipper])) @@ -10,22 +10,22 @@ (p;Parser (Z;Zipper t) a)) (def: #export (run-zipper zipper parser) - (All [t a] (-> (Z;Zipper t) (Parser t a) (R;Result a))) + (All [t a] (-> (Z;Zipper t) (Parser t a) (E;Error a))) (case (p;run zipper parser) - (#R;Success [zipper output]) - (#R;Success output) + (#E;Success [zipper output]) + (#E;Success output) - (#R;Error error) - (#R;Error error))) + (#E;Error error) + (#E;Error error))) (def: #export (run tree parser) - (All [t a] (-> (T;Tree t) (Parser t a) (R;Result a))) + (All [t a] (-> (T;Tree t) (Parser t a) (E;Error a))) (run-zipper (Z;zip tree) parser)) (def: #export value (All [t] (Parser t t)) (function [zipper] - (#R;Success [zipper (Z;value zipper)]))) + (#E;Success [zipper (Z;value zipper)]))) (exception: #export Cannot-Move-Further) @@ -36,7 +36,7 @@ (let [next (<direction> zipper)] (if (is zipper next) (ex;throw Cannot-Move-Further "") - (#R;Success [next []])))))] + (#E;Success [next []])))))] [up Z;up] [down Z;down] diff --git a/stdlib/source/lux/data/result.lux b/stdlib/source/lux/data/error.lux index df52522af..e433d7454 100644 --- a/stdlib/source/lux/data/result.lux +++ b/stdlib/source/lux/data/error.lux @@ -5,19 +5,19 @@ ["M" monad #+ do Monad]))) ## [Types] -(type: #export (Result a) +(type: #export (Error a) (#Error Text) (#Success a)) ## [Structures] -(struct: #export _ (F;Functor Result) +(struct: #export _ (F;Functor Error) (def: (map f ma) (case ma (#Error msg) (#Error msg) (#Success datum) (#Success (f datum))))) -(struct: #export _ (A;Applicative Result) - (def: functor Functor<Result>) +(struct: #export _ (A;Applicative Error) + (def: functor Functor<Error>) (def: (wrap a) (#Success a)) @@ -36,17 +36,17 @@ (#Error msg)) )) -(struct: #export _ (Monad Result) - (def: applicative Applicative<Result>) +(struct: #export _ (Monad Error) + (def: applicative Applicative<Error>) (def: (join mma) (case mma (#Error msg) (#Error msg) (#Success ma) ma))) -(struct: #export (ResultT Monad<M>) - (All [M] (-> (Monad M) (Monad (All [a] (M (Result a)))))) - (def: applicative (A;compose (get@ #M;applicative Monad<M>) Applicative<Result>)) +(struct: #export (ErrorT Monad<M>) + (All [M] (-> (Monad M) (Monad (All [a] (M (Error a)))))) + (def: applicative (A;compose (get@ #M;applicative Monad<M>) Applicative<Error>)) (def: (join MeMea) (do Monad<M> [eMea MeMea] @@ -58,20 +58,20 @@ Mea)))) (def: #export (lift Monad<M>) - (All [M a] (-> (Monad M) (-> (M a) (M (Result a))))) - (M;lift Monad<M> (:: Monad<Result> wrap))) + (All [M a] (-> (Monad M) (-> (M a) (M (Error a))))) + (M;lift Monad<M> (:: Monad<Error> wrap))) (def: #export (succeed value) - (All [a] (-> a (Result a))) + (All [a] (-> a (Error a))) (#Success value)) (def: #export (fail message) - (All [a] (-> Text (Result a))) + (All [a] (-> Text (Error a))) (#Error message)) -(def: #export (assume result) - (All [a] (-> (Result a) a)) - (case result +(def: #export (assume error) + (All [a] (-> (Error a) a)) + (case error (#Success value) value @@ -80,14 +80,14 @@ (macro: #export (default tokens compiler) {#;doc (doc "Allows you to provide a default value that will be used" - "if a (Result x) value turns out to be #Error." + "if a (Error x) value turns out to be #Error." (is 10 (default 20 (#Success 10))) (is 20 (default 20 (#Error "KABOOM!"))))} (case tokens - (^ (list else result)) - (#Success [compiler (list (` (case (~ result) + (^ (list else error)) + (#Success [compiler (list (` (case (~ error) (#;;Success (~' g!temp)) (~' g!temp) diff --git a/stdlib/source/lux/data/format/context.lux b/stdlib/source/lux/data/format/context.lux index a515052c6..5f0d29b11 100644 --- a/stdlib/source/lux/data/format/context.lux +++ b/stdlib/source/lux/data/format/context.lux @@ -3,7 +3,7 @@ (lux (control ["p" parser] ["ex" exception #+ exception:] [monad #+ do]) - (data ["R" result] + (data ["E" error] (coll ["d" dict])))) (exception: #export Unknown-Property) @@ -25,10 +25,10 @@ (ex;throw Unknown-Property name)))) (def: #export (run context property) - (All [a] (-> Context (Property a) (R;Result a))) + (All [a] (-> Context (Property a) (E;Error a))) (case (property context) - (#R;Success [_ output]) - (#R;Success output) + (#E;Success [_ output]) + (#E;Success output) - (#R;Error error) - (#R;Error error))) + (#E;Error error) + (#E;Error error))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 867cec189..7eac167e1 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -11,7 +11,7 @@ (text ["l" lexer]) [number "frac/" Codec<Text,Frac> "nat/" Codec<Text,Nat>] [maybe] - ["R" result] + ["E" error] [sum] [product] (coll [list "list/" Fold<List> Monad<List>] @@ -96,52 +96,52 @@ (def: #export (get-fields json) {#;doc "Get all the fields in a JSON object."} - (-> JSON (R;Result (List String))) + (-> JSON (E;Error (List String))) (case json (#Object obj) - (#R;Success (dict;keys obj)) + (#E;Success (dict;keys obj)) _ - (#R;Error ($_ text/compose "Cannot get the fields of a non-object.")))) + (#E;Error ($_ text/compose "Cannot get the fields of a non-object.")))) (def: #export (get key json) {#;doc "A JSON object field getter."} - (-> String JSON (R;Result JSON)) + (-> String JSON (E;Error JSON)) (case json (#Object obj) (case (dict;get key obj) (#;Some value) - (#R;Success value) + (#E;Success value) #;None - (#R;Error ($_ text/compose "Missing field \"" key "\" on object."))) + (#E;Error ($_ text/compose "Missing field \"" key "\" on object."))) _ - (#R;Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) + (#E;Error ($_ text/compose "Cannot get field \"" key "\" of a non-object.")))) (def: #export (set key value json) {#;doc "A JSON object field setter."} - (-> String JSON JSON (R;Result JSON)) + (-> String JSON JSON (E;Error JSON)) (case json (#Object obj) - (#R;Success (#Object (dict;put key value obj))) + (#E;Success (#Object (dict;put key value obj))) _ - (#R;Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) + (#E;Error ($_ text/compose "Cannot set field \"" key "\" of a non-object.")))) (do-template [<name> <tag> <type> <desc>] [(def: #export (<name> key json) {#;doc (code;text ($_ text/compose "A JSON object field getter for " <desc> "."))} - (-> Text JSON (R;Result <type>)) + (-> Text JSON (E;Error <type>)) (case (get key json) - (#R;Success (<tag> value)) - (#R;Success value) + (#E;Success (<tag> value)) + (#E;Success value) - (#R;Success _) - (#R;Error ($_ text/compose "Wrong value type at key: " key)) + (#E;Success _) + (#E;Error ($_ text/compose "Wrong value type at key: " key)) - (#R;Error error) - (#R;Error error)))] + (#E;Error error) + (#E;Error error)))] [get-boolean #Boolean Boolean "booleans"] [get-number #Number Number "numbers"] @@ -195,23 +195,23 @@ (def: unconsumed-input-error Text "Unconsumed JSON.") (def: #export (run json parser) - (All [a] (-> JSON (Reader a) (R;Result a))) + (All [a] (-> JSON (Reader a) (E;Error a))) (case (p;run (list json) parser) - (#R;Success [remainder output]) + (#E;Success [remainder output]) (case remainder #;Nil - (#R;Success output) + (#E;Success output) _ - (#R;Error unconsumed-input-error)) + (#E;Error unconsumed-input-error)) - (#R;Error error) - (#R;Error error))) + (#E;Error error) + (#E;Error error))) (def: #export (fail error) (All [a] (-> Text (Reader a))) (function [inputs] - (#R;Error error))) + (#E;Error error))) (def: #export any {#;doc "Just returns the JSON input without applying any logic."} @@ -219,10 +219,10 @@ (<| (function [inputs]) (case inputs #;Nil - (#R;Error "Empty JSON stream.") + (#E;Error "Empty JSON stream.") (#;Cons head tail) - (#R;Success [tail head])))) + (#E;Success [tail head])))) (do-template [<name> <type> <tag> <desc>] [(def: #export <name> @@ -289,10 +289,10 @@ (case head (#Array values) (case (p;run (vector;to-list values) parser) - (#R;Error error) + (#E;Error error) (fail error) - (#R;Success [remainder output]) + (#E;Success [remainder output]) (case remainder #;Nil (wrap output) @@ -310,7 +310,7 @@ [head any] (case head (#Object object) - (case (do R;Monad<Result> + (case (do E;Monad<Error> [] (|> (dict;entries object) (monad;map @ (function [[key val]] @@ -318,10 +318,10 @@ [val (run val parser)] (wrap [key val])))) (:: @ map (dict;from-list text;Hash<Text>)))) - (#R;Success table) + (#E;Success table) (wrap table) - (#R;Error error) + (#E;Error error) (fail error)) _ @@ -337,13 +337,13 @@ (case (dict;get field-name object) (#;Some value) (case (run value parser) - (#R;Success output) + (#E;Success output) (function [tail] - (#R;Success [(#;Cons (#Object (dict;remove field-name object)) + (#E;Success [(#;Cons (#Object (dict;remove field-name object)) tail) output])) - (#R;Error error) + (#E;Error error) (fail error)) _ @@ -438,10 +438,10 @@ offset (l;many l;decimal)] (wrap ($_ text/compose mark (if signed?' "-" "") offset))))] (case (frac/decode ($_ text/compose (if signed? "-" "") digits "." decimals exp)) - (#R;Error message) + (#E;Error message) (p;fail message) - (#R;Success value) + (#E;Success value) (wrap value)))) (def: escaped~ diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 2be7afdd3..f2d1eb056 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -8,7 +8,7 @@ (data [text "text/" Eq<Text> Monoid<Text>] (text ["l" lexer]) [number] - ["R" result] + ["E" error] [product] [maybe "m/" Monad<Maybe>] [ident "ident/" Eq<Ident> Codec<Text,Ident>] @@ -170,7 +170,7 @@ (p;after (p;maybe xml-header^)))) (def: #export (read input) - (-> Text (R;Result XML)) + (-> Text (E;Error XML)) (l;run input xml^)) (def: (sanitize-value input) @@ -262,7 +262,7 @@ (#;Cons head tail) (case head (#Text value) - (#R;Success [tail value]) + (#E;Success [tail value]) (#Node _) (ex;throw Unexpected-Input ""))))) @@ -285,20 +285,20 @@ (ex;throw Unknown-Attribute "") (#;Some value) - (#R;Success [docs value])))))) + (#E;Success [docs value])))))) (def: (run' docs reader) - (All [a] (-> (List XML) (Reader a) (R;Result a))) + (All [a] (-> (List XML) (Reader a) (E;Error a))) (case (p;run docs reader) - (#R;Success [remaining output]) + (#E;Success [remaining output]) (if (list;empty? remaining) - (#R;Success output) + (#E;Success output) (ex;throw Unconsumed-Inputs (|> remaining (L/map (:: Codec<Text,XML> encode)) (text;join-with "\n\n")))) - (#R;Error error) - (#R;Error error))) + (#E;Error error) + (#E;Error error))) (def: #export (node tag) (-> Ident (Reader Unit)) @@ -314,7 +314,7 @@ (#Node _tag _attrs _children) (if (ident/= tag _tag) - (#R;Success [docs []]) + (#E;Success [docs []]) (ex;throw Wrong-Tag (ident/encode tag))))))) (def: #export (children reader) @@ -330,7 +330,7 @@ (ex;throw Unexpected-Input "") (#Node _tag _attrs _children) - (do R;Monad<Result> + (do E;Monad<Error> [output (run' _children reader)] (wrap [tail output])))))) @@ -342,8 +342,8 @@ (ex;throw Empty-Input "") (#;Cons head tail) - (#R;Success [tail []])))) + (#E;Success [tail []])))) (def: #export (run document reader) - (All [a] (-> XML (Reader a) (R;Result a))) + (All [a] (-> XML (Reader a) (E;Error a))) (run' (list document) reader)) diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux index 4f0c2b9d9..729c83979 100644 --- a/stdlib/source/lux/data/number.lux +++ b/stdlib/source/lux/data/number.lux @@ -8,7 +8,7 @@ enum interval codec) - (data ["R" result] + (data ["E" error] [maybe] [bit]))) @@ -163,10 +163,10 @@ (def: (decode input) (case (_lux_proc <decoder> [input]) (#;Some value) - (#R;Success value) + (#E;Success value) #;None - (#R;Error <error>))))] + (#E;Error <error>))))] [Frac ["frac" "encode"] ["frac" "decode"] "Could not decode Frac"] ) @@ -200,16 +200,16 @@ (let [digit (maybe;assume (get-char input idx))] (case (_lux_proc ["text" "index"] [<char-set> digit +0]) #;None - (#R;Error (_lux_proc ["text" "append"] [<error> repr])) + (#E;Error (_lux_proc ["text" "append"] [<error> repr])) (#;Some index) (recur (n.inc idx) (|> output (n.* <base>) (n.+ index))))) - (#R;Success output)))) + (#E;Success output)))) _ - (#R;Error (_lux_proc ["text" "append"] [<error> repr]))) - (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))))] + (#E;Error (_lux_proc ["text" "append"] [<error> repr]))) + (#E;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: "] @@ -251,13 +251,13 @@ (let [digit (maybe;assume (get-char input idx))] (case (_lux_proc ["text" "index"] [<char-set> digit +0]) #;None - (#R;Error <error>) + (#E;Error <error>) (#;Some index) (recur (n.inc idx) (|> output (i.* <base>) (i.+ (:! Int index)))))) - (#R;Success (i.* sign output))))) - (#R;Error <error>)))))] + (#E;Success (i.* sign output))))) + (#E;Error <error>)))))] [Binary@Codec<Text,Int> 2 "01" "Invalid binary syntax for Int: "] [Octal@Codec<Text,Int> 8 "01234567" "Invalid octal syntax for Int: "] @@ -291,11 +291,11 @@ (^multi (^ (#;Some (char "."))) [(:: <nat> decode (_lux_proc ["text" "append"] ["+" (de-prefix repr)])) (#;Some output)]) - (#R;Success (:! Deg output)) + (#E;Success (:! Deg output)) _ - (#R;Error (_lux_proc ["text" "append"] [<error> repr]))) - (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))))] + (#E;Error (_lux_proc ["text" "append"] [<error> repr]))) + (#E;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: "] @@ -341,19 +341,19 @@ (f.* <base> output)))) adjusted-decimal (|> decimal int-to-frac (f./ div-power)) dec-deg (case (:: Hex@Codec<Text,Deg> decode (_lux_proc ["text" "append"] ["." decimal-part])) - (#R;Success dec-deg) + (#E;Success dec-deg) dec-deg - (#R;Error error) + (#E;Error error) (error! error))] - (#R;Success (f.+ (int-to-frac whole) + (#E;Success (f.+ (int-to-frac whole) (f.* sign adjusted-decimal)))) _ - (#R;Error (_lux_proc ["text" "append"] [<error> repr])))) + (#E;Error (_lux_proc ["text" "append"] [<error> repr])))) _ - (#R;Error (_lux_proc ["text" "append"] [<error> repr])))))] + (#E;Error (_lux_proc ["text" "append"] [<error> repr])))))] [Binary@Codec<Text,Frac> Binary@Codec<Text,Int> 2.0 "01" "Invalid binary syntax: "] ) @@ -531,14 +531,14 @@ [(if (f.= -1.0 sign) "-" "")] (_lux_proc ["text" "append"]))] (case (:: Binary@Codec<Text,Frac> decode as-binary) - (#R;Error _) - (#R;Error (_lux_proc ["text" "append"] [<error> repr])) + (#E;Error _) + (#E;Error (_lux_proc ["text" "append"] [<error> repr])) output output)) _ - (#R;Error (_lux_proc ["text" "append"] [<error> repr]))))))] + (#E;Error (_lux_proc ["text" "append"] [<error> repr]))))))] [Octal@Codec<Text,Frac> "Invalid octaladecimal syntax: " binary-to-octal octal-to-binary] [Hex@Codec<Text,Frac> "Invalid hexadecimal syntax: " binary-to-hex hex-to-binary] @@ -550,26 +550,26 @@ (case tokens (#;Cons [meta (#;Text repr)] #;Nil) (case (:: <nat> decode repr) - (#R;Success value) - (#R;Success [state (list [meta (#;Nat value)])]) + (#E;Success value) + (#E;Success [state (list [meta (#;Nat value)])]) - (^multi (#R;Error _) - [(:: <int> decode repr) (#R;Success value)]) - (#R;Success [state (list [meta (#;Int value)])]) + (^multi (#E;Error _) + [(:: <int> decode repr) (#E;Success value)]) + (#E;Success [state (list [meta (#;Int value)])]) - (^multi (#R;Error _) - [(:: <deg> decode repr) (#R;Success value)]) - (#R;Success [state (list [meta (#;Deg value)])]) + (^multi (#E;Error _) + [(:: <deg> decode repr) (#E;Success value)]) + (#E;Success [state (list [meta (#;Deg value)])]) - (^multi (#R;Error _) - [(:: <frac> decode repr) (#R;Success value)]) - (#R;Success [state (list [meta (#;Frac value)])]) + (^multi (#E;Error _) + [(:: <frac> decode repr) (#E;Success value)]) + (#E;Success [state (list [meta (#;Frac value)])]) _ - (#R;Error <error>)) + (#E;Error <error>)) _ - (#R;Error <error>)))] + (#E;Error <error>)))] [bin Binary@Codec<Text,Nat> Binary@Codec<Text,Int> Binary@Codec<Text,Deg> Binary@Codec<Text,Frac> "Invalid binary syntax." @@ -764,11 +764,11 @@ (recur (digits-sub! power digits) (n.inc idx) (bit;set (n.- idx (n.dec bit;width)) output)))) - (#R;Success (:! Deg output)))) + (#E;Success (:! Deg output)))) #;None - (#R;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input]))) - (#R;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input])))) + (#E;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input]))) + (#E;Error (_lux_proc ["text" "append"] ["Wrong syntax for Deg: " input])))) )) (def: (log2 input) diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux index d2933a1ab..e1fbccb36 100644 --- a/stdlib/source/lux/data/number/complex.lux +++ b/stdlib/source/lux/data/number/complex.lux @@ -9,7 +9,7 @@ (data [number "f/" Number<Frac> Codec<Text,Frac>] [text "text/" Monoid<Text>] text/format - ["R" result] + ["E" error] [maybe] (coll [list "L/" Monad<List>])) [macro] @@ -323,7 +323,7 @@ (#;Left (text/compose "Wrong syntax for complex numbers: " input)) (#;Some [r' i']) - (do R;Monad<Result> + (do E;Monad<Error> [r (f/decode (text;trim r')) i (f/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 391242a32..8db271d7d 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -10,7 +10,7 @@ (data [number "n/" Number<Nat> Codec<Text,Nat>] [text "Text/" Monoid<Text>] text/format - ["R" result] + ["E" error] [product] [maybe]) [macro] @@ -131,7 +131,7 @@ (|>. n/encode (text;split +1) maybe;assume product;right)) (def: part-decode - (-> Text (R;Result Nat)) + (-> Text (E;Error Nat)) (|>. (format "+") n/decode)) (struct: #export _ (Codec Text Ratio) @@ -141,7 +141,7 @@ (def: (decode input) (case (text;split-with separator input) (#;Some [num denom]) - (do R;Monad<Result> + (do E;Monad<Error> [numerator (part-decode num) denominator (part-decode denom)] (wrap (normalize {#numerator numerator diff --git a/stdlib/source/lux/data/text/lexer.lux b/stdlib/source/lux/data/text/lexer.lux index 1f76e833a..3803414e4 100644 --- a/stdlib/source/lux/data/text/lexer.lux +++ b/stdlib/source/lux/data/text/lexer.lux @@ -5,7 +5,7 @@ (data [text "text/" Monoid<Text>] [product] [maybe] - ["R" result] + ["E" error] (coll [list])) (macro [code]))) @@ -27,15 +27,15 @@ ($_ text/compose "Unconsumed input: " (remaining offset tape))) (def: #export (run input lexer) - (All [a] (-> Text (Lexer a) (R;Result a))) + (All [a] (-> Text (Lexer a) (E;Error a))) (case (lexer [start-offset input]) - (#R;Error msg) - (#R;Error msg) + (#E;Error msg) + (#E;Error msg) - (#R;Success [[end-offset _] output]) + (#E;Success [[end-offset _] output]) (if (n.= end-offset (text;size input)) - (#R;Success output) - (#R;Error (unconsumed-input-error end-offset input))) + (#E;Success output) + (#E;Error (unconsumed-input-error end-offset input))) )) (def: #export any @@ -44,10 +44,10 @@ (function [[offset tape]] (case (text;nth offset tape) (#;Some output) - (#R;Success [[(n.inc offset) tape] (text;from-code output)]) + (#E;Success [[(n.inc offset) tape] (text;from-code output)]) _ - (#R;Error cannot-lex-error)) + (#E;Error cannot-lex-error)) )) (def: #export (not p) @@ -55,11 +55,11 @@ (All [a] (-> (Lexer a) (Lexer Text))) (function [input] (case (p input) - (#R;Error msg) + (#E;Error msg) (any input) _ - (#R;Error "Expected to fail; yet succeeded.")))) + (#E;Error "Expected to fail; yet succeeded.")))) (def: #export (this reference) {#;doc "Lex a text if it matches the given sample."} @@ -67,10 +67,10 @@ (function [[offset tape]] (case (text;index-of reference offset tape) (^multi (#;Some where) (n.= offset where)) - (#R;Success [[(n.+ (text;size reference) offset) tape] []]) + (#E;Success [[(n.+ (text;size reference) offset) tape] []]) _ - (#R;Error ($_ text/compose "Could not match: " (text;encode reference) " @ " tape))))) + (#E;Error ($_ text/compose "Could not match: " (text;encode reference) " @ " tape))))) (def: #export (this? reference) {#;doc "Lex a text if it matches the given sample."} @@ -78,24 +78,24 @@ (function [(^@ input [offset tape])] (case (text;index-of reference offset tape) (^multi (#;Some where) (n.= offset where)) - (#R;Success [[(n.+ (text;size reference) offset) tape] true]) + (#E;Success [[(n.+ (text;size reference) offset) tape] true]) _ - (#R;Success [input false])))) + (#E;Success [input false])))) (def: #export end {#;doc "Ensure the lexer's input is empty."} (Lexer Unit) (function [(^@ input [offset tape])] (if (n.= offset (text;size tape)) - (#R;Success [input []]) - (#R;Error (unconsumed-input-error offset tape))))) + (#E;Success [input []]) + (#E;Error (unconsumed-input-error offset tape))))) (def: #export end? {#;doc "Ask if the lexer's input is empty."} (Lexer Bool) (function [(^@ input [offset tape])] - (#R;Success [input (n.= offset (text;size tape))]))) + (#E;Success [input (n.= offset (text;size tape))]))) (def: #export peek {#;doc "Lex the next character (without consuming it from the input)."} @@ -103,17 +103,17 @@ (function [(^@ input [offset tape])] (case (text;nth offset tape) (#;Some output) - (#R;Success [input (text;from-code output)]) + (#E;Success [input (text;from-code output)]) _ - (#R;Error cannot-lex-error)) + (#E;Error cannot-lex-error)) )) (def: #export get-input {#;doc "Get all of the remaining input (without consuming it)."} (Lexer Text) (function [(^@ input [offset tape])] - (#R;Success [input (remaining offset tape)]))) + (#E;Success [input (remaining offset tape)]))) (def: #export (range bottom top) {#;doc "Only lex characters within a range."} @@ -164,11 +164,11 @@ (#;Some output) (let [output (text;from-code output)] (if (text;contains? output options) - (#R;Success [[(n.inc offset) tape] output]) - (#R;Error ($_ text/compose "Character (" output ") is not one of: " options)))) + (#E;Success [[(n.inc offset) tape] output]) + (#E;Error ($_ text/compose "Character (" output ") is not one of: " options)))) _ - (#R;Error cannot-lex-error)))) + (#E;Error cannot-lex-error)))) (def: #export (none-of options) {#;doc "Only lex characters that are not part of a piece of text."} @@ -178,11 +178,11 @@ (#;Some output) (let [output (text;from-code output)] (if (;not (text;contains? output options)) - (#R;Success [[(n.inc offset) tape] output]) - (#R;Error ($_ text/compose "Character (" output ") is one of: " options)))) + (#E;Success [[(n.inc offset) tape] output]) + (#E;Error ($_ text/compose "Character (" output ") is one of: " options)))) _ - (#R;Error cannot-lex-error)))) + (#E;Error cannot-lex-error)))) (def: #export (satisfies p) {#;doc "Only lex characters that satisfy a predicate."} @@ -191,11 +191,11 @@ (case (text;nth offset tape) (#;Some output) (if (p output) - (#R;Success [[(n.inc offset) tape] (text;from-code output)]) - (#R;Error ($_ text/compose "Character does not satisfy predicate: " (text;from-code output)))) + (#E;Success [[(n.inc offset) tape] (text;from-code output)]) + (#E;Error ($_ text/compose "Character does not satisfy predicate: " (text;from-code output)))) _ - (#R;Error cannot-lex-error)))) + (#E;Error cannot-lex-error)))) (def: #export space {#;doc "Only lex white-space."} @@ -248,8 +248,8 @@ (All [a] (-> Text (Lexer a) (Lexer a))) (function [real-input] (case (run local-input lexer) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success value) - (#R;Success [real-input value])))) + (#E;Success value) + (#E;Success [real-input value])))) diff --git a/stdlib/source/lux/data/text/regex.lux b/stdlib/source/lux/data/text/regex.lux index 11139cd6a..a425224cb 100644 --- a/stdlib/source/lux/data/text/regex.lux +++ b/stdlib/source/lux/data/text/regex.lux @@ -7,7 +7,7 @@ text/format [number "Int/" Codec<Text,Int>] [product] - ["R" result] + ["E" error] [maybe] (coll [list "L/" Fold<List> Monad<List>])) [macro #- run] @@ -276,14 +276,14 @@ [Int (List Code) (List (List Code))]) (function [part [idx names steps]] (case part - (^or (#R;Error complex) (#R;Success [#Non-Capturing complex])) + (^or (#E;Error complex) (#E;Success [#Non-Capturing complex])) [idx names (list& (list g!temp complex (' #let) (` [(~ g!total) (_Text/compose_ (~ g!total) (~ g!temp))])) steps)] - (#R;Success [(#Capturing [?name num-captures]) scoped]) + (#E;Success [(#Capturing [?name num-captures]) scoped]) (let [[idx! name!] (case ?name (#;Some _name) [idx (code;symbol ["" _name])] @@ -320,31 +320,31 @@ (All [l r] (-> (l;Lexer [Text l]) (l;Lexer [Text r]) (l;Lexer [Text (| l r)]))) (function [input] (case (left input) - (#R;Success [input' [lt lv]]) - (#R;Success [input' [lt (+0 lv)]]) + (#E;Success [input' [lt lv]]) + (#E;Success [input' [lt (+0 lv)]]) - (#R;Error _) + (#E;Error _) (case (right input) - (#R;Success [input' [rt rv]]) - (#R;Success [input' [rt (+1 rv)]]) + (#E;Success [input' [rt rv]]) + (#E;Success [input' [rt (+1 rv)]]) - (#R;Error error) - (#R;Error error))))) + (#E;Error error) + (#E;Error error))))) (def: #hidden (|||_^ left right) (All [l r] (-> (l;Lexer [Text l]) (l;Lexer [Text r]) (l;Lexer Text))) (function [input] (case (left input) - (#R;Success [input' [lt lv]]) - (#R;Success [input' lt]) + (#E;Success [input' [lt lv]]) + (#E;Success [input' lt]) - (#R;Error _) + (#E;Error _) (case (right input) - (#R;Success [input' [rt rv]]) - (#R;Success [input' rt]) + (#E;Success [input' [rt rv]]) + (#E;Success [input' rt]) - (#R;Error error) - (#R;Error error))))) + (#E;Error error) + (#E;Error error))))) (def: (prep-alternative [num-captures alt]) (-> [Nat Code] Code) @@ -462,11 +462,11 @@ (case (|> (regex^ current-module) (p;before l;end) (l;run pattern)) - (#R;Error error) + (#E;Error error) (macro;fail (format "Error while parsing regular-expression:\n" error)) - (#R;Success regex) + (#E;Success regex) (wrap (list regex)) ))) @@ -488,7 +488,7 @@ [g!temp (macro;gensym "temp")] (wrap (list& (` (^multi (~ g!temp) [(l;run (~ g!temp) (regex (~ (code;text pattern)))) - (#R;Success (~ (maybe;default g!temp + (#E;Success (~ (maybe;default g!temp bindings)))])) body branches)))) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 9f691c964..4fb0b08a4 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -8,43 +8,43 @@ [product] [ident "ident/" Codec<Text,Ident> Eq<Ident>] [maybe] - ["R" result] + ["E" error] [text "text/" Monoid<Text> Eq<Text>] (coll [list "list/" Monoid<List> Monad<List>])))) ## (type: (Lux a) -## (-> Compiler (R;Result [Compiler a]))) +## (-> Compiler (E;Error [Compiler a]))) (struct: #export _ (F;Functor Lux) (def: (map f fa) (function [state] (case (fa state) - (#R;Error msg) - (#R;Error msg) + (#E;Error msg) + (#E;Error msg) - (#R;Success [state' a]) - (#R;Success [state' (f a)]))))) + (#E;Success [state' a]) + (#E;Success [state' (f a)]))))) (struct: #export _ (A;Applicative Lux) (def: functor Functor<Lux>) (def: (wrap x) (function [state] - (#R;Success [state x]))) + (#E;Success [state x]))) (def: (apply ff fa) (function [state] (case (ff state) - (#R;Success [state' f]) + (#E;Success [state' f]) (case (fa state') - (#R;Success [state'' a]) - (#R;Success [state'' (f a)]) + (#E;Success [state'' a]) + (#E;Success [state'' (f a)]) - (#R;Error msg) - (#R;Error msg)) + (#E;Error msg) + (#E;Error msg)) - (#R;Error msg) - (#R;Error msg))))) + (#E;Error msg) + (#E;Error msg))))) (struct: #export _ (Monad Lux) (def: applicative Applicative<Lux>) @@ -52,10 +52,10 @@ (def: (join mma) (function [state] (case (mma state) - (#R;Error msg) - (#R;Error msg) + (#E;Error msg) + (#E;Error msg) - (#R;Success [state' ma]) + (#E;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) (R;Result [Compiler a]))) + (All [a] (-> Compiler (Lux a) (E;Error [Compiler a]))) (action compiler)) (def: #export (run compiler action) - (All [a] (-> Compiler (Lux a) (R;Result a))) + (All [a] (-> Compiler (Lux a) (E;Error a))) (case (action compiler) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success [_ output]) - (#R;Success output))) + (#E;Success [_ output]) + (#E;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) - (#R;Error error) + (#E;Error error) (right compiler) - (#R;Success [compiler' output]) - (#R;Success [compiler' output])))) + (#E;Success [compiler' output]) + (#E;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 - (#R;Success [compiler []]) - (#R;Error message)))) + (#E;Success [compiler []]) + (#E;Error message)))) (def: #export (fail msg) {#;doc "Fails with the given message."} (All [a] (-> Text (Lux a))) (function [_] - (#R;Error msg))) + (#E;Error msg))) (def: #export (find-module name) (-> Text (Lux Module)) (function [state] (case (get name (get@ #;modules state)) (#;Some module) - (#R;Success [state module]) + (#E;Success [state module]) _ - (#R;Error ($_ text/compose "Unknown module: " name))))) + (#E;Error ($_ text/compose "Unknown module: " name))))) (def: #export current-module-name (Lux Text) @@ -126,13 +126,13 @@ (#;Some scope) (case (get@ #;name scope) (#;Cons m-name #;Nil) - (#R;Success [state m-name]) + (#E;Success [state m-name]) _ - (#R;Error "Improper name for scope.")) + (#E;Error "Improper name for scope.")) _ - (#R;Error "Empty environment!") + (#E;Error "Empty environment!") ))) (def: #export current-module @@ -261,7 +261,7 @@ (let [[module name] ident] (: (Lux (Maybe Macro)) (function [state] - (#R;Success [state (find-macro' (get@ #;modules state) this-module module name)])))))) + (#E;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. @@ -360,7 +360,7 @@ A prefix can be given (or just be empty text \"\") to better identify the code for debugging purposes."} (-> Text (Lux Code)) (function [state] - (#R;Success [(update@ #;seed n.inc state) + (#E;Success [(update@ #;seed n.inc state) (code;symbol ["" ($_ text/compose "__gensym__" prefix (:: number;Codec<Text,Nat> encode (get@ #;seed state)))])]))) (def: (get-local-symbol ast) @@ -411,7 +411,7 @@ (def: #export (module-exists? module) (-> Text (Lux Bool)) (function [state] - (#R;Success [state (case (get module (get@ #;modules state)) + (#E;Success [state (case (get module (get@ #;modules state)) (#;Some _) true @@ -445,10 +445,10 @@ (get@ [#;captured #;mappings] scope)))] (wrap type)) (#;Some var-type) - (#R;Success [state var-type]) + (#E;Success [state var-type]) #;None - (#R;Error ($_ text/compose "Unknown variable: " name)))))) + (#E;Error ($_ text/compose "Unknown variable: " name)))))) (def: #export (find-def name) {#;doc "Looks-up a definition's whole data in the available modules (including the current one)."} @@ -460,10 +460,10 @@ (^slots [#;defs]) (get v-prefix (get@ #;modules state))] (get v-name defs))) (#;Some _anns) - (#R;Success [state _anns]) + (#E;Success [state _anns]) _ - (#R;Error ($_ text/compose "Unknown definition: " (ident/encode name)))))) + (#E;Error ($_ text/compose "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)."} @@ -494,8 +494,8 @@ (-> Text (Lux (List [Text Def]))) (function [state] (case (get module-name (get@ #;modules state)) - #;None (#R;Error ($_ text/compose "Unknown module: " module-name)) - (#;Some module) (#R;Success [state (get@ #;defs module)]) + #;None (#E;Error ($_ text/compose "Unknown module: " module-name)) + (#;Some module) (#E;Success [state (get@ #;defs module)]) ))) (def: #export (exports module-name) @@ -515,7 +515,7 @@ (|> state (get@ #;modules) [state] - #R;Success))) + #E;Success))) (def: #export (tags-of type-name) {#;doc "All the tags associated with a type definition."} @@ -534,7 +534,7 @@ {#;doc "The cursor of the current expression being analyzed."} (Lux Cursor) (function [state] - (#R;Success [state (get@ #;cursor state)]))) + (#E;Success [state (get@ #;cursor state)]))) (def: #export expected-type {#;doc "The expected type of the current expression being analyzed."} @@ -542,10 +542,10 @@ (function [state] (case (get@ #;expected state) (#;Some type) - (#R;Success [state type]) + (#E;Success [state type]) #;None - (#R;Error "Not expecting any type.")))) + (#E;Error "Not expecting any type.")))) (def: #export (imported-modules module-name) {#;doc "All the modules imported by a specified module."} @@ -590,10 +590,10 @@ (function [state] (case (list;inits (get@ #;scopes state)) #;None - (#R;Error "No local environment") + (#E;Error "No local environment") (#;Some scopes) - (#R;Success [state + (#E;Success [state (list/map (|>. (get@ [#;locals #;mappings]) (list/map (function [[name [type _]]] [name type]))) @@ -616,12 +616,12 @@ {#;doc "Obtains the current state of the compiler."} (Lux Compiler) (function [compiler] - (#R;Success [compiler compiler]))) + (#E;Success [compiler compiler]))) (def: #export type-context (Lux Type-Context) (function [compiler] - (#R;Success [compiler (get@ #;type-context compiler)]))) + (#E;Success [compiler (get@ #;type-context compiler)]))) (do-template [<macro> <func> <desc>] [(macro: #export (<macro> tokens) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index d744a28f7..fc6c7120f 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -12,7 +12,7 @@ [bool] [maybe] [ident "ident/" Eq<Ident> Codec<Text,Ident>] - ["R" result]) + ["E" error]) [macro #+ with-gensyms] (macro [code] ["s" syntax #+ syntax: Syntax] @@ -31,70 +31,70 @@ (def: #export fresh Env (dict;new number;Hash<Nat>)) (def: (run' env types poly) - (All [a] (-> Env (List Type) (Poly a) (R;Result a))) + (All [a] (-> Env (List Type) (Poly a) (E;Error a))) (case (p;run [env types] poly) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success [[env' remaining] output]) + (#E;Success [[env' remaining] output]) (case remaining #;Nil - (#R;Success output) + (#E;Success output) _ - (#R;Error (|> remaining + (#E;Error (|> remaining (list/map type;to-text) (text;join-with ", ") (text/compose "Unconsumed types: ")))))) (def: #export (run type poly) - (All [a] (-> Type (Poly a) (R;Result a))) + (All [a] (-> Type (Poly a) (E;Error a))) (run' fresh (list type) poly)) (def: #export env (Poly Env) (;function [[env inputs]] - (#R;Success [[env inputs] env]))) + (#E;Success [[env inputs] env]))) (def: (with-env temp poly) (All [a] (-> Env (Poly a) (Poly a))) (;function [[env inputs]] (case (p;run [temp inputs] poly) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success [[_ remaining] output]) - (#R;Success [[env remaining] output])))) + (#E;Success [[_ remaining] output]) + (#E;Success [[env remaining] output])))) (def: #export peek (Poly Type) (;function [[env inputs]] (case inputs #;Nil - (#R;Error "Empty stream of types.") + (#E;Error "Empty stream of types.") (#;Cons headT tail) - (#R;Success [[env inputs] headT])))) + (#E;Success [[env inputs] headT])))) (def: #export any (Poly Type) (;function [[env inputs]] (case inputs #;Nil - (#R;Error "Empty stream of types.") + (#E;Error "Empty stream of types.") (#;Cons headT tail) - (#R;Success [[env tail] headT])))) + (#E;Success [[env tail] headT])))) (def: #export (local types poly) (All [a] (-> (List Type) (Poly a) (Poly a))) (;function [[env pass-through]] (case (run' env types poly) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success output) - (#R;Success [[env pass-through] output])))) + (#E;Success output) + (#E;Success [[env pass-through] output])))) (def: (label idx) (-> Nat Code) @@ -108,11 +108,11 @@ (case (p;run [(dict;put current-id [type g!var] env) inputs] poly) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success [[_ inputs'] output]) - (#R;Success [[env inputs'] [g!var output]]))))) + (#E;Success [[_ inputs'] output]) + (#E;Success [[env inputs'] [g!var output]]))))) (do-template [<combinator> <name> <type>] [(def: #export <combinator> @@ -149,10 +149,10 @@ deg frac text)) - (#R;Error error) + (#E;Error error) (p;fail error) - (#R;Success _) + (#E;Success _) (wrap headT)))) (do-template [<name> <flattener> <tag>] diff --git a/stdlib/source/lux/macro/poly/json.lux b/stdlib/source/lux/macro/poly/json.lux index 1c3510b85..1b66e39f5 100644 --- a/stdlib/source/lux/macro/poly/json.lux +++ b/stdlib/source/lux/macro/poly/json.lux @@ -10,7 +10,7 @@ (text ["l" lexer]) [number "frac/" Codec<Text,Frac> "nat/" Codec<Text,Nat>] maybe - ["R" result] + ["E" error] [sum] [product] (coll [list "list/" Fold<List> Monad<List>] @@ -63,7 +63,7 @@ (struct: #hidden _ (Codec JSON Int) (def: encode (|>. int-to-nat (:: Codec<JSON,Nat> encode))) (def: decode - (|>. (:: Codec<JSON,Nat> decode) (:: R;Functor<Result> map nat-to-int)))) + (|>. (:: Codec<JSON,Nat> decode) (:: E;Functor<Error> map nat-to-int)))) (def: #hidden (nullable writer) {#;doc "Builds a JSON generator for potentially inexistent values."} @@ -78,7 +78,7 @@ (def: encode (|>. unit;out (:: Codec<JSON,Int> encode))) (def: decode - (|>. (:: Codec<JSON,Int> decode) (:: R;Functor<Result> map (unit;in carrier))))) + (|>. (:: Codec<JSON,Int> decode) (:: E;Functor<Error> map (unit;in carrier))))) (poly: #hidden Codec<JSON,?>//encode (with-expansions diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 4e431de82..a31eb8c6e 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -11,7 +11,7 @@ (coll [list "list/" Functor<List>]) [product] [maybe] - ["R" result])) + ["E" error])) (.. [code "code/" Eq<Code>])) ## [Utils] @@ -38,8 +38,8 @@ (Syntax Code) (function [tokens] (case tokens - #;Nil (#R;Error "There are no tokens to parse!") - (#;Cons [t tokens']) (#R;Success [tokens' t])))) + #;Nil (#E;Error "There are no tokens to parse!") + (#;Cons [t tokens']) (#E;Success [tokens' t])))) (do-template [<get-name> <type> <tag> <eq> <desc>] [(def: #export <get-name> @@ -48,10 +48,10 @@ (function [tokens] (case tokens (#;Cons [[_ (<tag> x)] tokens']) - (#R;Success [tokens' x]) + (#E;Success [tokens' x]) _ - (#R;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] + (#E;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] [ bool Bool #;Bool bool;Eq<Bool> "bool"] [ nat Nat #;Nat number;Eq<Nat> "nat"] @@ -73,10 +73,10 @@ remaining (if is-it? tokens' tokens)] - (#R;Success [remaining is-it?])) + (#E;Success [remaining is-it?])) _ - (#R;Success [tokens false])))) + (#E;Success [tokens false])))) (def: #export (this ast) {#;doc "Ensures the given Code is the next input."} @@ -85,12 +85,12 @@ (case tokens (#;Cons [token tokens']) (if (code/= ast token) - (#R;Success [tokens' []]) - (#R;Error ($_ text/compose "Expected a " (code;to-text ast) " but instead got " (code;to-text token) + (#E;Success [tokens' []]) + (#E;Error ($_ text/compose "Expected a " (code;to-text ast) " but instead got " (code;to-text token) (remaining-inputs tokens)))) _ - (#R;Error "There are no tokens to parse!")))) + (#E;Error "There are no tokens to parse!")))) (do-template [<name> <comp> <error>] [(def: #export <name> @@ -111,10 +111,10 @@ (function [tokens] (case tokens (#;Cons [[_ (<tag> ["" x])] tokens']) - (#R;Success [tokens' x]) + (#E;Success [tokens' x]) _ - (#R;Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))] + (#E;Error ($_ text/compose "Cannot parse local " <desc> (remaining-inputs tokens))))))] [local-symbol #;Symbol "symbol"] [ local-tag #;Tag "tag"] @@ -129,11 +129,11 @@ (case tokens (#;Cons [[_ (<tag> members)] tokens']) (case (p members) - (#R;Success [#;Nil x]) (#R;Success [tokens' x]) - _ (#R;Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens)))) + (#E;Success [#;Nil x]) (#E;Success [tokens' x]) + _ (#E;Error ($_ text/compose "Syntax was expected to fully consume " <desc> (remaining-inputs tokens)))) _ - (#R;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] + (#E;Error ($_ text/compose "Cannot parse " <desc> (remaining-inputs tokens))))))] [ form #;Form "form"] [tuple #;Tuple "tuple"] @@ -147,38 +147,38 @@ (case tokens (#;Cons [[_ (#;Record pairs)] tokens']) (case (p (join-pairs pairs)) - (#R;Success [#;Nil x]) (#R;Success [tokens' x]) - _ (#R;Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) + (#E;Success [#;Nil x]) (#E;Success [tokens' x]) + _ (#E;Error ($_ text/compose "Syntax was expected to fully consume record" (remaining-inputs tokens)))) _ - (#R;Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens)))))) + (#E;Error ($_ text/compose "Cannot parse record" (remaining-inputs tokens)))))) (def: #export end! {#;doc "Ensures there are no more inputs."} (Syntax Unit) (function [tokens] (case tokens - #;Nil (#R;Success [tokens []]) - _ (#R;Error ($_ text/compose "Expected list of tokens to be empty!" (remaining-inputs tokens)))))) + #;Nil (#E;Success [tokens []]) + _ (#E;Error ($_ text/compose "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 (#R;Success [tokens true]) - _ (#R;Success [tokens false])))) + #;Nil (#E;Success [tokens true]) + _ (#E;Success [tokens false])))) (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) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success value) - (#R;Success [input value]) + (#E;Success value) + (#E;Success [input value]) ))) (def: #export (local local-inputs syntax) @@ -186,16 +186,16 @@ (All [a] (-> (List Code) (Syntax a) (Syntax a))) (function [real-inputs] (case (syntax local-inputs) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success [unconsumed-inputs value]) + (#E;Success [unconsumed-inputs value]) (case unconsumed-inputs #;Nil - (#R;Success [real-inputs value]) + (#E;Success [real-inputs value]) _ - (#R;Error (text/compose "Unconsumed inputs: " + (#E;Error (text/compose "Unconsumed inputs: " (|> (list/map code;to-text unconsumed-inputs) (text;join-with ", ")))))))) @@ -265,10 +265,10 @@ g!end (code;symbol ["" ""]) error-msg (code;text (text/compose "Wrong syntax for " name)) export-ast (: (List Code) (case exported? - (#;Some #R;Error) + (#;Some #E;Error) (list (' #hidden)) - (#;Some #R;Success) + (#;Some #E;Success) (list (' #export)) _ @@ -280,15 +280,15 @@ (: (Syntax (Lux (List Code))) (do ;;_Monad<Parser>_ [(~@ (join-pairs vars+parsers)) - (~ g!end) end!] + (~ g!end) ;;end!] ((~' wrap) (do macro;Monad<Lux> [] (~ body)))))) - (#R;Success [(~ g!tokens) (~ g!body)]) + (#E;Success [(~ g!tokens) (~ g!body)]) ((~ g!body) (~ g!state)) - (#R;Error (~ g!msg)) - (#R;Error (text.join-with ": " (list (~ error-msg) (~ g!msg)))))))))))) + (#E;Error (~ g!msg)) + (#E;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 6d21a074b..e25f685cf 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -11,11 +11,11 @@ [maybe] [text] text/format - ["E" result]) + ["E" error]) [io #- run] (time [instant] [duration]) - ["R" math/random])) + ["r" math/random])) ## [Host] (do-template [<name> <signal>] @@ -83,18 +83,18 @@ (|>. product;right (n.> +0))) (def: (try seed random-test) - (-> Seed (R;Random Test) (Promise [Seed [Counters Text]])) - (let [[prng [new-seed test]] (R;run (R;pcg-32 [pcg-32-magic-inc seed]) - (do R;Monad<Random> + (-> Seed (r;Random Test) (Promise [Seed [Counters Text]])) + (let [[prng [new-seed test]] (r;run (r;pcg-32 [pcg-32-magic-inc seed]) + (do r;Monad<Random> [test random-test - next-seed R;nat] + next-seed r;nat] (wrap [next-seed test])))] (do Monad<Promise> [result test] (wrap [new-seed result])))) (def: (repeat' seed times random-test) - (-> Seed Nat (R;Random Test) Test) + (-> Seed Nat (r;Random Test) Test) (if (n.= +0 times) (fail "Cannot try a test 0 times.") (do Monad<Promise> @@ -110,9 +110,9 @@ (repeat' seed' (n.dec times) random-test))))) (def: #hidden (repeat ?seed times random-test) - (-> (Maybe Nat) Nat (R;Random Test) Test) + (-> (Maybe Nat) Nat (r;Random Test) Test) (repeat' (maybe;default (|> (io;run instant;now) instant;to-millis int-to-nat) - ?seed) + ?seed) (case ?seed #;None times (#;Some _) +1) @@ -197,10 +197,10 @@ (test "Can have defaults for Maybe values." (and (is "yolo" (maybe;default "yolo" - #;None)) + #;None)) (is "lol" (maybe;default "yolo" - (#;Some "lol"))))) + (#;Some "lol"))))) )) "Also works with random generation of values for property-based testing." (context: "Addition & Substraction" @@ -240,7 +240,7 @@ bindings' (|> bindings (L/map pair-to-list) L/join)] (` (repeat (~ =seed) (~ (code;nat =times)) - (do R;Monad<Random> + (do r;Monad<Random> [(~@ bindings')] ((~' wrap) (;;try-body (io;io (~ body)))))))) diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux index 9f2d2972b..b513ef07c 100644 --- a/stdlib/source/lux/time/date.lux +++ b/stdlib/source/lux/time/date.lux @@ -6,7 +6,7 @@ codec ["p" parser] [monad #+ do]) - (data ["R" result] + (data ["E" error] [maybe] [number "int/" Codec<Text,Int>] [text "text/" Monoid<Text>] @@ -311,7 +311,7 @@ #day (int-to-nat utc-day)}))) (def: (decode input) - (-> Text (R;Result Date)) + (-> Text (E;Error Date)) (l;run input lex-date)) (struct: #export _ diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index 003a84a97..35911a6cc 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -8,7 +8,7 @@ (data [number "int/" Codec<Text,Int> Number<Int>] [text "text/" Monoid<Text>] (text ["l" lexer]) - ["R" result]) + ["E" error]) (type opaque))) (opaque: #export Duration @@ -134,7 +134,7 @@ (merge (scale (sign utc-millis) milli)))))) (def: (decode input) - (-> Text (R;Result Duration)) + (-> Text (E;Error Duration)) (l;run input lex-duration)) (struct: #export _ diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index c76f108fb..31da7dc29 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -10,7 +10,7 @@ (data [text "text/" Monoid<Text>] (text ["l" lexer]) [number "int/" Codec<Text,Int>] - ["R" result] + ["E" error] [maybe] (coll [list "L/" Fold<List> Functor<List>] ["v" vector "v/" Functor<Vector> Fold<Vector>])) @@ -296,7 +296,7 @@ (shift (duration;scale utc-millis duration;milli)))))) (def: (decode input) - (-> Text (R;Result Instant)) + (-> Text (E;Error Instant)) (l;run input lex-instant)) (struct: #export _ diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux index 769b45391..f51ba5a15 100644 --- a/stdlib/source/lux/type/check.lux +++ b/stdlib/source/lux/type/check.lux @@ -2,57 +2,57 @@ Very useful for writing advanced macros."} lux - (lux (control ["F" functor] - ["A" applicative] - ["M" monad #+ do Monad]) + (lux (control [functor #+ Functor] + [applicative #+ Applicative] + [monad #+ do Monad]) (data [text "text/" Monoid<Text> Eq<Text>] [number "nat/" Codec<Text,Nat>] maybe [product] (coll [list]) - ["R" result]) - [type "Type/" Eq<Type>] + ["E" error]) + [type "type/" Eq<Type>] )) (type: #export Assumptions (List [[Type Type] Bool])) (type: #export (Check a) - (-> Type-Context (R;Result [Type-Context a]))) + (-> Type-Context (E;Error [Type-Context a]))) (type: #export Type-Vars (List [Nat (Maybe Type)])) -(struct: #export _ (F;Functor Check) +(struct: #export _ (Functor Check) (def: (map f fa) (function [context] (case (fa context) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success [context' output]) - (#R;Success [context' (f output)]) + (#E;Success [context' output]) + (#E;Success [context' (f output)]) )))) -(struct: #export _ (A;Applicative Check) +(struct: #export _ (Applicative Check) (def: functor Functor<Check>) (def: (wrap x) (function [context] - (#R;Success [context x]))) + (#E;Success [context x]))) (def: (apply ff fa) (function [context] (case (ff context) - (#R;Success [context' f]) + (#E;Success [context' f]) (case (fa context') - (#R;Success [context'' a]) - (#R;Success [context'' (f a)]) + (#E;Success [context'' a]) + (#E;Success [context'' (f a)]) - (#R;Error error) - (#R;Error error)) + (#E;Error error) + (#E;Error error)) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) ))) ) @@ -62,20 +62,20 @@ (def: (join ffa) (function [context] (case (ffa context) - (#R;Success [context' fa]) + (#E;Success [context' fa]) (case (fa context') - (#R;Success [context'' a]) - (#R;Success [context'' a]) + (#E;Success [context'' a]) + (#E;Success [context'' a]) - (#R;Error error) - (#R;Error error)) + (#E;Error error) + (#E;Error error)) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) ))) ) -(open Monad<Check> "Check/") +(open Monad<Check> "check/") (def: (var::get id plist) (-> Nat Type-Vars (Maybe (Maybe Type))) @@ -121,30 +121,30 @@ ## [[Logic]] (def: #export (run context proc) - (All [a] (-> Type-Context (Check a) (R;Result a))) + (All [a] (-> Type-Context (Check a) (E;Error a))) (case (proc context) - (#R;Error error) - (#R;Error error) + (#E;Error error) + (#E;Error error) - (#R;Success [context' output]) - (#R;Success output))) + (#E;Success [context' output]) + (#E;Success output))) (def: (apply-type! t-func t-arg) (-> Type Type (Check Type)) (function [context] (case (type;apply (list t-arg) t-func) #;None - (#R;Error ($_ text/compose "Invalid type application: " (type;to-text t-func) " on " (type;to-text t-arg))) + (#E;Error ($_ text/compose "Invalid type application: " (type;to-text t-func) " on " (type;to-text t-arg))) (#;Some output) - (#R;Success [context output])))) + (#E;Success [context output])))) (def: #export existential {#;doc "A producer of existential types."} (Check [Nat Type]) (function [context] (let [id (get@ #;ex-counter context)] - (#R;Success [(update@ #;ex-counter n.inc context) + (#E;Success [(update@ #;ex-counter n.inc context) [id (#;Ex id)]])))) (def: #export (bound? id) @@ -152,62 +152,62 @@ (function [context] (case (|> context (get@ #;var-bindings) (var::get id)) (#;Some (#;Some _)) - (#R;Success [context true]) + (#E;Success [context true]) (#;Some #;None) - (#R;Success [context false]) + (#E;Success [context false]) #;None - (#R;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) + (#E;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) (def: #export (read id) (-> Nat (Check Type)) (function [context] (case (|> context (get@ #;var-bindings) (var::get id)) (#;Some (#;Some type)) - (#R;Success [context type]) + (#E;Success [context type]) (#;Some #;None) - (#R;Error ($_ text/compose "Unbound type-var: " (nat/encode id))) + (#E;Error ($_ text/compose "Unbound type-var: " (nat/encode id))) #;None - (#R;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) + (#E;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) (def: #export (write id type) (-> Nat Type (Check Unit)) (function [context] (case (|> context (get@ #;var-bindings) (var::get id)) (#;Some (#;Some bound)) - (#R;Error ($_ text/compose "Cannot rebind type-var: " (nat/encode id) " | Current type: " (type;to-text bound))) + (#E;Error ($_ text/compose "Cannot rebind type-var: " (nat/encode id) " | Current type: " (type;to-text bound))) (#;Some #;None) - (#R;Success [(update@ #;var-bindings (var::put id (#;Some type)) context) + (#E;Success [(update@ #;var-bindings (var::put id (#;Some type)) context) []]) #;None - (#R;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) + (#E;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) (def: (update id type) (-> Nat Type (Check Unit)) (function [context] (case (|> context (get@ #;var-bindings) (var::get id)) (#;Some _) - (#R;Success [(update@ #;var-bindings (var::put id (#;Some type)) context) + (#E;Success [(update@ #;var-bindings (var::put id (#;Some type)) context) []]) #;None - (#R;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) + (#E;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) (def: #export (clear id) (-> Nat (Check Unit)) (function [context] (case (|> context (get@ #;var-bindings) (var::get id)) (#;Some _) - (#R;Success [(update@ #;var-bindings (var::put id #;None) context) + (#E;Success [(update@ #;var-bindings (var::put id #;None) context) []]) #;None - (#R;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) + (#E;Error ($_ text/compose "Unknown type-var: " (nat/encode id)))))) (def: #export (clean t-id type) (-> Nat Type (Check Type)) @@ -243,7 +243,7 @@ (#;Host name params) (do Monad<Check> - [=params (M;map @ (clean t-id) params)] + [=params (monad;map @ (clean t-id) params)] (wrap (#;Host name =params))) (^template [<tag>] @@ -260,7 +260,7 @@ (^template [<tag>] (<tag> env body) (do Monad<Check> - [=env (M;map @ (clean t-id) env) + [=env (monad;map @ (clean t-id) env) =body (clean t-id body)] ## TODO: DO NOT CLEAN THE BODY (wrap (<tag> =env =body)))) ([#;UnivQ] @@ -274,7 +274,7 @@ (Check [Nat Type]) (function [context] (let [id (get@ #;var-counter context)] - (#R;Success [(|> context + (#E;Success [(|> context (update@ #;var-counter n.inc) (update@ #;var-bindings (var::put id #;None))) [id (#;Var id)]])))) @@ -282,19 +282,19 @@ (def: get-bindings (Check (List [Nat (Maybe Type)])) (function [context] - (#R;Success [context + (#E;Success [context (get@ #;var-bindings context)]))) (def: (set-bindings value) (-> (List [Nat (Maybe Type)]) (Check Unit)) (function [context] - (#R;Success [(set@ #;var-bindings value context) + (#E;Success [(set@ #;var-bindings value context) []]))) (def: #export (delete id) (-> Nat (Check Unit)) (function [context] - (#R;Success [(update@ #;var-bindings (var::remove id) context) + (#E;Success [(update@ #;var-bindings (var::remove id) context) []]))) (def: #export (with k) @@ -316,16 +316,16 @@ (All [a] (-> (Check a) (Check (Maybe a)))) (function [context] (case (op context) - (#R;Success [context' output]) - (#R;Success [context' (#;Some output)]) + (#E;Success [context' output]) + (#E;Success [context' (#;Some output)]) - (#R;Error _) - (#R;Success [context #;None])))) + (#E;Error _) + (#E;Success [context #;None])))) (def: #export (fail message) (All [a] (-> Text (Check a))) (function [context] - (#R;Error message))) + (#E;Error message))) (def: (fail-check expected actual) (All [a] (-> Type Type (Check a))) @@ -337,18 +337,18 @@ (All [a] (-> (Check a) (Check a) (Check a))) (function [context] (case (left context) - (#R;Success [context' output]) - (#R;Success [context' output]) + (#E;Success [context' output]) + (#E;Success [context' output]) - (#R;Error _) + (#E;Error _) (right context)))) (def: (assumed? [e a] assumptions) (-> [Type Type] Assumptions (Maybe Bool)) (:: Monad<Maybe> map product;right (list;find (function [[[fe fa] status]] - (and (Type/= e fe) - (Type/= a fa))) + (and (type/= e fe) + (type/= a fa))) assumptions))) (def: (assume! ea status assumptions) @@ -370,11 +370,11 @@ {#;doc "Type-check to ensure that the 'expected' type subsumes the 'actual' type."} (-> Type Type Assumptions (Check Assumptions)) (if (is expected actual) - (Check/wrap assumptions) + (check/wrap assumptions) (case [expected actual] [(#;Var e-id) (#;Var a-id)] (if (n.= e-id a-id) - (Check/wrap assumptions) + (check/wrap assumptions) (do Monad<Check> [ebound (attempt (read e-id)) abound (attempt (read a-id))] @@ -394,12 +394,12 @@ (check' etype atype assumptions)))) [(#;Var id) _] - (on id actual (Check/wrap assumptions) + (on id actual (check/wrap assumptions) (function [bound] (check' bound actual assumptions))) [_ (#;Var id)] - (on id expected (Check/wrap assumptions) + (on id expected (check/wrap assumptions) (function [bound] (check' expected bound assumptions))) @@ -433,7 +433,7 @@ (case (assumed? fx-pair assumptions) (#;Some ?) (if ? - (Check/wrap assumptions) + (check/wrap assumptions) (fail-check expected actual)) #;None @@ -459,7 +459,7 @@ [actual' (apply-type! actual var) assumptions (check' expected actual' assumptions) _ (clean var-id expected)] - (Check/wrap assumptions)))) + (check/wrap assumptions)))) [(#;ExQ e!env e!def) _] (with @@ -468,7 +468,7 @@ [expected' (apply-type! expected var) assumptions (check' expected' actual assumptions) _ (clean var-id actual)] - (Check/wrap assumptions)))) + (check/wrap assumptions)))) [_ (#;ExQ a!env a!def)] (do Monad<Check> @@ -481,16 +481,16 @@ (n.= (list;size e-params) (list;size a-params))) (do Monad<Check> - [assumptions (M;fold Monad<Check> - (function [[e a] assumptions] (check' e a assumptions)) - assumptions - (list;zip2 e-params a-params))] - (Check/wrap assumptions)) + [assumptions (monad;fold Monad<Check> + (function [[e a] assumptions] (check' e a assumptions)) + assumptions + (list;zip2 e-params a-params))] + (check/wrap assumptions)) (fail-check expected actual)) (^template [<identity> <compose>] [<identity> <identity>] - (Check/wrap assumptions) + (check/wrap assumptions) [(<compose> eL eR) (<compose> aL aR)] (do Monad<Check> @@ -506,7 +506,7 @@ [(#;Ex e!id) (#;Ex a!id)] (if (n.= e!id a!id) - (Check/wrap assumptions) + (check/wrap assumptions) (fail-check expected actual)) [(#;Named _ ?etype) _] @@ -529,13 +529,13 @@ {#;doc "A simple type-checking function that just returns a yes/no answer."} (-> Type Type Bool) (case (run fresh-context (check expected actual)) - (#R;Error error) + (#E;Error error) false - (#R;Success _) + (#E;Success _) true)) (def: #export get-context (Check Type-Context) (function [context] - (#R;Success [context context]))) + (#E;Success [context context]))) diff --git a/stdlib/source/lux/type/opaque.lux b/stdlib/source/lux/type/opaque.lux index b58e8d32e..00a27333a 100644 --- a/stdlib/source/lux/type/opaque.lux +++ b/stdlib/source/lux/type/opaque.lux @@ -4,7 +4,7 @@ [monad #+ do Monad] ["p" parser]) (data [text "text/" Eq<Text> Monoid<Text>] - ["R" result] + ["E" error] (coll [list "list/" Functor<List> Monoid<List>])) [macro] (macro [code] @@ -91,7 +91,7 @@ _ (macro;fail ($_ text/compose "Wrong syntax for " up-cast))))]))))]] (function [compiler] - (#R;Success [(update@ #;modules (put this-module-name this-module) compiler) + (#E;Success [(update@ #;modules (put this-module-name this-module) compiler) []])))) (def: (un-install-casts' this-module-name) @@ -102,7 +102,7 @@ (update@ #;defs (remove down-cast)) (update@ #;defs (remove up-cast)))]] (function [compiler] - (#R;Success [(update@ #;modules (put this-module-name this-module) compiler) + (#E;Success [(update@ #;modules (put this-module-name this-module) compiler) []])))) (syntax: #hidden (install-casts [name s;local-symbol] diff --git a/stdlib/source/lux/world/blob.jvm.lux b/stdlib/source/lux/world/blob.jvm.lux index 4d35a5658..88efc1859 100644 --- a/stdlib/source/lux/world/blob.jvm.lux +++ b/stdlib/source/lux/world/blob.jvm.lux @@ -5,7 +5,7 @@ [eq]) (data [bit] [maybe] - ["R" result] + ["E" error] text/format) [host])) @@ -31,23 +31,23 @@ (host;array byte size)) (def: #export (read-8 idx blob) - (-> Nat Blob (R;Result Nat)) + (-> Nat Blob (E;Error Nat)) (if (n.< (host;array-length blob) idx) - (|> (host;array-read idx blob) byte-to-nat #R;Success) + (|> (host;array-read idx blob) byte-to-nat #E;Success) (ex;throw Index-Out-Of-Bounds (%n idx)))) (def: #export (read-16 idx blob) - (-> Nat Blob (R;Result Nat)) + (-> Nat Blob (E;Error Nat)) (if (n.< (host;array-length blob) (n.+ +1 idx)) - (#R;Success ($_ bit;or + (#E;Success ($_ bit;or (bit;shift-left +8 (byte-to-nat (host;array-read idx blob))) (byte-to-nat (host;array-read (n.+ +1 idx) blob)))) (ex;throw Index-Out-Of-Bounds (%n idx)))) (def: #export (read-32 idx blob) - (-> Nat Blob (R;Result Nat)) + (-> Nat Blob (E;Error Nat)) (if (n.< (host;array-length blob) (n.+ +3 idx)) - (#R;Success ($_ bit;or + (#E;Success ($_ bit;or (bit;shift-left +24 (byte-to-nat (host;array-read idx blob))) (bit;shift-left +16 (byte-to-nat (host;array-read (n.+ +1 idx) blob))) (bit;shift-left +8 (byte-to-nat (host;array-read (n.+ +2 idx) blob))) @@ -55,9 +55,9 @@ (ex;throw Index-Out-Of-Bounds (%n idx)))) (def: #export (read-64 idx blob) - (-> Nat Blob (R;Result Nat)) + (-> Nat Blob (E;Error Nat)) (if (n.< (host;array-length blob) (n.+ +7 idx)) - (#R;Success ($_ bit;or + (#E;Success ($_ bit;or (bit;shift-left +56 (byte-to-nat (host;array-read idx blob))) (bit;shift-left +48 (byte-to-nat (host;array-read (n.+ +1 idx) blob))) (bit;shift-left +40 (byte-to-nat (host;array-read (n.+ +2 idx) blob))) @@ -69,35 +69,35 @@ (ex;throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-8 idx value blob) - (-> Nat Nat Blob (R;Result Unit)) + (-> Nat Nat Blob (E;Error Unit)) (if (n.< (host;array-length blob) idx) (exec (|> blob (host;array-write idx (host;l2b (:! Int value)))) - (#R;Success [])) + (#E;Success [])) (ex;throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-16 idx value blob) - (-> Nat Nat Blob (R;Result Unit)) + (-> Nat Nat Blob (E;Error Unit)) (if (n.< (host;array-length blob) (n.+ +1 idx)) (exec (|> blob (host;array-write idx (host;l2b (:! Int (bit;shift-right +8 value)))) (host;array-write (n.+ +1 idx) (host;l2b (:! Int value)))) - (#R;Success [])) + (#E;Success [])) (ex;throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-32 idx value blob) - (-> Nat Nat Blob (R;Result Unit)) + (-> Nat Nat Blob (E;Error Unit)) (if (n.< (host;array-length blob) (n.+ +3 idx)) (exec (|> blob (host;array-write idx (host;l2b (:! Int (bit;shift-right +24 value)))) (host;array-write (n.+ +1 idx) (host;l2b (:! Int (bit;shift-right +16 value)))) (host;array-write (n.+ +2 idx) (host;l2b (:! Int (bit;shift-right +8 value)))) (host;array-write (n.+ +3 idx) (host;l2b (:! Int value)))) - (#R;Success [])) + (#E;Success [])) (ex;throw Index-Out-Of-Bounds (%n idx)))) (def: #export (write-64 idx value blob) - (-> Nat Nat Blob (R;Result Unit)) + (-> Nat Nat Blob (E;Error Unit)) (if (n.< (host;array-length blob) (n.+ +7 idx)) (exec (|> blob (host;array-write idx (host;l2b (:! Int (bit;shift-right +56 value)))) @@ -108,7 +108,7 @@ (host;array-write (n.+ +5 idx) (host;l2b (:! Int (bit;shift-right +16 value)))) (host;array-write (n.+ +6 idx) (host;l2b (:! Int (bit;shift-right +8 value)))) (host;array-write (n.+ +7 idx) (host;l2b (:! Int value)))) - (#R;Success [])) + (#E;Success [])) (ex;throw Index-Out-Of-Bounds (%n idx)))) (def: #export (size blob) @@ -116,7 +116,7 @@ (host;array-length blob)) (def: #export (slice from to blob) - (-> Nat Nat Blob (R;Result Blob)) + (-> Nat Nat Blob (E;Error Blob)) (with-expansions [<description> (as-is (format "from = " (%n from) " | " "to = " (%n to)))] (let [size (host;array-length blob)] (cond (not (n.<= to from)) @@ -127,10 +127,10 @@ (ex;throw Index-Out-Of-Bounds <description>) ## else - (#R;Success (Arrays.copyOfRange [blob (:! Int from) (:! Int (n.inc to))])))))) + (#E;Success (Arrays.copyOfRange [blob (:! Int from) (:! Int (n.inc to))])))))) (def: #export (slice' from blob) - (-> Nat Blob (R;Result Blob)) + (-> Nat Blob (E;Error Blob)) (slice from (n.dec (host;array-length blob)) blob)) (struct: #export _ (eq;Eq Blob) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 4c0881e04..1c968b888 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -4,7 +4,7 @@ ["ex" exception #+ exception:]) (concurrency ["P" promise] ["T" task]) - (data ["R" result] + (data ["E" error] (coll [array])) (time ["i" instant] ["d" duration]) @@ -52,7 +52,7 @@ (do-template [<name> <flag>] [(def: #export (<name> data file) (-> Blob File (T;Task Unit)) - (P;future (do (R;ResultT io;Monad<IO>) + (P;future (do (E;ErrorT io;Monad<IO>) [stream (FileOutputStream.new [(java.io.File.new file) <flag>]) _ (OutputStream.write [data] stream) _ (OutputStream.flush [] stream)] @@ -64,7 +64,7 @@ (def: #export (read file) (-> File (T;Task Blob)) - (P;future (do (R;ResultT io;Monad<IO>) + (P;future (do (E;ErrorT io;Monad<IO>) [#let [file' (java.io.File.new file)] size (java.io.File.length [] file') #let [data (blob;create (int-to-nat size))] @@ -77,13 +77,13 @@ (def: #export (size file) (-> File (T;Task Nat)) - (P;future (do (R;ResultT io;Monad<IO>) + (P;future (do (E;ErrorT io;Monad<IO>) [size (java.io.File.length [] (java.io.File.new file))] (wrap (int-to-nat size))))) (def: #export (files dir) (-> File (T;Task (List File))) - (P;future (do (R;ResultT io;Monad<IO>) + (P;future (do (E;ErrorT io;Monad<IO>) [files (java.io.File.listFiles [] (java.io.File.new dir))] (monad;map @ (java.io.File.getAbsolutePath []) (array;to-list files))))) @@ -110,7 +110,7 @@ (def: #export (get-last-modified file) (-> File (T;Task i;Instant)) - (P;future (do (R;ResultT io;Monad<IO>) + (P;future (do (E;ErrorT io;Monad<IO>) [millis (java.io.File.lastModified [] (java.io.File.new file))] (wrap (|> millis d;from-millis i;absolute))))) diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index fec65e387..e8832b67e 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -4,7 +4,7 @@ (concurrency ["P" promise] ["T" task] [frp]) - (data ["R" result]) + (data ["E" error]) (type opaque) (world [blob #+ Blob]) [io] @@ -44,7 +44,7 @@ (def: #export (read data offset length self) (let [in (get@ #in (@repr self))] (P;future - (do (R;ResultT io;Monad<IO>) + (do (E;ErrorT io;Monad<IO>) [bytes-read (InputStream.read [data (nat-to-int offset) (nat-to-int length)] in)] (wrap (int-to-nat bytes-read)))))) @@ -52,7 +52,7 @@ (def: #export (write data offset length self) (let [out (get@ #out (@repr self))] (P;future - (do (R;ResultT io;Monad<IO>) + (do (E;ErrorT io;Monad<IO>) [_ (OutputStream.write [data (nat-to-int offset) (nat-to-int length)] out)] (Flushable.flush [] out))))) @@ -60,14 +60,14 @@ (def: #export (close self) (let [(^open) (@repr self)] (P;future - (do (R;ResultT io;Monad<IO>) + (do (E;ErrorT io;Monad<IO>) [_ (AutoCloseable.close [] in) _ (AutoCloseable.close [] out)] (AutoCloseable.close [] socket))))) (def: (tcp-client socket) - (-> Socket (io;IO (R;Result TCP))) - (do (R;ResultT io;Monad<IO>) + (-> Socket (io;IO (E;Error TCP))) + (do (E;ErrorT io;Monad<IO>) [input (Socket.getInputStream [] socket) output (Socket.getOutputStream [] socket)] (wrap (@opaque {#socket socket @@ -77,7 +77,7 @@ (def: #export (client address port) (-> ..;Address ..;Port (T;Task TCP)) (P;future - (do (R;ResultT io;Monad<IO>) + (do (E;ErrorT io;Monad<IO>) [socket (Socket.new [address (nat-to-int port)])] (tcp-client socket)))) @@ -102,21 +102,21 @@ (def: #export (server port) (-> ..;Port (T;Task (frp;Channel TCP))) (P;future - (do (R;ResultT io;Monad<IO>) + (do (E;ErrorT io;Monad<IO>) [server (ServerSocket.new [(nat-to-int port)]) #let [output (frp;channel TCP) _ (: (P;Promise Bool) (P;future (loop [tail output] (do io;Monad<IO> - [?client (do (R;ResultT io;Monad<IO>) + [?client (do (E;ErrorT io;Monad<IO>) [socket (ServerSocket.accept [] server)] (tcp-client socket))] (case ?client - (#R;Error error) + (#E;Error error) (frp;close tail) - (#R;Success client) + (#E;Success client) (do @ [?tail' (frp;write client tail)] (case ?tail' diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index 89eaba448..29be4a920 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -5,7 +5,7 @@ (concurrency ["P" promise] ["T" task] [frp]) - (data ["R" result] + (data ["E" error] [maybe] (coll [array])) (type opaque) @@ -45,10 +45,10 @@ (exception: #export Multiple-Candidate-Addresses) (def: (resolve address) - (-> ..;Address (io;IO (R;Result InetAddress))) - (do (R;ResultT io;Monad<IO>) + (-> ..;Address (io;IO (E;Error InetAddress))) + (do (E;ErrorT io;Monad<IO>) [addresses (InetAddress.getAllByName [address])] - (: (io;IO (R;Result InetAddress)) + (: (io;IO (E;Error InetAddress)) (case (array;size addresses) +0 (io;io (ex;throw Cannot-Resolve-Address address)) +1 (wrap (maybe;assume (array;read +0 addresses))) @@ -62,7 +62,7 @@ (let [(^open) (@repr self) packet (DatagramPacket.new|receive [data (nat-to-int offset) (nat-to-int length)])] (P;future - (do (R;ResultT io;Monad<IO>) + (do (E;ErrorT io;Monad<IO>) [_ (DatagramSocket.receive [packet] socket) #let [bytes-read (int-to-nat (DatagramPacket.getLength [] packet))]] (wrap [bytes-read @@ -72,7 +72,7 @@ (def: #export (write address port data offset length self) (-> ..;Address ..;Port Blob Nat Nat UDP (T;Task Unit)) (P;future - (do (R;ResultT io;Monad<IO>) + (do (E;ErrorT io;Monad<IO>) [address (resolve address) #let [(^open) (@repr self)]] (DatagramSocket.send (DatagramPacket.new|send [data (nat-to-int offset) (nat-to-int length) address (nat-to-int port)]) @@ -87,14 +87,14 @@ (def: #export (client _) (-> Unit (T;Task UDP)) (P;future - (do (R;ResultT io;Monad<IO>) + (do (E;ErrorT io;Monad<IO>) [socket (DatagramSocket.new|client [])] (wrap (@opaque (#socket socket)))))) (def: #export (server port) (-> ..;Port (T;Task UDP)) (P;future - (do (R;ResultT io;Monad<IO>) + (do (E;ErrorT io;Monad<IO>) [socket (DatagramSocket.new|server [(nat-to-int port)])] (wrap (@opaque (#socket socket)))))) ) |