From c5a740c89dd6df2a2955dddc9f98929083139deb Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 28 Jul 2018 20:56:27 -0400
Subject: Added a caching layer to correlate host-specific names to Lux names.

---
 .../lux/compiler/default/phase/translation.lux     | 62 ++++++++++++++++++----
 .../phase/translation/scheme/reference.jvm.lux     | 46 ++++++----------
 2 files changed, 69 insertions(+), 39 deletions(-)

(limited to 'stdlib')

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))))
-- 
cgit v1.2.3