- WIP: Caching.

5 files changed, 86 insertions, 44 deletions

diff --git a/new-luxc/source/luxc/lang/host.jvm.lux b/new-luxc/source/luxc/lang/host.jvm.lux
index c980eab9d..6eb8aacbc 100644
--- a/new-luxc/source/luxc/lang/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/host.jvm.lux
@@ -56,8 +56,8 @@
   (Method::invoke [loader
                    (array.from-list (list (:! Object class-name)
                                           (:! Object byte-code)
-                                          (:! Object (host.l2i 0))
-                                          (:! Object (host.l2i (nat-to-int (host.array-length byte-code))))))]
+                                          (:! Object (host.long-to-int 0))
+                                          (:! Object (host.long-to-int (nat-to-int (host.array-length byte-code))))))]
                   ClassLoader::defineClass))
 
 (def: (fetch-byte-code class-name store)
diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux
index 8e90172d5..8c73c1086 100644
--- a/new-luxc/source/luxc/lang/host/jvm/def.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/def.lux
@@ -266,13 +266,13 @@
          writer)))]
 
   [boolean-field Bool $t.boolean id]
-  [byte-field    Int  $t.byte    host.l2b]
-  [short-field   Int  $t.short   host.l2s]
-  [int-field     Int  $t.int     host.l2i]
+  [byte-field    Int  $t.byte    host.long-to-byte]
+  [short-field   Int  $t.short   host.long-to-short]
+  [int-field     Int  $t.int     host.long-to-int]
   [long-field    Int  $t.long    id]
-  [float-field   Frac $t.float   host.d2f]
+  [float-field   Frac $t.float   host.double-to-float]
   [double-field  Frac $t.double  id]
-  [char-field    Nat  $t.char    (|>> nat-to-int host.l2i host.i2c)]
+  [char-field    Nat  $t.char    (|>> nat-to-int host.long-to-int host.int-to-char)]
   [string-field  Text ($t.class "java.lang.String" (list)) id]
   )
 
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index 5f3711bbd..0b1904020 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -128,10 +128,10 @@
          (MethodVisitor::visitLdcInsn [(<prepare> value)]))))]
 
   [boolean Bool id]
-  [int     Int  host.l2i]
+  [int     Int  host.long-to-int]
   [long    Int  id]
   [double  Frac id]
-  [char    Nat  (|>> nat-to-int host.l2i host.i2c)]
+  [char    Nat  (|>> nat-to-int host.long-to-int host.int-to-char)]
   [string  Text id]
   )
 
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index a0e5bca97..b1e65c952 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -4,7 +4,8 @@
                 ["ex" exception #+ exception:])
        (concurrency ["P" promise]
                     ["T" task])
-       (data ["e" error]
+       (data [product]
+             ["e" error]
              [text "text/" Hash<Text>]
              text/format
              (coll [list "list/" Functor<List>]
@@ -14,9 +15,13 @@
              (type ["tc" check]))
        [host]
        [io #+ IO Process io]
-       (world [file #+ File]))
+       (world [blob #+ Blob]
+              [file #+ File]))
   (luxc ["&" lang]
         ["&." io]
+        [cache]
+        [cache/description]
+        [cache/io]
         (lang [".L" module]
               [".L" host]
               [".L" macro]
@@ -35,9 +40,7 @@
                            [".T" expression]
                            [".T" eval]
                            [".T" imports])
-              ["&." eval]
-              ## [".L" cache]
-              )
+              ["&." eval])
         ))
 
 (def: analyse
@@ -156,27 +159,30 @@
       (#e.Success [(set@ #.source source' compiler)
                    output]))))
 
-(def: (write-module target-dir module-name module artifacts)
-  (-> File Text Module Artifacts (Process Unit))
+(for {"JVM" (as-is (host.import java/lang/String
+                     (getBytes [String] #try (Array byte)))
+
+                   (def: text-to-blob
+                     (-> Text Blob)
+                     (|>> (:! String)
+                          (String::getBytes ["UTF-8"])
+                          e.assume)))})
+
+(def: (write-module target-dir file-name module-name module artifacts)
+  (-> File Text Text Module Artifacts (Process Unit))
   (do io.Monad<Process>
-    [_ (monad.map @ (function [[name content]]
-                      (&io.write target-dir
-                                 (format module-name "/" name (for {"JVM" ".class"
-                                                                    "JS" ".js"}))
-                                 content))
+    [_ (monad.map @ (product.uncurry (&io.write target-dir))
                   (dict.entries artifacts))]
-    (wrap [])
-    ## (&io.write (format module-dir "/" cacheL.descriptor-name)
-    ##            (text-to-blob (%code (cacheL.describe module))))
-    ))
+    (&io.write target-dir
+               (format module-name "/" cache.descriptor-name)
+               (text-to-blob (%code (cache/description.write file-name module))))))
 
 (def: no-aliases Aliases (dict.new text.Hash<Text>))
 
 (def: #export (translate-module source-dirs target-dir module-name compiler)
   (-> (List File) File Text Compiler (Process Compiler))
   (do io.Monad<Process>
-    [## _ (&io.prepare-module target-dir module-name)
-     [file-name file-content] (&io.read-module source-dirs module-name)
+    [[file-name file-content] (&io.read source-dirs module-name)
      #let [module-hash (text/hash file-content)
            translate-module (translate-module source-dirs target-dir)]]
     (case (macro.run' compiler
@@ -197,8 +203,8 @@
                         (wrap [module artifacts])))
       (#e.Success [compiler [module artifacts]])
       (do @
-        [## _ (write-module target-dir module-name module artifacts)
-         ]
+        [_ (&io.prepare-module target-dir module-name)
+         _ (write-module target-dir file-name module-name module artifacts)]
         (wrap compiler))
       
       (#e.Error error)
@@ -246,7 +252,8 @@
                    (do @
                      [_ (&io.prepare-target target)
                       _ (&io.write target (format hostL.runtime-class ".class") runtime-bc)
-                      _ (&io.write target (format hostL.function-class ".class") function-bc)]
+                      _ (&io.write target (format hostL.function-class ".class") function-bc)
+                      _ (cache/io.pre-load sources target (commonT.load-definition compiler))]
                      (wrap (set@ #.extensions
                                  (:! Void
                                      {#extensionL.analysis analysisE.defaults
@@ -261,5 +268,6 @@
   (do io.Monad<Process>
     [compiler (initialize sources target)
      _ (translate-module sources target program compiler)
+     ## _ (cache/io.clean target ...)
      #let [_ (log! "Compilation complete!")]]
     (wrap [])))
diff --git a/new-luxc/source/luxc/lang/translation/common.jvm.lux b/new-luxc/source/luxc/lang/translation/common.jvm.lux
index 1132928d0..a4eb5b93b 100644
--- a/new-luxc/source/luxc/lang/translation/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -1,16 +1,19 @@
 (.module:
-  [lux #- function]
-  (lux (control ["ex" exception #+ exception:])
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
        [io]
        (concurrency [atom #+ Atom atom])
-       (data ["e" error]
-             [text]
+       (data ["e" error #+ Error]
+             [text "text/" Hash<Text>]
              text/format
              (coll [dict #+ Dict]))
+       [macro]
        [host]
        (world [blob #+ Blob]
               [file #+ File]))
-  (luxc (lang [".L" variable #+ Register]
+  (luxc [lang]
+        (lang [".L" variable #+ Register]
               (host ["$" jvm]
                     (jvm ["$t" type]
                          ["$d" def]
@@ -23,7 +26,11 @@
 
 (host.import java/lang/Object)
 
-(host.import (java/lang/Class a))
+(host.import java/lang/reflect/Field
+  (get [#? Object] #try #? Object))
+
+(host.import (java/lang/Class c)
+  (getField [String] #try Field))
 
 (host.import java/lang/ClassLoader
   (loadClass [String] (Class Object)))
@@ -41,14 +48,16 @@
    #context [Text Nat]
    #anchor (Maybe [Label Register])})
 
-(exception: Unknown-Class)
-(exception: Class-Already-Stored)
-(exception: No-Function-Being-Compiled)
-(exception: Cannot-Overwrite-Artifact)
+(exception: #export Unknown-Class)
+(exception: #export Class-Already-Stored)
+(exception: #export No-Function-Being-Compiled)
+(exception: #export Cannot-Overwrite-Artifact)
+(exception: #export Cannot-Load-Definition)
+(exception: #export Invalid-Definition-Value)
 
 (def: #export (with-artifacts action)
   (All [a] (-> (Meta a) (Meta [Artifacts a])))
-  (.function [compiler]
+  (function [compiler]
     (case (action (update@ #.host
                            (|>> (:! Host)
                                 (set@ #artifacts (dict.new text.Hash<Text>))
@@ -68,7 +77,7 @@
 
 (def: #export (record-artifact name content)
   (-> Text Blob (Meta Unit))
-  (.function [compiler]
+  (function [compiler]
     (if (|> compiler (get@ #.host) (:! Host) (get@ #artifacts) (dict.contains? name))
       (ex.throw Cannot-Overwrite-Artifact name)
       (#e.Success [(update@ #.host
@@ -80,7 +89,7 @@
 
 (def: #export (store-class name byte-code)
   (-> Text Bytecode (Meta Unit))
-  (.function [compiler]
+  (function [compiler]
     (let [store (|> (get@ #.host compiler)
                     (:! Host)
                     (get@ #store))]
@@ -91,7 +100,7 @@
 
 (def: #export (load-class name)
   (-> Text (Meta (Class Object)))
-  (.function [compiler]
+  (function [compiler]
     (let [host (:! Host (get@ #.host compiler))
           store (|> host (get@ #store) atom.read io.run)]
       (if (dict.contains? name store)
@@ -100,3 +109,28 @@
 
 (def: #export value-field Text "_value")
 (def: #export $Object $.Type ($t.class "java.lang.Object" (list)))
+
+(def: #export (load-definition compiler)
+  (-> Compiler
+      (-> Ident Blob (Error Top)))
+  (function [(^@ def-ident [def-module def-name]) def-bytecode]
+    (let [normal-name (format (lang.normalize-name def-name) (%n (text/hash def-name)))
+          class-name (format (text.replace-all "/" "." def-module) "." normal-name)]
+      (<| (macro.run compiler)
+          (do macro.Monad<Meta>
+            [_ (..store-class class-name def-bytecode)
+             class (..load-class class-name)]
+            (case (do e.Monad<Error>
+                    [field (Class::getField [..value-field] class)]
+                    (Field::get [#.None] field))
+              (#e.Success (#.Some def-value))
+              (wrap def-value)
+
+              (#e.Success #.None)
+              (lang.throw Invalid-Definition-Value (%ident def-ident))
+              
+              (#e.Error error)
+              (lang.throw Cannot-Load-Definition
+                          (format "Definition: " (%ident def-ident) "\n"
+                                  "Error:\n"
+                                  error))))))))