From 012f6bd41e527479dddbccbdab10daa78fd9a0fd Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Wed, 1 Nov 2017 00:51:45 -0400
Subject: - Re-organized code-generation, and re-named it "translation".

---
 .../source/luxc/lang/translation/common.jvm.lux    | 131 +++++++++++++++++++++
 1 file changed, 131 insertions(+)
 create mode 100644 new-luxc/source/luxc/lang/translation/common.jvm.lux

(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
new file mode 100644
index 000000000..1870530c2
--- /dev/null
+++ b/new-luxc/source/luxc/lang/translation/common.jvm.lux
@@ -0,0 +1,131 @@
+(;module:
+  [lux #- function]
+  (lux (control ["ex" exception #+ exception:])
+       [io]
+       (concurrency ["A" atom])
+       (data ["e" error]
+             [text]
+             text/format
+             (coll [dict #+ Dict]))
+       [host]
+       (world [blob #+ Blob]))
+  (luxc (host ["$" jvm]
+              (jvm ["$t" type]
+                   ["$d" def]
+                   ["$i" inst]))))
+
+(host;import org.objectweb.asm.Opcodes
+  (#static V1_6 int))
+
+(host;import java.lang.Object)
+
+(host;import (java.lang.Class a))
+
+(host;import java.lang.ClassLoader
+  (loadClass [String] (Class Object)))
+
+(type: #export Bytecode (host;type (Array byte)))
+
+(type: #export Class-Store (A;Atom (Dict Text Bytecode)))
+
+(type: #export Artifacts (Dict Text Blob))
+
+(type: #export Host
+  {#loader ClassLoader
+   #store Class-Store
+   #function-class (Maybe Text)
+   #artifacts Artifacts})
+
+(exception: Unknown-Class)
+(exception: Class-Already-Stored)
+(exception: No-Function-Being-Compiled)
+(exception: Cannot-Overwrite-Artifact)
+
+(def: #export (with-artifacts action)
+  (All [a] (-> (Meta a) (Meta [Artifacts a])))
+  (;function [compiler]
+    (case (action (update@ #;host
+                           (|>. (:! Host)
+                                (set@ #artifacts (dict;new text;Hash<Text>))
+                                (:! Void))
+                           compiler))
+      (#e;Success [compiler' output])
+      (#e;Success [(update@ #;host
+                            (|>. (:! Host)
+                                 (set@ #artifacts (|> (get@ #;host compiler) (:! Host) (get@ #artifacts)))
+                                 (:! Void))
+                            compiler')
+                   [(|> compiler' (get@ #;host) (:! Host) (get@ #artifacts))
+                    output]])
+      
+      (#e;Error error)
+      (#e;Error error))))
+
+(def: #export (record-artifact name content)
+  (-> Text Blob (Meta Unit))
+  (;function [compiler]
+    (if (|> compiler (get@ #;host) (:! Host) (get@ #artifacts) (dict;contains? name))
+      (ex;throw Cannot-Overwrite-Artifact name)
+      (#e;Success [(update@ #;host
+                            (|>. (:! Host)
+                                 (update@ #artifacts (dict;put name content))
+                                 (:! Void))
+                            compiler)
+                   []]))))
+
+(def: #export (store-class name byte-code)
+  (-> Text Bytecode (Meta Unit))
+  (;function [compiler]
+    (let [store (|> (get@ #;host compiler)
+                    (:! Host)
+                    (get@ #store))]
+      (if (dict;contains? name (|> store A;get io;run))
+        (ex;throw Class-Already-Stored name)
+        (#e;Success [compiler (io;run (A;update (dict;put name byte-code) store))])
+        ))))
+
+(def: #export (load-class name)
+  (-> Text (Meta (Class Object)))
+  (;function [compiler]
+    (let [host (:! Host (get@ #;host compiler))
+          store (|> host (get@ #store) A;get io;run)]
+      (if (dict;contains? name store)
+        (#e;Success [compiler (ClassLoader.loadClass [name] (get@ #loader host))])
+        (ex;throw Unknown-Class name)))))
+
+(def: #export (with-function class expr)
+  (All [a] (-> Text (Meta a) (Meta a)))
+  (;function [compiler]
+    (let [host (:! Host (get@ #;host compiler))
+          old-function-class (get@ #function-class host)]
+      (case (expr (set@ #;host
+                        (:! Void (set@ #function-class
+                                       (#;Some class)
+                                       host))
+                        compiler))
+        (#e;Success [compiler' output])
+        (#e;Success [(update@ #;host
+                              (|>. (:! Host)
+                                   (set@ #function-class old-function-class)
+                                   (:! Void))
+                              compiler')
+                     output])
+
+        (#e;Error error)
+        (#e;Error error)))))
+
+(def: #export function
+  (Meta Text)
+  (;function [compiler]
+    (let [host (:! Host (get@ #;host compiler))]
+      (case (get@ #function-class host)
+        #;None
+        (ex;throw No-Function-Being-Compiled "")
+        
+        (#;Some function-class)
+        (#e;Success [compiler function-class])))))
+
+(def: #export bytecode-version Int Opcodes.V1_6)
+
+(def: #export value-field Text "_value")
+(def: #export $Object $;Type ($t;class "java.lang.Object" (list)))
-- 
cgit v1.2.3