diff options
Diffstat (limited to 'new-luxc/source/luxc')
| -rw-r--r-- | new-luxc/source/luxc/analyser.lux | 132 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/function.lux | 3 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/proc.lux | 3 | ||||
| -rw-r--r-- | new-luxc/source/luxc/analyser/struct.lux | 3 | ||||
| -rw-r--r-- | new-luxc/source/luxc/base.lux | 56 | ||||
| -rw-r--r-- | new-luxc/source/luxc/compiler.lux | 40 | ||||
| -rw-r--r-- | new-luxc/source/luxc/compiler/base.jvm.lux | 3 | ||||
| -rw-r--r-- | new-luxc/source/luxc/compiler/common.jvm.lux | 22 | ||||
| -rw-r--r-- | new-luxc/source/luxc/compiler/expr.jvm.lux | 3 | ||||
| -rw-r--r-- | new-luxc/source/luxc/compiler/runtime.jvm.lux | 6 | ||||
| -rw-r--r-- | new-luxc/source/luxc/compiler/statement.jvm.lux | 3 | ||||
| -rw-r--r-- | new-luxc/source/luxc/env.lux | 20 | ||||
| -rw-r--r-- | new-luxc/source/luxc/io.jvm.lux | 26 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/synthesis.lux | 4 | ||||
| -rw-r--r-- | new-luxc/source/luxc/module.lux | 20 | ||||
| -rw-r--r-- | new-luxc/source/luxc/module/descriptor/type.lux | 4 | ||||
| -rw-r--r-- | new-luxc/source/luxc/parser.lux | 12 | ||||
| -rw-r--r-- | new-luxc/source/luxc/synthesizer.lux | 25 |
18 files changed, 201 insertions, 184 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))) + )) |