diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase')
17 files changed, 161 insertions, 166 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis.lux b/stdlib/source/lux/tool/compiler/phase/analysis.lux index 9281046c1..fbdb18f16 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis.lux @@ -5,7 +5,6 @@ [control ["ex" exception (#+ exception:)]] [data - ["." error] [text ["%" format (#+ format)]]] ["." macro]] diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux index 85be37a90..dd45ab734 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/case.lux @@ -3,10 +3,10 @@ [abstract ["." monad (#+ do)]] [control + ["." try] ["ex" exception (#+ exception:)]] [data ["." product] - ["." error] ["." maybe] [text ["%" format (#+ format)]] @@ -304,12 +304,12 @@ branchesT) outputHC (|> outputH product.left /coverage.determine) outputTC (monad.map @ (|>> product.left /coverage.determine) outputT) - _ (.case (monad.fold error.monad /coverage.merge outputHC outputTC) - (#error.Success coverage) + _ (.case (monad.fold try.monad /coverage.merge outputHC outputTC) + (#try.Success coverage) (///.assert non-exhaustive-pattern-matching [inputC branches coverage] (/coverage.exhaustive? coverage)) - (#error.Failure error) + (#try.Failure error) (/.fail error))] (wrap (#/.Case inputA [outputH outputT]))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux index 067ce0972..af43a0e53 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/case/coverage.lux @@ -4,10 +4,10 @@ equivalence ["." monad (#+ do)]] [control + ["." try (#+ Try) ("#@." monad)] ["ex" exception (#+ exception:)]] [data ["." bit ("#@." equivalence)] - ["." error (#+ Error) ("#@." monad)] ["." maybe] [number ["." nat]] @@ -214,15 +214,15 @@ ## pattern-matching expression is exhaustive and whether it contains ## redundant patterns. (def: #export (merge addition so-far) - (-> Coverage Coverage (Error Coverage)) + (-> Coverage Coverage (Try Coverage)) (case [addition so-far] [#Partial #Partial] - (error@wrap #Partial) + (try@wrap #Partial) ## 2 bit coverages are exhaustive if they complement one another. (^multi [(#Bit sideA) (#Bit sideSF)] (xor sideA sideSF)) - (error@wrap #Exhaustive) + (try@wrap #Exhaustive) [(#Variant allA casesA) (#Variant allSF casesSF)] (let [addition-cases (cases allSF) @@ -236,7 +236,7 @@ (ex.throw redundant-pattern [so-far addition]) ## else - (do error.monad + (do try.monad [casesM (monad.fold @ (function (_ [tagA coverageA] casesSF') (case (dictionary.get tagA casesSF') @@ -266,7 +266,7 @@ (case [(coverage/= leftSF leftA) (coverage/= rightSF rightA)] ## Same prefix [#1 #0] - (do error.monad + (do try.monad [rightM (merge rightA rightSF)] (if (exhaustive? rightM) ## If all that follows is exhaustive, then it can be safely dropped @@ -277,13 +277,13 @@ ## Same suffix [#0 #1] - (do error.monad + (do try.monad [leftM (merge leftA leftSF)] (wrap (#Seq leftM rightA))) ## The 2 sequences cannot possibly be merged. [#0 #0] - (error@wrap (#Alt so-far addition)) + (try@wrap (#Alt so-far addition)) ## There is nothing the addition adds to the coverage. [#1 #1] @@ -295,7 +295,7 @@ ## The addition completes the coverage. [#Exhaustive _] - (error@wrap #Exhaustive) + (try@wrap #Exhaustive) ## The left part will always match, so the addition is redundant. (^multi [(#Seq left right) single] @@ -305,7 +305,7 @@ ## The right part is not necessary, since it can always match the left. (^multi [single (#Seq left right)] (coverage/= left single)) - (error@wrap single) + (try@wrap single) ## When merging a new coverage against one based on Alt, it may be ## that one of the many coverages in the Alt is complementary to @@ -317,10 +317,10 @@ ## This process must be repeated until no further productive ## merges can be done. [_ (#Alt leftS rightS)] - (do error.monad + (do try.monad [#let [fuse-once (: (-> Coverage (List Coverage) - (Error [(Maybe Coverage) - (List Coverage)])) + (Try [(Maybe Coverage) + (List Coverage)])) (function (_ coverageA possibilitiesSF) (loop [altsSF possibilitiesSF] (case altsSF @@ -329,7 +329,7 @@ (#.Cons altSF altsSF') (case (merge coverageA altSF) - (#error.Success altMSF) + (#try.Success altMSF) (case altMSF (#Alt _) (do @ @@ -339,8 +339,8 @@ _ (wrap [(#.Some altMSF) altsSF'])) - (#error.Failure error) - (error.fail error)) + (#try.Failure error) + (try.fail error)) ))))] [successA possibilitiesSF] (fuse-once addition (flatten-alt so-far))] (loop [successA successA @@ -366,4 +366,4 @@ ## The addition cannot possibly improve the coverage. (ex.throw redundant-pattern [so-far addition]) ## There are now 2 alternative paths. - (error@wrap (#Alt so-far addition))))) + (try@wrap (#Alt so-far addition))))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux index c6280e4b3..bb1094b2a 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux @@ -4,11 +4,11 @@ ["." monad (#+ do)]] [control pipe + ["." try] ["ex" exception (#+ exception:)]] [data ["." text ("#@." equivalence) ["%" format (#+ format)]] - ["." error] [collection ["." list ("#@." fold functor)] [dictionary @@ -72,10 +72,10 @@ (case (get@ #.module-annotations self) #.None (function (_ state) - (#error.Success [(update@ #.modules - (plist.put self-name (set@ #.module-annotations (#.Some annotations) self)) - state) - []])) + (#try.Success [(update@ #.modules + (plist.put self-name (set@ #.module-annotations (#.Some annotations) self)) + state) + []])) (#.Some old) (/.throw' cannot-set-module-annotations-more-than-once [self-name old annotations]))))) @@ -86,14 +86,14 @@ (do ///.monad [self-name macro.current-module-name] (function (_ state) - (#error.Success [(update@ #.modules - (plist.update self-name (update@ #.imports (function (_ current) - (if (list.any? (text@= module) - current) - current - (#.Cons module current))))) - state) - []]))))) + (#try.Success [(update@ #.modules + (plist.update self-name (update@ #.imports (function (_ current) + (if (list.any? (text@= module) + current) + current + (#.Cons module current))))) + state) + []]))))) (def: #export (alias alias module) (-> Text Text (Operation Any)) @@ -101,11 +101,11 @@ (do ///.monad [self-name macro.current-module-name] (function (_ state) - (#error.Success [(update@ #.modules - (plist.update self-name (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text])) - (|>> (#.Cons [alias module]))))) - state) - []]))))) + (#try.Success [(update@ #.modules + (plist.update self-name (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text])) + (|>> (#.Cons [alias module]))))) + state) + []]))))) (def: #export (exists? module) (-> Text (Operation Bit)) @@ -115,7 +115,7 @@ (get@ #.modules) (plist.get module) (case> (#.Some _) #1 #.None #0) - [state] #error.Success)))) + [state] #try.Success)))) (def: #export (define name definition) (-> Text Global (Operation Any)) @@ -126,14 +126,14 @@ (function (_ state) (case (plist.get name (get@ #.definitions self)) #.None - (#error.Success [(update@ #.modules - (plist.put self-name - (update@ #.definitions - (: (-> (List [Text Global]) (List [Text Global])) - (|>> (#.Cons [name definition]))) - self)) - state) - []]) + (#try.Success [(update@ #.modules + (plist.put self-name + (update@ #.definitions + (: (-> (List [Text Global]) (List [Text Global])) + (|>> (#.Cons [name definition]))) + self)) + state) + []]) (#.Some already-existing) ((/.throw' cannot-define-more-than-once [self-name name]) state)))))) @@ -143,10 +143,10 @@ (///extension.lift (function (_ state) (let [module (new hash)] - (#error.Success [(update@ #.modules - (plist.put name module) - state) - []]))))) + (#try.Success [(update@ #.modules + (plist.put name module) + state) + []]))))) (def: #export (with-module hash name action) (All [a] (-> Nat Text (Operation a) (Operation [Module a]))) @@ -168,10 +168,10 @@ #.Active #1 _ #0)] (if active? - (#error.Success [(update@ #.modules - (plist.put module-name (set@ #.module-state <tag> module)) - state) - []]) + (#try.Success [(update@ #.modules + (plist.put module-name (set@ #.module-state <tag> module)) + state) + []]) ((/.throw' can-only-change-state-of-active-module [module-name <tag>]) state))) @@ -184,10 +184,10 @@ (function (_ state) (case (|> state (get@ #.modules) (plist.get module-name)) (#.Some module) - (#error.Success [state - (case (get@ #.module-state module) - <tag> #1 - _ #0)]) + (#try.Success [state + (case (get@ #.module-state module) + <tag> #1 + _ #0)]) #.None ((/.throw' unknown-module module-name) state)))))] @@ -204,7 +204,7 @@ (function (_ state) (case (|> state (get@ #.modules) (plist.get module-name)) (#.Some module) - (#error.Success [state (get@ <tag> module)]) + (#try.Success [state (get@ <tag> module)]) #.None ((/.throw' unknown-module module-name) state)))))] @@ -247,15 +247,15 @@ (case (|> state (get@ #.modules) (plist.get self-name)) (#.Some module) (let [namespaced-tags (list@map (|>> [self-name]) tags)] - (#error.Success [(update@ #.modules - (plist.update self-name - (|>> (update@ #.tags (function (_ tag-bindings) - (list@fold (function (_ [idx tag] table) - (plist.put tag [idx namespaced-tags exported? type] table)) - tag-bindings - (list.enumerate tags)))) - (update@ #.types (plist.put type-name [namespaced-tags exported? type])))) - state) - []])) + (#try.Success [(update@ #.modules + (plist.update self-name + (|>> (update@ #.tags (function (_ tag-bindings) + (list@fold (function (_ [idx tag] table) + (plist.put tag [idx namespaced-tags exported? type] table)) + tag-bindings + (list.enumerate tags)))) + (update@ #.types (plist.put type-name [namespaced-tags exported? type])))) + state) + []])) #.None ((/.throw' unknown-module self-name) state)))))) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux b/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux index 104001da9..e5d145a54 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/scope.lux @@ -3,12 +3,12 @@ [abstract monad] [control + ["e" try] ["ex" exception (#+ exception:)]] [data ["." text ("#;." equivalence)] ["." maybe ("#;." monad)] ["." product] - ["e" error] [collection ["." list ("#;." functor fold monoid)] [dictionary diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux index a630a8fab..eeb2cf9e0 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/structure.lux @@ -9,7 +9,6 @@ ["." name] ["." product] ["." maybe] - ["." error] [number ["." nat]] [text diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/type.lux b/stdlib/source/lux/tool/compiler/phase/analysis/type.lux index d7ebbe2a3..20b313381 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/type.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/type.lux @@ -3,9 +3,8 @@ [abstract [monad (#+ do)]] [control - ["." function]] - [data - ["." error]] + ["." function] + ["." try]] [type ["." check (#+ Check)]] ["." macro]] @@ -23,11 +22,11 @@ (All [a] (-> (Check a) (Operation a))) (function (_ (^@ stateE [bundle state])) (case (action (get@ #.type-context state)) - (#error.Success [context' output]) - (#error.Success [[bundle (set@ #.type-context context' state)] - output]) + (#try.Success [context' output]) + (#try.Success [[bundle (set@ #.type-context context' state)] + output]) - (#error.Failure error) + (#try.Failure error) ((/.fail error) stateE)))) (def: #export with-fresh-env diff --git a/stdlib/source/lux/tool/compiler/phase/extension.lux b/stdlib/source/lux/tool/compiler/phase/extension.lux index 4b00c946f..a0564cedd 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension.lux @@ -4,9 +4,9 @@ [monad (#+ do)]] [control ["." function] + ["." try (#+ Try)] ["." exception (#+ exception:)]] [data - ["." error (#+ Error)] ["." text ("#@." order) ["%" format (#+ Format format)]] [collection @@ -67,8 +67,8 @@ (function (_ [bundle state]) (case (dictionary.get name bundle) #.None - (#error.Success [[(dictionary.put name handler bundle) state] - []]) + (#try.Success [[(dictionary.put name handler bundle) state] + []]) _ (exception.throw cannot-overwrite name)))) @@ -93,11 +93,11 @@ (function (_ [bundle state]) (let [old (get state)] (case (operation [bundle (set (transform old) state)]) - (#error.Success [[bundle' state'] output]) - (#error.Success [[bundle' (set old state')] output]) + (#try.Success [[bundle' state'] output]) + (#try.Success [[bundle' (set old state')] output]) - (#error.Failure error) - (#error.Failure error)))))) + (#try.Failure error) + (#try.Failure error)))))) (def: #export (temporary transform) (All [s i o v] @@ -106,11 +106,11 @@ (function (_ operation) (function (_ [bundle state]) (case (operation [bundle (transform state)]) - (#error.Success [[bundle' state'] output]) - (#error.Success [[bundle' state] output]) + (#try.Success [[bundle' state'] output]) + (#try.Success [[bundle' state] output]) - (#error.Failure error) - (#error.Failure error))))) + (#try.Failure error) + (#try.Failure error))))) (def: #export (with-state state) (All [s i o v] @@ -121,13 +121,13 @@ (All [s i o v] (-> (-> s v) (Operation s i o v))) (function (_ [bundle state]) - (#error.Success [[bundle state] (get state)]))) + (#try.Success [[bundle state] (get state)]))) (def: #export (update transform) (All [s i o] (-> (-> s s) (Operation s i o Any))) (function (_ [bundle state]) - (#error.Success [[bundle (transform state)] []]))) + (#try.Success [[bundle (transform state)] []]))) (def: #export (lift action) (All [s i o v] @@ -135,8 +135,8 @@ (//.Operation [(Bundle s i o) s] v))) (function (_ [bundle state]) (case (action state) - (#error.Success [state' output]) - (#error.Success [[bundle state'] output]) + (#try.Success [state' output]) + (#try.Success [[bundle state'] output]) - (#error.Failure error) - (#error.Failure error)))) + (#try.Failure error) + (#try.Failure error)))) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux index fa31254c8..3acecec11 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux @@ -5,13 +5,13 @@ [abstract ["." monad (#+ do)]] [control + ["." try (#+ Try) ("#@." monad)] ["<>" parser ["<c>" code (#+ Parser)] ["<t>" text]] ["." exception (#+ exception:)] pipe] [data - ["." error (#+ Error) ("#@." monad)] ["." maybe] ["." product] ["." text ("#@." equivalence) @@ -829,7 +829,7 @@ (function (_ extension-name analyse [class field]) (do ////.monad [[final? fieldJT] (////.lift - (do error.monad + (do try.monad [class (reflection!.load class)] (reflection!.static-field field class))) fieldT (reflection-type luxT.fresh fieldJT) @@ -847,7 +847,7 @@ (do ////.monad [_ (typeA.infer Any) [final? fieldJT] (////.lift - (do error.monad + (do try.monad [class (reflection!.load class)] (reflection!.static-field field class))) fieldT (reflection-type luxT.fresh fieldJT) @@ -869,7 +869,7 @@ [[objectT objectA] (typeA.with-inference (analyse objectC)) [mapping fieldJT] (////.lift - (do error.monad + (do try.monad [class (reflection!.load class) [final? fieldJT] (reflection!.virtual-field field class) mapping (reflection!.correspond class objectT)] @@ -892,7 +892,7 @@ (analyse objectC)) _ (typeA.infer objectT) [final? mapping fieldJT] (////.lift - (do error.monad + (do try.monad [class (reflection!.load class) [final? fieldJT] (reflection!.virtual-field field class) mapping (reflection!.correspond class objectT)] @@ -921,8 +921,8 @@ (do ////.monad [parameters (|> (java/lang/reflect/Method::getGenericParameterTypes method) array.to-list - (monad.map error.monad reflection!.type) - (:: error.monad map (list@map jvm.descriptor)) + (monad.map try.monad reflection!.type) + (:: try.monad map (list@map jvm.descriptor)) ////.lift) #let [modifiers (java/lang/reflect/Method::getModifiers method) correct-class? (java/lang/Object::equals class (java/lang/reflect/Method::getDeclaringClass method)) @@ -958,8 +958,8 @@ (do ////.monad [parameters (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor) array.to-list - (monad.map error.monad reflection!.type) - (:: error.monad map (list@map jvm.descriptor)) + (monad.map try.monad reflection!.type) + (:: try.monad map (list@map jvm.descriptor)) ////.lift)] (wrap (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor)) (n/= (list.size arg-classes) (list.size parameters)) @@ -1401,13 +1401,13 @@ (template [<name> <filter>] [(def: <name> (-> (java/lang/Class java/lang/Object) - (Error (List [Text Method]))) + (Try (List [Text Method]))) (|>> java/lang/Class::getDeclaredMethods array.to-list <filter> - (monad.map error.monad + (monad.map try.monad (function (_ method) - (do error.monad + (do try.monad [inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method) array.to-list (monad.map @ reflection!.type)) @@ -1428,11 +1428,11 @@ (template [<name> <methods>] [(def: <name> - (-> (List Class) (Error (List [Text Method]))) - (|>> (monad.map error.monad (|>> product.left reflection!.load)) - (error@map (monad.map error.monad <methods>)) - error@join - (error@map list@join)))] + (-> (List Class) (Try (List [Text Method]))) + (|>> (monad.map try.monad (|>> product.left reflection!.load)) + (try@map (monad.map try.monad <methods>)) + try@join + (try@map list@join)))] [all-abstract-methods ..abstract-methods] [all-methods ..methods] diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/lux.lux index 2086a0fea..efd917bd2 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/lux.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/lux.lux @@ -4,12 +4,12 @@ ["." monad (#+ do)]] [control [io (#+ IO)] + ["." try] ["." exception (#+ exception:)] ["<>" parser ["<c>" code (#+ Parser)]]] [data ["." maybe] - ["." error] ["." text ["%" format (#+ format)]] [collection @@ -37,10 +37,10 @@ Handler)) (function (_ extension-name analyse args) (case (<c>.run syntax args) - (#error.Success inputs) + (#try.Success inputs) (handler extension-name analyse inputs) - (#error.Failure error) + (#try.Failure _) (/////analysis.throw ///.invalid-syntax [extension-name %.code args])))) (def: (simple inputsT+ outputT) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux index e4cf0140e..56067c845 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux @@ -4,13 +4,13 @@ ["." monad (#+ do)]] [control [io (#+ IO)] + ["." try] ["." exception (#+ exception:)] ["p" parser ["s" code (#+ Parser)]]] [data ["." product] ["." maybe] - ["." error] [text ["%" format (#+ format)]] [collection @@ -46,10 +46,10 @@ (Handler anchor expression statement))) (function (_ extension-name phase inputs) (case (s.run syntax inputs) - (#error.Success inputs) + (#try.Success inputs) (handler extension-name phase inputs) - (#error.Failure error) + (#try.Failure error) (////.throw ///.invalid-syntax [extension-name %.code inputs])))) ## TODO: Inline "evaluate!'" into "evaluate!" ASAP diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux index 93dc97518..aa7d09d66 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation.lux @@ -3,10 +3,10 @@ [abstract [monad (#+ do)]] [control + ["." try (#+ Try)] ["." exception (#+ exception:)]] [data ["." product] - ["." error (#+ Error)] ["." name ("#@." equivalence)] ["." text ["%" format (#+ format)]] @@ -60,11 +60,11 @@ #inner-functions Nat}) (signature: #export (Host expression statement) - (: (-> Text expression (Error Any)) + (: (-> Text expression (Try Any)) evaluate!) - (: (-> Text statement (Error Any)) + (: (-> Text statement (Try Any)) execute!) - (: (-> Name expression (Error [Text Any statement])) + (: (-> Name expression (Try [Text Any statement])) define!)) (type: #export (Buffer statement) (Row [Name statement])) @@ -111,12 +111,12 @@ (let [[old-scope old-inner] (get@ #context state) new-scope (format old-scope "c" (%.nat old-inner))] (case (expr [bundle (set@ #context [new-scope 0] state)]) - (#error.Success [[bundle' state'] output]) - (#error.Success [[bundle' (set@ #context [old-scope (inc old-inner)] state')] - [new-scope output]]) + (#try.Success [[bundle' state'] output]) + (#try.Success [[bundle' (set@ #context [old-scope (inc old-inner)] state')] + [new-scope output]]) - (#error.Failure error) - (#error.Failure error))))) + (#try.Failure error) + (#try.Failure error))))) (def: #export context (All [anchor expression statement] @@ -136,12 +136,12 @@ (function (_ body) (function (_ [bundle state]) (case (body [bundle (set@ <tag> (#.Some <with-value>) state)]) - (#error.Success [[bundle' state'] output]) - (#error.Success [[bundle' (set@ <tag> (get@ <tag> state) state')] - output]) + (#try.Success [[bundle' state'] output]) + (#try.Success [[bundle' (set@ <tag> (get@ <tag> state) state')] + output]) - (#error.Failure error) - (#error.Failure error))))) + (#try.Failure error) + (#try.Failure error))))) (def: #export <get> (All [anchor expression statement] @@ -149,7 +149,7 @@ (function (_ (^@ stateE [bundle state])) (case (get@ <tag> state) (#.Some output) - (#error.Success [stateE output]) + (#try.Success [stateE output]) #.None (exception.throw <exception> [])))) @@ -158,8 +158,8 @@ (All [anchor expression statement] (-> <get-type> (Operation anchor expression statement Any))) (function (_ [bundle state]) - (#error.Success [[bundle (set@ <tag> (#.Some value) state)] - []])))] + (#try.Success [[bundle (set@ <tag> (#.Some value) state)] + []])))] [#anchor (with-anchor anchor) @@ -200,10 +200,10 @@ (-> Text <inputT> (Operation anchor expression statement Any))) (function (_ (^@ state+ [bundle state])) (case (:: (get@ #host state) <name> label code) - (#error.Success output) - (#error.Success [state+ output]) + (#try.Success output) + (#try.Success [state+ output]) - (#error.Failure error) + (#try.Failure error) (exception.throw cannot-interpret error))))] [evaluate! expression] @@ -215,10 +215,10 @@ (-> Name expression (Operation anchor expression statement [Text Any statement]))) (function (_ (^@ stateE [bundle state])) (case (:: (get@ #host state) define! name code) - (#error.Success output) - (#error.Success [stateE output]) + (#try.Success output) + (#try.Success [stateE output]) - (#error.Failure error) + (#try.Failure error) (exception.throw cannot-interpret error)))) (def: #export (save! execute? name code) @@ -253,7 +253,7 @@ (let [cache (get@ #name-cache state)] (case (dictionary.get lux-name cache) (#.Some host-name) - (#error.Success [stateE host-name]) + (#try.Success [stateE host-name]) #.None (exception.throw unknown-lux-name [lux-name cache]))))) @@ -265,11 +265,11 @@ (let [cache (get@ #name-cache state)] (case (dictionary.get lux-name cache) #.None - (#error.Success [[bundle - (update@ #name-cache - (dictionary.put lux-name host-name) - state)] - []]) + (#try.Success [[bundle + (update@ #name-cache + (dictionary.put lux-name host-name) + state)] + []]) (#.Some old-host-name) (exception.throw cannot-overwrite-lux-name [lux-name old-host-name host-name]))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux index f2d22f57b..9baf594da 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux @@ -4,11 +4,11 @@ [abstract ["." monad (#+ do)]] [control + ["." try] ["<>" parser ["<s>" synthesis (#+ Parser)]]] [data ["." product] - ["." error] [collection ["." list ("#@." functor)] ["." dictionary]]] @@ -33,10 +33,10 @@ Handler)) (function (_ extension-name phase input) (case (<s>.run input parser) - (#error.Success input') + (#try.Success input') (handler extension-name phase input') - (#error.Failure error) + (#try.Failure error) (/////.throw extension.invalid-syntax [extension-name %synthesis input])))) ## [Procedures] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux index 423f0a58d..c44e1bdff 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux @@ -7,7 +7,6 @@ ["<>" parser ["<s>" synthesis (#+ Parser)]]] [data - ["." error] [collection ["." dictionary]]] [target diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux index 42c1d196d..e23692e88 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux @@ -8,7 +8,6 @@ [parser ["s" code]]] [data - ["e" error] ["." product] ["." text] [number (#+ hex)] diff --git a/stdlib/source/lux/tool/compiler/phase/macro.lux b/stdlib/source/lux/tool/compiler/phase/macro.lux index 10d3cd332..db384c727 100644 --- a/stdlib/source/lux/tool/compiler/phase/macro.lux +++ b/stdlib/source/lux/tool/compiler/phase/macro.lux @@ -3,9 +3,9 @@ [abstract [monad (#+ do)]] [control + ["." try (#+ Try)] ["." exception (#+ exception:)]] [data - ["." error (#+ Error)] ["." text ["%" format (#+ format)]] [collection @@ -27,18 +27,18 @@ ["Outputs" (exception.enumerate %.code outputs)])) (type: #export Expander - (-> Macro (List Code) Lux (Error (Error [Lux (List Code)])))) + (-> Macro (List Code) Lux (Try (Try [Lux (List Code)])))) (def: #export (expand expander name macro inputs) (-> Expander Name Macro (List Code) (Meta (List Code))) (function (_ state) - (do error.monad + (do try.monad [output (expander macro inputs state)] (case output - (#error.Success output) - (#error.Success output) + (#try.Success output) + (#try.Success output) - (#error.Failure error) + (#try.Failure error) ((//.throw expansion-failed [name inputs error]) state))))) (def: #export (expand-one expander name macro inputs) diff --git a/stdlib/source/lux/tool/compiler/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/phase/synthesis.lux index 1b92abf97..45372e46b 100644 --- a/stdlib/source/lux/tool/compiler/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/phase/synthesis.lux @@ -3,10 +3,10 @@ [abstract ["." monad (#+ do)]] [control - [pipe (#+ case>)]] + [pipe (#+ case>)] + ["." try]] [data ["." maybe] - ["." error] [collection ["." list ("#;." functor)] ["." dictionary (#+ Dictionary)]]]] @@ -77,10 +77,10 @@ (function (_ state) (|> (//extension.apply phase [name args]) (//.run' state) - (case> (#error.Success output) - (#error.Success output) + (case> (#try.Success output) + (#try.Success output) - (#error.Failure error) + (#try.Failure _) (<| (//.run' state) (do //.monad [argsS+ (monad.map @ phase args)] |