diff options
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/translation.lux | 62 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/translation/scheme/reference.jvm.lux | 46 |
2 files changed, 69 insertions, 39 deletions
diff --git a/stdlib/source/lux/compiler/default/phase/translation.lux b/stdlib/source/lux/compiler/default/phase/translation.lux index c0242bd38..d2b0b0678 100644 --- a/stdlib/source/lux/compiler/default/phase/translation.lux +++ b/stdlib/source/lux/compiler/default/phase/translation.lux @@ -2,16 +2,17 @@ [lux #* [control ["ex" exception (#+ exception:)] - [monad (#+ do)]] + [monad (#+ do)] + pipe] [data ["." product] ["." error (#+ Error)] - [name ("name/." Equivalence<Name> Codec<Text,Name>)] + ["." name ("name/." Equivalence<Name>)] ["." text format] [collection ["." row (#+ Row)] - ["dict" dictionary (#+ Dictionary)]]] + ["." dictionary (#+ Dictionary)]]] [world [file (#+ File)]]] ["." // @@ -26,12 +27,22 @@ [no-anchor] ) -(exception: #export (cannot-interpret {message Text}) - message) +(exception: #export (cannot-interpret {error Text}) + (ex.report ["Error" error])) + +(exception: #export (unknown-lux-name {name Name}) + (ex.report ["Name" (%name name)])) + +(exception: #export (cannot-overwrite-lux-name {lux-name Name} + {old-host-name Text} + {new-host-name Text}) + (ex.report ["Lux Name" (%name lux-name)] + ["Old Host Name" old-host-name] + ["New Host Name" new-host-name])) (do-template [<name>] [(exception: #export (<name> {name Name}) - (ex.report ["Artifact" (name/encode name)]))] + (ex.report ["Artifact" (%name name)]))] [cannot-overwrite-artifact] [no-buffer-for-saving-code] @@ -57,7 +68,8 @@ #host (Host expression statement) #buffer (Maybe (Buffer statement)) #artifacts (Artifacts statement) - #counter Nat}) + #counter Nat + #name-cache (Dictionary Name Text)}) (type: #export (Operation anchor expression statement) (extension.Operation (State anchor expression statement) Synthesis expression)) @@ -80,8 +92,9 @@ #anchor #.None #host host #buffer #.None - #artifacts (dict.new text.Hash<Text>) - #counter 0}) + #artifacts (dictionary.new text.Hash<Text>) + #counter 0 + #name-cache (dictionary.new name.Hash<Name>)}) (def: #export (with-context expr) (All [anchor expression statement output] @@ -198,4 +211,33 @@ (-> File (Operation anchor expression statement Any))) (do //.Monad<Operation> [buffer ..buffer] - (extension.update (update@ #artifacts (dict.put target buffer))))) + (extension.update (update@ #artifacts (dictionary.put target buffer))))) + +(def: #export (remember lux-name) + (All [anchor expression statement] + (-> Name (Operation anchor expression statement Text))) + (function (_ (^@ stateE [_ state])) + (|> state + (get@ #name-cache) + (dictionary.get lux-name) + (case> (#.Some host-name) + (#error.Success [stateE host-name]) + + #.None + (ex.throw unknown-lux-name lux-name))))) + +(def: #export (learn lux-name host-name) + (All [anchor expression statement] + (-> Name Text (Operation anchor expression statement Any))) + (function (_ [bundle state]) + (let [cache (get@ #name-cache state)] + (case (dictionary.get lux-name cache) + (#.Some old-host-name) + (ex.throw cannot-overwrite-lux-name [lux-name old-host-name host-name]) + + #.None + (#error.Success [[bundle + (update@ #name-cache + (dictionary.put lux-name host-name) + state)] + []]))))) diff --git a/stdlib/source/lux/compiler/default/phase/translation/scheme/reference.jvm.lux b/stdlib/source/lux/compiler/default/phase/translation/scheme/reference.jvm.lux index 240513fbc..6d4088189 100644 --- a/stdlib/source/lux/compiler/default/phase/translation/scheme/reference.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/translation/scheme/reference.jvm.lux @@ -7,15 +7,15 @@ format]]] [// [runtime (#+ Operation)] - [/// ("operation/." Monad<Operation>) - [analysis (#+ Variant Tuple)] - [synthesis (#+ Synthesis)] - [// - ["." reference (#+ Register Variable Reference)] - ["." name] + ["/." // + [// ("operation/." Monad<Operation>) + [analysis (#+ Variant Tuple)] + [synthesis (#+ Synthesis)] [// - [host - ["_" scheme (#+ Expression Var)]]]]]]) + ["." reference (#+ Register Variable Reference)] + [// + [host + ["_" scheme (#+ Expression Global Var)]]]]]]]) (do-template [<name> <prefix>] [(def: #export <name> @@ -26,35 +26,23 @@ [foreign' "f"] ) -(def: #export variable' - (-> Variable Var) +(def: #export variable + (-> Variable (Operation Var)) (|>> (case> (#reference.Local register) (local' register) (#reference.Foreign register) - (foreign' register)))) - -(def: #export variable - (-> Variable (Operation Var)) - (|>> ..variable' + (foreign' register)) operation/wrap)) -(def: #export constant' - (-> Name Var) - (|>> name.definition _.var)) - (def: #export constant - (-> Name (Operation Var)) - (|>> constant' operation/wrap)) + (-> Name (Operation Global)) + (|>> ///.remember (operation/map _.global))) -(def: #export reference' - (-> Reference Expression) +(def: #export reference + (-> Reference (Operation Expression)) (|>> (case> (#reference.Constant value) - (..constant' value) + (..constant value) (#reference.Variable value) - (..variable' value)))) - -(def: #export reference - (-> Reference (Operation Expression)) - (|>> reference' operation/wrap)) + (..variable value)))) |