aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2018-07-28 20:56:27 -0400
committerEduardo Julian2018-07-28 20:56:27 -0400
commitc5a740c89dd6df2a2955dddc9f98929083139deb (patch)
treef00273f374e2b1999fae4a97f5c9855c0f77d5fd /stdlib
parent005fa8c09fa469233736912f772022f1dfacf352 (diff)
Added a caching layer to correlate host-specific names to Lux names.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/compiler/default/phase/translation.lux62
-rw-r--r--stdlib/source/lux/compiler/default/phase/translation/scheme/reference.jvm.lux46
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))))