diff options
Diffstat (limited to '')
22 files changed, 288 insertions, 271 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))) )) |