From 2e86fefe6f15877e8c46a45411a9cbd04b26e2e3 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 5 Dec 2017 22:55:11 -0400
Subject: - WIP: Caching.

---
 .../source/luxc/lang/translation/common.jvm.lux    | 62 +++++++++++++++++-----
 1 file changed, 48 insertions(+), 14 deletions(-)

(limited to 'new-luxc/source/luxc/lang/translation/common.jvm.lux')

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