diff options
52 files changed, 913 insertions, 904 deletions
diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux index b220fb433..eba8ae62a 100644 --- a/new-luxc/source/luxc/analyser.lux +++ b/new-luxc/source/luxc/analyser.lux @@ -1,7 +1,7 @@ (;module: lux (lux (control monad) - (data ["E" error] + (data ["R" result] [text "T/" Eq<Text>] text/format [number] @@ -19,85 +19,93 @@ ["&&;" reference] ["&&;" type] ["&&;" struct] + ## ["&&;" case] ["&&;" proc])) (def: #export (analyser eval) (-> &;Eval &;Analyser) (: (-> Code (Lux la;Analysis)) (function analyse [ast] - (case ast - (^template [<tag> <analyser>] - [cursor (<tag> value)] - (<analyser> value)) - ([#;Bool &&primitive;analyse-bool] - [#;Nat &&primitive;analyse-nat] - [#;Int &&primitive;analyse-int] - [#;Deg &&primitive;analyse-deg] - [#;Real &&primitive;analyse-real] - [#;Char &&primitive;analyse-char] - [#;Text &&primitive;analyse-text]) + (let [[cursor ast'] ast] + (&;with-cursor cursor + (case ast' + (^template [<tag> <analyser>] + (<tag> value) + (<analyser> value)) + ([#;Bool &&primitive;analyse-bool] + [#;Nat &&primitive;analyse-nat] + [#;Int &&primitive;analyse-int] + [#;Deg &&primitive;analyse-deg] + [#;Real &&primitive;analyse-real] + [#;Char &&primitive;analyse-char] + [#;Text &&primitive;analyse-text]) - (^ [cursor (#;Tuple (list))]) - &&primitive;analyse-unit + (^ (#;Tuple (list))) + &&primitive;analyse-unit - (^ [cursor (#;Tuple (list singleton))]) - (analyse singleton) + (^ (#;Tuple (list singleton))) + (analyse singleton) - (^ [cursor (#;Tuple elems)]) - (&&struct;analyse-tuple analyse elems) + (^ (#;Tuple elems)) + (&&struct;analyse-tuple analyse elems) - [cursor (#;Symbol reference)] - (&&reference;analyse-reference reference) + (#;Symbol reference) + (&&reference;analyse-reference reference) - (^ [cursor (#;Form (list [_ (#;Symbol ["" "_lux_check"])] - type - value))]) - (&&type;analyse-check analyse eval type value) + (^ (#;Form (list [_ (#;Symbol ["" "_lux_check"])] + type + value))) + (&&type;analyse-check analyse eval type value) - (^ [cursor (#;Form (list [_ (#;Symbol ["" "_lux_coerce"])] - type - value))]) - (&&type;analyse-coerce analyse eval type value) + (^ (#;Form (list [_ (#;Symbol ["" "_lux_coerce"])] + type + value))) + (&&type;analyse-coerce analyse eval type value) - (^ [cursor (#;Form (list [_ (#;Symbol ["" "_lux_proc"])] - [_ (#;Symbol proc)] - [_ (#;Tuple args)]))]) - (&&proc;analyse-proc analyse proc args) + (^ (#;Form (list [_ (#;Symbol ["" "_lux_proc"])] + [_ (#;Symbol proc)] + [_ (#;Tuple args)]))) + (&&proc;analyse-proc analyse proc args) - (^ [cursor (#;Form (list [_ (#;Nat tag)] - value))]) - (&&struct;analyse-variant analyse tag value) + ## (^ (#;Form (list& [_ (#;Symbol ["" "_lux_case"])] + ## input + ## branches))) + ## (&&case;analyse-case analyse proc branches) - (^ [cursor (#;Form (list& func args))]) - (do Monad<Lux> - [[funcT =func] (&&common;with-unknown-type - (analyse func))] - (case =func - (#la;Absolute def-name) - (do @ - [[def-type def-anns def-value] (macro;find-def def-name)] - (if (macro;macro? def-anns) + (^ (#;Form (list [_ (#;Nat tag)] + value))) + (&&struct;analyse-variant analyse tag value) + + (^ (#;Form (list& func args))) + (do Monad<Lux> + [[funcT =func] (&&common;with-unknown-type + (analyse func))] + (case =func + (#la;Absolute def-name) (do @ - [## macro-expansion (function [compiler] - ## (case (macro-caller def-value args compiler) - ## (#E;Success [compiler' output]) - ## (#E;Success [compiler' output]) + [[def-type def-anns def-value] (macro;find-def def-name)] + (if (macro;macro? def-anns) + (do @ + [## macro-expansion (function [compiler] + ## (case (macro-caller def-value args compiler) + ## (#R;Success [compiler' output]) + ## (#R;Success [compiler' output]) + + ## (#R;Error error) + ## ((&;fail error) compiler))) + macro-expansion (: (Lux (List Code)) + (undefined))] + (case macro-expansion + (^ (list single-expansion)) + (analyse single-expansion) - ## (#E;Error error) - ## ((&;fail error) compiler))) - macro-expansion (: (Lux (List Code)) - (undefined))] - (case macro-expansion - (^ (list single-expansion)) - (analyse single-expansion) + _ + (&;fail (format "Macro expressions must expand to a single expression: " (%code ast))))) + (&&function;analyse-apply analyse funcT =func args))) - _ - (&;fail (format "Macro expressions must expand to a single expression: " (%code ast))))) + _ (&&function;analyse-apply analyse funcT =func args))) _ - (&&function;analyse-apply analyse funcT =func args))) - - _ - (&;fail (format "Unrecognized syntax: " (%code ast))) - )))) + (&;fail (format "Unrecognized syntax: " (%code ast))) + )))))) diff --git a/new-luxc/source/luxc/analyser/function.lux b/new-luxc/source/luxc/analyser/function.lux index 17441b760..4b867551e 100644 --- a/new-luxc/source/luxc/analyser/function.lux +++ b/new-luxc/source/luxc/analyser/function.lux @@ -1,8 +1,7 @@ (;module: lux (lux (control monad) - (data ["E" error] - [text] + (data [text] text/format (coll [list "L/" Fold<List> Monoid<List> Monad<List>])) [macro #+ Monad<Lux>] diff --git a/new-luxc/source/luxc/analyser/proc.lux b/new-luxc/source/luxc/analyser/proc.lux index 8bd975272..56b4ba3b3 100644 --- a/new-luxc/source/luxc/analyser/proc.lux +++ b/new-luxc/source/luxc/analyser/proc.lux @@ -1,8 +1,7 @@ (;module: lux (lux (control monad) - (data ["E" error] - [text] + (data [text] text/format (coll ["D" dict]) maybe)) diff --git a/new-luxc/source/luxc/analyser/struct.lux b/new-luxc/source/luxc/analyser/struct.lux index a698fb49f..0ca3c9f63 100644 --- a/new-luxc/source/luxc/analyser/struct.lux +++ b/new-luxc/source/luxc/analyser/struct.lux @@ -4,8 +4,7 @@ pipe) [io #- run] (concurrency ["A" atom]) - (data ["E" error] - [text "T/" Eq<Text>] + (data [text "T/" Eq<Text>] text/format (coll [list "L/" Fold<List> Monoid<List> Monad<List>] ["D" dict]) diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux index ee2d4464d..e900edf6c 100644 --- a/new-luxc/source/luxc/base.lux +++ b/new-luxc/source/luxc/base.lux @@ -3,7 +3,7 @@ (lux (control monad) (data [text "T/" Eq<Text>] text/format - ["E" error]) + ["R" result]) [macro #+ Monad<Lux>] (type ["TC" check])) (luxc (lang ["la" analysis]))) @@ -35,23 +35,23 @@ (All [a] (-> Type (Lux a) (Lux a))) (function [compiler] (case (action (set@ #;expected (#;Some expected) compiler)) - (#E;Success [compiler' output]) + (#R;Success [compiler' output]) (let [old-expected (get@ #;expected compiler)] - (#E;Success [(set@ #;expected old-expected compiler') + (#R;Success [(set@ #;expected old-expected compiler') output])) - (#E;Error error) - (#E;Error error)))) + (#R;Error error) + (#R;Error error)))) (def: #export (within-type-env action) (All [a] (-> (TC;Check a) (Lux a))) (function [compiler] (case (action (get@ #;type-context compiler)) - (#E;Error error) - (#E;Error error) + (#R;Error error) + (#R;Error error) - (#E;Success [context' output]) - (#E;Success [(set@ #;type-context context' compiler) + (#R;Success [context' output]) + (#R;Success [(set@ #;type-context context' compiler) output])))) (def: #export (pl-contains? key mappings) @@ -93,22 +93,22 @@ (function [compiler] (let [old-source (get@ #;source compiler)] (case (action (set@ #;source source compiler)) - (#E;Error error) - (#E;Error error) + (#R;Error error) + (#R;Error error) - (#E;Success [compiler' output]) - (#E;Success [(set@ #;source old-source compiler') + (#R;Success [compiler' output]) + (#R;Success [(set@ #;source old-source compiler') output]))))) (def: #export (with-stacked-errors handler action) (All [a] (-> (-> [] Text) (Lux a) (Lux a))) (function [compiler] (case (action compiler) - (#E;Success [compiler' output]) - (#E;Success [compiler' output]) + (#R;Success [compiler' output]) + (#R;Success [compiler' output]) - (#E;Error error) - (#E;Error (if (T/= "" error) + (#R;Error error) + (#R;Error (if (T/= "" error) (handler []) (format error "\n-----------------------------------------\n" (handler []))))))) @@ -128,14 +128,26 @@ (All [a] (-> (Lux a) (Lux [Scope a]))) (function [compiler] (case (action (update@ #;scopes (|>. (#;Cons fresh-scope)) compiler)) - (#E;Success [compiler' output]) + (#R;Success [compiler' output]) (case (get@ #;scopes compiler') #;Nil - (#E;Error "Impossible error: Drained scopes!") + (#R;Error "Impossible error: Drained scopes!") (#;Cons head tail) - (#E;Success [(set@ #;scopes tail compiler') + (#R;Success [(set@ #;scopes tail compiler') [head output]])) - (#E;Error error) - (#E;Error error)))) + (#R;Error error) + (#R;Error error)))) + +(def: #export (with-cursor cursor action) + (All [a] (-> Cursor (Lux a) (Lux a))) + (function [compiler] + (let [old-cursor (get@ #;cursor compiler)] + (case (action (set@ #;cursor cursor compiler)) + (#R;Success [compiler' output]) + (#R;Success [(set@ #;cursor old-cursor compiler') + output]) + + (#R;Error error) + (#R;Error error))))) diff --git a/new-luxc/source/luxc/compiler.lux b/new-luxc/source/luxc/compiler.lux index 92d4bf8ab..55fe3c738 100644 --- a/new-luxc/source/luxc/compiler.lux +++ b/new-luxc/source/luxc/compiler.lux @@ -3,7 +3,7 @@ (lux (control monad) (concurrency ["A" atom] ["P" promise]) - (data ["E" error] + (data ["R" result] [text "T/" Hash<Text>] text/format (coll ["D" dict] @@ -70,19 +70,19 @@ (Lux Code) (function [compiler] (case (&parser;parse (get@ #;source compiler)) - (#E;Error error) - (#E;Error error) + (#R;Error error) + (#R;Error error) - (#E;Success [source' output]) - (#E;Success [(set@ #;source source' compiler) + (#R;Success [source' output]) + (#R;Success [(set@ #;source source' compiler) output])))) (def: (compile-module source-dirs module-name compiler) - (-> (List &;Path) Text Compiler (P;Promise (E;Error Compiler))) + (-> (List &;Path) Text Compiler (P;Promise (R;Result Compiler))) (do P;Monad<Promise> [?input (&io;read-module source-dirs module-name)] (case ?input - (#E;Success [file-name file-content]) + (#R;Success [file-name file-content]) (let [compilation (do Monad<Lux> [_ (with-active-compilation [module-name file-name @@ -95,17 +95,17 @@ ## (&module;generate-descriptor module-name) )] (case (macro;run' compiler compilation) - (#E;Success [compiler module-descriptor]) + (#R;Success [compiler module-descriptor]) (do @ [## _ (&io;write-module module-name module-descriptor) ] - (wrap (#E;Success compiler))) + (wrap (#R;Success compiler))) - (#E;Error error) - (wrap (#E;Error error)))) + (#R;Error error) + (wrap (#R;Error error)))) - (#E;Error error) - (wrap (#E;Error error))))) + (#R;Error error) + (wrap (#R;Error error))))) (jvm-import org.objectweb.asm.MethodVisitor) @@ -135,11 +135,11 @@ (array-store +2 (:! (Class Object) Integer.TYPE)) (array-store +3 (:! (Class Object) Integer.TYPE)))] (class-for java.lang.ClassLoader)) - (#E;Success method) + (#R;Success method) (do-to method (AccessibleObject.setAccessible [true])) - (#E;Error error) + (#R;Error error) (error! error))) (def: (memory-class-loader store) @@ -155,10 +155,10 @@ (:! Object (l2i 0)) (:! Object (l2i (nat-to-int (array-length bytecode))))))] ClassLoader::defineClass) - (#E;Success output) + (#R;Success output) [] - (#E;Error error) + (#R;Error error) (error! error)) _ @@ -201,14 +201,14 @@ #;host (:! Void host)}) (def: (or-crash! action) - (All [a] (-> (P;Promise (E;Error a)) (P;Promise a))) + (All [a] (-> (P;Promise (R;Result a)) (P;Promise a))) (do P;Monad<Promise> [?output action] (case ?output - (#E;Error error) + (#R;Error error) (error! error) - (#E;Success output) + (#R;Success output) (wrap output)))) (def: #export (compile-program program target sources) diff --git a/new-luxc/source/luxc/compiler/base.jvm.lux b/new-luxc/source/luxc/compiler/base.jvm.lux index f5784319a..01a97aec4 100644 --- a/new-luxc/source/luxc/compiler/base.jvm.lux +++ b/new-luxc/source/luxc/compiler/base.jvm.lux @@ -3,8 +3,7 @@ (lux (control monad) [io #- run] (concurrency ["A" atom]) - (data ["E" error] - [text] + (data [text] text/format) host) (luxc ["&" base])) diff --git a/new-luxc/source/luxc/compiler/common.jvm.lux b/new-luxc/source/luxc/compiler/common.jvm.lux index d7abc1ff1..bd5487ef6 100644 --- a/new-luxc/source/luxc/compiler/common.jvm.lux +++ b/new-luxc/source/luxc/compiler/common.jvm.lux @@ -1,7 +1,7 @@ (;module: lux (lux (concurrency ["A" atom]) - (data ["E" error] + (data ["R" result] (coll ["D" dict])) [macro] [host #+ jvm-import])) @@ -33,13 +33,13 @@ (:! Host) (get@ #visitor))) -(def: (visitor::put visitor compiler) - (-> MethodVisitor Compiler Compiler) +(def: (visitor::put ?visitor compiler) + (-> (Maybe MethodVisitor) Compiler Compiler) (update@ #;host (function [host] (|> host (:! Host) - (set@ #visitor (#;Some visitor)) + (set@ #visitor ?visitor) (:! Void))) compiler)) @@ -48,18 +48,18 @@ (function [compiler] (case (visitor::get compiler) #;None - (#E;Error "No visitor has been set.") + (#R;Error "No visitor has been set.") (#;Some visitor) - (#E;Success [compiler visitor])))) + (#R;Success [compiler visitor])))) (def: #export (with-visitor visitor body) (All [a] (-> MethodVisitor (Lux a) (Lux a))) (function [compiler] - (case (macro;run' (visitor::put visitor compiler) body) - (#E;Error error) - (#E;Error error) + (case (macro;run' (visitor::put (#;Some visitor) compiler) body) + (#R;Error error) + (#R;Error error) - (#E;Success [compiler' output]) - (#E;Success [(visitor::put (visitor::get compiler) compiler') + (#R;Success [compiler' output]) + (#R;Success [(visitor::put (visitor::get compiler) compiler') output])))) diff --git a/new-luxc/source/luxc/compiler/expr.jvm.lux b/new-luxc/source/luxc/compiler/expr.jvm.lux index 173293b1c..b2e4923c4 100644 --- a/new-luxc/source/luxc/compiler/expr.jvm.lux +++ b/new-luxc/source/luxc/compiler/expr.jvm.lux @@ -5,7 +5,8 @@ [macro #+ Monad<Lux> "Lux/" Monad<Lux>] [host #+ jvm-import]) (luxc ["&" base] - (lang ["ls" synthesis]) + (lang ["la" analysis] + ["ls" synthesis]) ["&;" analyser] ["&;" synthesizer] (compiler ["&;" common]))) diff --git a/new-luxc/source/luxc/compiler/runtime.jvm.lux b/new-luxc/source/luxc/compiler/runtime.jvm.lux index 4a5e44785..16e072194 100644 --- a/new-luxc/source/luxc/compiler/runtime.jvm.lux +++ b/new-luxc/source/luxc/compiler/runtime.jvm.lux @@ -3,9 +3,9 @@ (lux (control monad) (concurrency ["P" promise "P/" Monad<Promise>]) (data text/format - ["E" error])) + ["R" result])) (luxc ["&" base])) (def: #export (compile-runtime compiler) - (-> Compiler (P;Promise (E;Error Compiler))) - (P/wrap (#E;Success compiler))) + (-> Compiler (P;Promise (R;Result Compiler))) + (P/wrap (#R;Success compiler))) diff --git a/new-luxc/source/luxc/compiler/statement.jvm.lux b/new-luxc/source/luxc/compiler/statement.jvm.lux index 7e48d061f..96263181f 100644 --- a/new-luxc/source/luxc/compiler/statement.jvm.lux +++ b/new-luxc/source/luxc/compiler/statement.jvm.lux @@ -2,8 +2,7 @@ lux (lux (control monad) [io #- run] - (data ["E" error] - [text "T/" Eq<Text>] + (data [text "T/" Eq<Text>] text/format) [macro #+ Monad<Lux>]) (luxc ["&" base] diff --git a/new-luxc/source/luxc/env.lux b/new-luxc/source/luxc/env.lux index 8c056f1c3..edc6a4a5b 100644 --- a/new-luxc/source/luxc/env.lux +++ b/new-luxc/source/luxc/env.lux @@ -5,7 +5,7 @@ text/format [maybe #+ Monad<Maybe> "Maybe/" Monad<Maybe>] [product] - ["E" error] + ["R" result] (coll [list "L/" Fold<List> Monoid<List>])) [macro]) (luxc ["&" base])) @@ -89,22 +89,22 @@ head)] (case (macro;run' (set@ #;scopes (#;Cons new-head tail) compiler) action) - (#E;Success [compiler' output]) + (#R;Success [compiler' output]) (case (get@ #;scopes compiler') (#;Cons head' tail') (let [scopes' (#;Cons (set@ #;locals (get@ #;locals head) head') tail')] - (#E;Success [(set@ #;scopes scopes' compiler') + (#R;Success [(set@ #;scopes scopes' compiler') output])) _ (error! "Invalid scope alteration.")) - (#E;Error error) - (#E;Error error))) + (#R;Error error) + (#R;Error error))) _ - (#E;Error "Cannot create local binding without a scope.")) + (#R;Error "Cannot create local binding without a scope.")) )) (do-template [<name> <val-type>] @@ -136,11 +136,11 @@ (case (action (update@ #;scopes (|>. (#;Cons (scope parent-name name))) compiler)) - (#E;Error error) - (#E;Error error) + (#R;Error error) + (#R;Error error) - (#E;Success [compiler' output]) - (#E;Success [(update@ #;scopes + (#R;Success [compiler' output]) + (#R;Success [(update@ #;scopes (|>. list;tail (default (list))) compiler') output]) diff --git a/new-luxc/source/luxc/io.jvm.lux b/new-luxc/source/luxc/io.jvm.lux index 18142e77a..cb37c69a9 100644 --- a/new-luxc/source/luxc/io.jvm.lux +++ b/new-luxc/source/luxc/io.jvm.lux @@ -3,7 +3,7 @@ (lux (control monad) [io #- run] (concurrency ["P" promise]) - (data ["E" error] + (data ["R" result] [text "T/" Eq<Text>] text/format) [macro] @@ -45,26 +45,26 @@ (recur source-dirs')))))) (def: (read-source-code lux-file) - (-> File (P;Promise (E;Error Text))) + (-> File (P;Promise (R;Result Text))) (P;future (let [reader (|> lux-file FileReader.new BufferedReader.new)] (loop [total ""] (do Monad<IO> [?line (BufferedReader.readLine [] reader)] (case ?line - (#E;Error error) - (wrap (#E;Error error)) + (#R;Error error) + (wrap (#R;Error error)) - (#E;Success #;None) - (wrap (#E;Success total)) + (#R;Success #;None) + (wrap (#R;Success total)) - (#E;Success (#;Some line)) + (#R;Success (#;Some line)) (if (T/= "" total) (recur line) (recur (format total "\n" line))))))))) (def: #export (read-module source-dirs module-name) - (-> (List &;Path) Text (P;Promise (E;Error [&;Path Text]))) + (-> (List &;Path) Text (P;Promise (R;Result [&;Path Text]))) (let [host-path (format module-name host-extension ".lux") lux-path (format module-name ".lux")] (with-expansions @@ -76,18 +76,18 @@ (do @ [?code (read-source-code file)] (case ?code - (#E;Error error) - (wrap (#E;Error error)) + (#R;Error error) + (wrap (#R;Error error)) - (#E;Success code) - (wrap (#E;Success [<path> code])))) + (#R;Success code) + (wrap (#R;Success [<path> code])))) #;None)] [host-path] [lux-path])] (<| <tries> - (wrap (#E;Error (format "Module cannot be found: " module-name))))))) + (wrap (#R;Error (format "Module cannot be found: " module-name))))))) (def: #export (write-module module-name module-descriptor) (-> Text Text (P;Promise Unit)) diff --git a/new-luxc/source/luxc/lang/synthesis.lux b/new-luxc/source/luxc/lang/synthesis.lux index 00cccfbe6..3eabd1d62 100644 --- a/new-luxc/source/luxc/lang/synthesis.lux +++ b/new-luxc/source/luxc/lang/synthesis.lux @@ -13,9 +13,9 @@ (#Text Text) (#Variant Nat Bool Synthesis) (#Tuple (List Synthesis)) - (#Case (lp;Pattern Synthesis)) + (#Case (List [lp;Pattern Synthesis])) (#Function Scope Synthesis) (#Call Synthesis (List Synthesis)) - (#Procedure Text (List Synthesis)) + (#Procedure Ident (List Synthesis)) (#Relative Ref) (#Absolute Ident)) diff --git a/new-luxc/source/luxc/module.lux b/new-luxc/source/luxc/module.lux index 1e6174143..237fda3b9 100644 --- a/new-luxc/source/luxc/module.lux +++ b/new-luxc/source/luxc/module.lux @@ -3,7 +3,7 @@ (lux (control monad) (data [text "T/" Eq<Text>] text/format - ["E" error])) + ["R" result])) (luxc ["&" base])) (def: (new-module hash) @@ -25,7 +25,7 @@ (#;Some module) (case (&;pl-get def-name (get@ #;defs module)) #;None - (#E;Success [(update@ #;modules + (#R;Success [(update@ #;modules (&;pl-put module-name (update@ #;defs (: (-> (List [Text Def]) (List [Text Def])) @@ -35,16 +35,16 @@ []]) (#;Some already-existing) - (#E;Error (format "Cannot re-define definiton: " (%ident full-name)))) + (#R;Error (format "Cannot re-define definiton: " (%ident full-name)))) #;None - (#E;Error (format "Cannot define in unknown module: " module-name))))) + (#R;Error (format "Cannot define in unknown module: " module-name))))) (def: #export (create hash name) (-> Nat Text (Lux Module)) (function [compiler] (let [module (new-module hash)] - (#E;Success [(update@ #;modules + (#R;Success [(update@ #;modules (&;pl-put name module) compiler) module])))) @@ -59,26 +59,26 @@ #;Active true _ false)] (if active? - (#E;Success [(update@ #;modules + (#R;Success [(update@ #;modules (&;pl-put module-name (set@ #;module-state <tag> module)) compiler) []]) - (#E;Error "Can only change the state of a currently-active module."))) + (#R;Error "Can only change the state of a currently-active module."))) #;None - (#E;Error (format "Module does not exist: " module-name))))) + (#R;Error (format "Module does not exist: " module-name))))) (def: #export (<asker> module-name) (-> Text (Lux Bool)) (function [compiler] (case (|> compiler (get@ #;modules) (&;pl-get module-name)) (#;Some module) - (#E;Success [compiler + (#R;Success [compiler (case (get@ #;module-state module) <tag> true _ false)]) #;None - (#E;Error (format "Module does not exist: " module-name))) + (#R;Error (format "Module does not exist: " module-name))) ))] [flag-active! active? #;Active] diff --git a/new-luxc/source/luxc/module/descriptor/type.lux b/new-luxc/source/luxc/module/descriptor/type.lux index d661aa385..dd11a163f 100644 --- a/new-luxc/source/luxc/module/descriptor/type.lux +++ b/new-luxc/source/luxc/module/descriptor/type.lux @@ -7,7 +7,7 @@ ["l" lexer "l/" Monad<Lexer>]) [char] [number] - error + ["R" result] (coll [list "L/" Functor<List>])) [type "Type/" Eq<Type>]) ["&" ../common]) @@ -136,7 +136,7 @@ ))))) (def: (decode-type input) - (-> Text (Error Type)) + (-> Text (R;Result Type)) (|> type-decoder (l;before l;end) (l;run input))) diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux index d76050860..5cd6299fc 100644 --- a/new-luxc/source/luxc/parser.lux +++ b/new-luxc/source/luxc/parser.lux @@ -31,7 +31,7 @@ (data [bool] [char] [text] - ["E" error #*] + ["R" result] [number] (text ["l" lexer #+ Lexer Monad<Lexer> "l/" Monad<Lexer>] format) @@ -549,10 +549,10 @@ ))) (def: #export (parse [where code]) - (-> [Cursor Text] (Error [[Cursor Text] Code])) + (-> [Cursor Text] (R;Result [[Cursor Text] Code])) (case (l;run' code (parse-ast where)) - (#E;Error error) - (#E;Error error) + (#R;Error error) + (#R;Error error) - (#E;Success [remaining [where' output]]) - (#E;Success [[where' remaining] output]))) + (#R;Success [remaining [where' output]]) + (#R;Success [[where' remaining] output]))) diff --git a/new-luxc/source/luxc/synthesizer.lux b/new-luxc/source/luxc/synthesizer.lux index c0aaec6ad..d2f559c3e 100644 --- a/new-luxc/source/luxc/synthesizer.lux +++ b/new-luxc/source/luxc/synthesizer.lux @@ -13,7 +13,7 @@ (-> Analysis Synthesis) (case analysis (^template [<from> <to>] - [meta (<from> value)] + (<from> value) (<to> value)) ([#la;Unit #ls;Unit] [#la;Bool #ls;Bool] @@ -26,20 +26,21 @@ [#la;Relative #ls;Relative] [#la;Absolute #ls;Absolute]) - [meta (#la;Tuple values)] + (#la;Tuple values) (#ls;Tuple (L/map synthesize values)) - [meta (#la;Variant tag last? value)] - (#ls;Variant tag last? (synthesize value)) + (#la;Variant tag last? value) + (undefined) - [meta (#la;Function scope body)] - (#ls;Function scope (synthesize body)) + (#la;Case pattern) + (undefined) - [meta (#la;Call func args)] - (#ls;Call (synthesize func) (L/map synthesize args)) + (#la;Function scope body) + (undefined) + + (#la;Apply arg func) + (undefined) - [meta (#la;Procedure name args)] + (#la;Procedure name args) (#ls;Procedure name (L/map synthesize args)) - - [meta (#la;Case pattern)] - (undefined))) + )) diff --git a/new-luxc/test/test/luxc/analyser/primitive.lux b/new-luxc/test/test/luxc/analyser/primitive.lux index 321a51fcb..6053e2fd7 100644 --- a/new-luxc/test/test/luxc/analyser/primitive.lux +++ b/new-luxc/test/test/luxc/analyser/primitive.lux @@ -9,10 +9,10 @@ (text format ["l" lexer]) [number] - ["E" error] + ["R" result] [product] (coll [list "L/" Functor<List> Fold<List>])) - ["R" math/random "R/" Monad<Random>] + ["r" math/random "R/" Monad<Random>] [type "Type/" Eq<Type>] [macro #+ Monad<Lux>] (macro [code]) @@ -27,20 +27,20 @@ (.. common)) (test: "Simple primitives" - [%bool% R;bool - %nat% R;nat - %int% R;int - %deg% R;deg - %real% R;real - %char% R;char - %text% (R;text +5)] + [%bool% r;bool + %nat% r;nat + %int% r;int + %deg% r;deg + %real% r;real + %char% r;char + %text% (r;text +5)] (with-expansions [<primitives> (do-template [<desc> <type> <tag> <value> <analyser>] [(assert (format "Can analyse " <desc> ".") (|> (@common;with-unknown-type (<analyser> <value>)) (macro;run init-compiler) - (case> (#E;Success [_type (<tag> value)]) + (case> (#R;Success [_type (<tag> value)]) (and (Type/= <type> _type) (is <value> value)) diff --git a/new-luxc/test/test/luxc/analyser/reference.lux b/new-luxc/test/test/luxc/analyser/reference.lux index 4e83a7af8..4b4355178 100644 --- a/new-luxc/test/test/luxc/analyser/reference.lux +++ b/new-luxc/test/test/luxc/analyser/reference.lux @@ -3,8 +3,8 @@ (lux [io] (control monad pipe) - (data ["E" error]) - ["R" math/random "R/" Monad<Random>] + (data ["R" result]) + ["r" math/random "R/" Monad<Random>] [type "Type/" Eq<Type>] [macro #+ Monad<Lux>] test) @@ -18,9 +18,9 @@ (test: "References" [[ref-type _] gen-simple-primitive - module-name (R;text +5) - scope-name (R;text +5) - var-name (R;text +5)] + module-name (r;text +5) + scope-name (r;text +5) + var-name (r;text +5)] ($_ seq (assert "Can analyse relative reference." (|> (&env;with-scope scope-name @@ -28,7 +28,7 @@ (@common;with-unknown-type (@;analyse-reference ["" var-name])))) (macro;run init-compiler) - (case> (#E;Success [_type (#~;Relative idx)]) + (case> (#R;Success [_type (#~;Relative idx)]) (Type/= ref-type _type) _ @@ -41,7 +41,7 @@ (@common;with-unknown-type (@;analyse-reference [module-name var-name]))) (macro;run init-compiler) - (case> (#E;Success [_type (#~;Absolute idx)]) + (case> (#R;Success [_type (#~;Absolute idx)]) (Type/= ref-type _type) _ diff --git a/new-luxc/test/test/luxc/analyser/struct.lux b/new-luxc/test/test/luxc/analyser/struct.lux index a86f6da9c..869b2b0d1 100644 --- a/new-luxc/test/test/luxc/analyser/struct.lux +++ b/new-luxc/test/test/luxc/analyser/struct.lux @@ -3,10 +3,10 @@ (lux [io] (control monad pipe) - (data ["E" error] + (data ["R" result] [product] (coll [list "L/" Functor<List>])) - ["R" math/random "R/" Monad<Random>] + ["r" math/random "R/" Monad<Random>] [type "Type/" Eq<Type>] [macro #+ Monad<Lux>] test) @@ -22,14 +22,14 @@ (analyser;analyser (:!! []))) (test: "Tuples" - [size (|> R;nat (:: @ map (|>. (n.% +10) (n.max +2)))) - primitives (R;list size gen-simple-primitive)] + [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) + primitives (r;list size gen-simple-primitive)] ($_ seq (assert "Can analyse tuple." (|> (@common;with-unknown-type (@;analyse-tuple analyse (L/map product;right primitives))) (macro;run init-compiler) - (case> (#E;Success [_type (#~;Tuple elems)]) + (case> (#R;Success [_type (#~;Tuple elems)]) (and (Type/= (type;tuple (L/map product;left primitives)) _type) (n.= size (list;size elems))) diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux index 5218bb926..f6ee8ea72 100644 --- a/new-luxc/test/test/luxc/parser.lux +++ b/new-luxc/test/test/luxc/parser.lux @@ -7,9 +7,9 @@ (text format ["l" lexer]) [number] - ["E" error] + ["R" result] (coll [list])) - ["R" math/random "R/" Monad<Random>] + ["r" math/random "r/" Monad<Random>] (macro [code]) test) (luxc ["&" parser])) @@ -21,103 +21,103 @@ #;column +0}) (def: ident-part^ - (R;Random Text) - (do R;Monad<Random> + (r;Random Text) + (do r;Monad<Random> [#let [digits "0123456789" delimiters "()[]{}#;" space "\t\v \n\r\f" invalid-range (format digits delimiters space) - char-gen (|> R;char - (R;filter (function [sample] + char-gen (|> r;char + (r;filter (function [sample] (not (text;contains? (char;as-text sample) invalid-range)))))] - size (|> R;nat (:: @ map (|>. (n.% +20) (n.max +1))))] - (R;text' char-gen size))) + size (|> r;nat (:: @ map (|>. (n.% +20) (n.max +1))))] + (r;text' char-gen size))) (def: ident^ - (R;Random Ident) - (R;seq ident-part^ ident-part^)) + (r;Random Ident) + (r;seq ident-part^ ident-part^)) (def: ast^ - (R;Random Code) - (let [numeric^ (: (R;Random Code) - ($_ R;either - (|> R;bool (R/map (|>. #;Bool [default-cursor]))) - (|> R;nat (R/map (|>. #;Nat [default-cursor]))) - (|> R;int (R/map (|>. #;Int [default-cursor]))) - (|> R;deg (R/map (|>. #;Deg [default-cursor]))) - (|> R;real (R/map (|>. #;Real [default-cursor]))))) - textual^ (: (R;Random Code) - ($_ R;either - (|> R;char (R/map (|>. #;Char [default-cursor]))) - (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +20)))] - (|> (R;text size) (R/map (|>. #;Text [default-cursor])))) - (|> ident^ (R/map (|>. #;Symbol [default-cursor]))) - (|> ident^ (R/map (|>. #;Tag [default-cursor]))))) - simple^ (: (R;Random Code) - ($_ R;either + (r;Random Code) + (let [numeric^ (: (r;Random Code) + ($_ r;either + (|> r;bool (r/map (|>. #;Bool [default-cursor]))) + (|> r;nat (r/map (|>. #;Nat [default-cursor]))) + (|> r;int (r/map (|>. #;Int [default-cursor]))) + (|> r;deg (r/map (|>. #;Deg [default-cursor]))) + (|> r;real (r/map (|>. #;Real [default-cursor]))))) + textual^ (: (r;Random Code) + ($_ r;either + (|> r;char (r/map (|>. #;Char [default-cursor]))) + (do r;Monad<Random> + [size (|> r;nat (r/map (n.% +20)))] + (|> (r;text size) (r/map (|>. #;Text [default-cursor])))) + (|> ident^ (r/map (|>. #;Symbol [default-cursor]))) + (|> ident^ (r/map (|>. #;Tag [default-cursor]))))) + simple^ (: (r;Random Code) + ($_ r;either numeric^ textual^))] - (R;rec + (r;rec (function [ast^] - (let [multi^ (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +3)))] - (R;list size ast^)) - composite^ (: (R;Random Code) - ($_ R;either - (|> multi^ (R/map (|>. #;Form [default-cursor]))) - (|> multi^ (R/map (|>. #;Tuple [default-cursor]))) - (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +3)))] - (|> (R;list size (R;seq ast^ ast^)) - (R/map (|>. #;Record [default-cursor]))))))] - (R;either simple^ + (let [multi^ (do r;Monad<Random> + [size (|> r;nat (r/map (n.% +3)))] + (r;list size ast^)) + composite^ (: (r;Random Code) + ($_ r;either + (|> multi^ (r/map (|>. #;Form [default-cursor]))) + (|> multi^ (r/map (|>. #;Tuple [default-cursor]))) + (do r;Monad<Random> + [size (|> r;nat (r/map (n.% +3)))] + (|> (r;list size (r;seq ast^ ast^)) + (r/map (|>. #;Record [default-cursor]))))))] + (r;either simple^ composite^)))))) (test: "Lux code parser." [sample ast^] (assert "Can parse Lux code." (case (&;parse [default-cursor (code;to-text sample)]) - (#E;Error error) + (#R;Error error) false - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) (:: code;Eq<Code> = parsed sample)) )) (def: comment-text^ - (R;Random Text) - (let [char-gen (|> R;char (R;filter (function [value] + (r;Random Text) + (let [char-gen (|> r;char (r;filter (function [value] (not (or (char;space? value) (C/= #"\n" value) (C/= #"#" value) (C/= #"(" value) (C/= #")" value))))))] - (do R;Monad<Random> - [size (|> R;nat (R/map (n.% +20)))] - (R;text' char-gen size)))) + (do r;Monad<Random> + [size (|> r;nat (r/map (n.% +20)))] + (r;text' char-gen size)))) (def: comment^ - (R;Random Text) - (R;either (do R;Monad<Random> + (r;Random Text) + (r;either (do r;Monad<Random> [comment comment-text^] (wrap (format "## " comment "\n"))) - (R;rec (function [nested^] - (do R;Monad<Random> - [comment (R;either comment-text^ + (r;rec (function [nested^] + (do r;Monad<Random> + [comment (r;either comment-text^ nested^)] (wrap (format "#( " comment " )#"))))))) (test: "Multi-line text & comments." - [#let [char-gen (|> R;char (R;filter (function [value] + [#let [char-gen (|> r;char (r;filter (function [value] (not (or (char;space? value) (C/= #"\"" value) (C/= #"\n" value))))))] x char-gen y char-gen z char-gen - offset-size (|> R;nat (R/map (|>. (n.% +10) (n.max +1)))) + offset-size (|> r;nat (r/map (|>. (n.% +10) (n.max +1)))) #let [offset (text;join-with "" (list;repeat offset-size " "))] sample ast^ comment comment^ @@ -129,10 +129,10 @@ (char;as-text z))] (case (&;parse [default-cursor (format "\"" bad-match "\"")]) - (#E;Error error) + (#R;Error error) true - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) false))) (assert "Will accept valid multi-line text" (let [good-input (format (char;as-text x) "\n" @@ -144,36 +144,36 @@ (case (&;parse [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size)))) (format "\"" good-input "\"")]) - (#E;Error error) + (#R;Error error) false - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) (:: code;Eq<Code> = parsed (code;text good-output))))) (assert "Can handle comments." (case (&;parse [default-cursor (format comment (code;to-text sample))]) - (#E;Error error) + (#R;Error error) false - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) (:: code;Eq<Code> = parsed sample))) (assert "Will reject unbalanced multi-line comments." (and (case (&;parse [default-cursor (format "#(" "#(" unbalanced-comment ")#" (code;to-text sample))]) - (#E;Error error) + (#R;Error error) true - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) false) (case (&;parse [default-cursor (format "#(" unbalanced-comment ")#" ")#" (code;to-text sample))]) - (#E;Error error) + (#R;Error error) true - (#E;Success [_ parsed]) + (#R;Success [_ parsed]) false))) )) 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]))) diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux index a4c69a880..a92c2c376 100644 --- a/stdlib/test/test/lux/concurrency/actor.lux +++ b/stdlib/test/test/lux/concurrency/actor.lux @@ -4,7 +4,7 @@ (control monad) (data [number] text/format - [error #- fail]) + ["R" result]) (concurrency [promise #+ Promise Monad<Promise> "Promise/" Monad<Promise>] ["&" actor #+ actor:])) lux/test) diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux index a141753a8..245428f38 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/concurrency/frp.lux @@ -3,8 +3,7 @@ (lux [io #- run] (control monad) (data [number] - text/format - [error #- fail]) + text/format) (concurrency [promise #+ Promise Monad<Promise> "Promise/" Monad<Promise>] ["&" frp])) lux/test) diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux index 7ad25fc46..8c4e623e4 100644 --- a/stdlib/test/test/lux/concurrency/promise.lux +++ b/stdlib/test/test/lux/concurrency/promise.lux @@ -4,8 +4,7 @@ (control monad pipe) (data [number] - text/format - [error #- fail]) + text/format) (concurrency ["&" promise]) ["R" math/random]) lux/test) diff --git a/stdlib/test/test/lux/control/exception.lux b/stdlib/test/test/lux/control/exception.lux index 80267cedd..bef3ae4cd 100644 --- a/stdlib/test/test/lux/control/exception.lux +++ b/stdlib/test/test/lux/control/exception.lux @@ -3,7 +3,7 @@ (lux [io] (control monad ["&" exception #+ exception:]) - (data [error #- fail] + (data ["E" result] [text] text/format [number]) @@ -36,7 +36,7 @@ another-val) otherwise-val) default-val) - actual (|> (: (Error Nat) + actual (|> (: (E;Result Nat) (if should-throw? (&;throw this-ex "Uh-oh...") (&;return default-val))) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index 7acddf750..b52b72635 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -7,7 +7,7 @@ pipe) (data [text "Text/" Monoid<Text>] text/format - [error #- fail] + [result] [bool] [char] [maybe] diff --git a/stdlib/test/test/lux/data/error.lux b/stdlib/test/test/lux/data/result.lux index d90387c89..aee931279 100644 --- a/stdlib/test/test/lux/data/error.lux +++ b/stdlib/test/test/lux/data/result.lux @@ -4,18 +4,18 @@ (control monad pipe) (data text/format - ["&" error])) + ["&" result])) lux/test) -(test: "Errors" - (let [(^open "&/") &;Monad<Error>] +(test: "Results" + (let [(^open "&/") &;Monad<Result>] ($_ seq (assert "Functor correctly handles both cases." - (and (|> (: (&;Error Int) (#&;Success 10)) + (and (|> (: (&;Result Int) (#&;Success 10)) (&/map i.inc) (case> (#&;Success 11) true _ false)) - (|> (: (&;Error Int) (#&;Error "YOLO")) + (|> (: (&;Result Int) (#&;Error "YOLO")) (&/map i.inc) (case> (#&;Error "YOLO") true _ false)) )) @@ -29,13 +29,13 @@ (case> (#&;Error "YOLO") true _ false)))) (assert "Monad correctly handles both cases." - (and (|> (do &;Monad<Error> + (and (|> (do &;Monad<Result> [f (wrap i.+) a (wrap 10) b (wrap 20)] (wrap (f a b))) (case> (#&;Success 30) true _ false)) - (|> (do &;Monad<Error> + (|> (do &;Monad<Result> [f (wrap i.+) a (#&;Error "YOLO") b (wrap 20)] @@ -45,10 +45,10 @@ ))) (test: "Monad transformer" - (let [lift (&;lift-error io;Monad<IO>) + (let [lift (&;lift-result io;Monad<IO>) (^open "io/") io;Monad<IO>] - (assert "Can add error functionality to any monad." - (|> (io;run (do (&;ErrorT io;Monad<IO>) + (assert "Can add result functionality to any monad." + (|> (io;run (do (&;ResultT io;Monad<IO>) [a (lift (io/wrap 123)) b (wrap 456)] (wrap (i.+ a b)))) diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux index 8a63cf573..f9b6bdc79 100644 --- a/stdlib/test/test/lux/data/text/lexer.lux +++ b/stdlib/test/test/lux/data/text/lexer.lux @@ -3,7 +3,7 @@ (lux (control monad pipe) [io] - (data [error #- fail] + (data ["E" result] [text "T/" Eq<Text>] text/format ["&" text/lexer] @@ -14,13 +14,13 @@ ## [Utils] (def: (should-fail input) - (All [a] (-> (Error a) Bool)) + (All [a] (-> (E;Result a) Bool)) (case input (#;Left _) true _ false)) (def: (should-passC test input) - (-> Char (Error Char) Bool) + (-> Char (E;Result Char) Bool) (case input (#;Right output) (C/= test output) @@ -29,7 +29,7 @@ false)) (def: (should-passT test input) - (-> Text (Error Text) Bool) + (-> Text (E;Result Text) Bool) (case input (#;Right output) (T/= test output) @@ -38,7 +38,7 @@ false)) (def: (should-passL test input) - (-> (List Char) (Error (List Char)) Bool) + (-> (List Char) (E;Result (List Char)) Bool) (let [(^open "L/") (list;Eq<List> char;Eq<Char>)] (case input (#;Right output) @@ -48,7 +48,7 @@ false))) (def: (should-passE test input) - (-> (Either Char Char) (Error (Either Char Char)) Bool) + (-> (Either Char Char) (E;Result (Either Char Char)) Bool) (case input (#;Right output) (case [test output] diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index 62953b20b..e4cfa2e10 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -3,8 +3,7 @@ (lux [io] (control monad pipe) - (data [error #- fail] - [product] + (data [product] [text "T/" Eq<Text>] text/format (text [lexer] diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index f75a7117e..0badc67f3 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -9,7 +9,7 @@ [bool] [char] [ident] - [error #- fail]) + ["E" result]) ["R" math/random] [macro] (macro [code] @@ -45,7 +45,7 @@ false)) (def: (fails? input) - (All [a] (-> (Error a) Bool)) + (All [a] (-> (E;Result a) Bool)) (case input (#;Left _) true diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index b3eaeb22c..b55373330 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -25,7 +25,7 @@ (data ["_;" bit] ["_;" bool] ["_;" char] - ["_;" error] + ["_;" result] ["_;" ident] ["_;" identity] ["_;" log] |