1 files changed, 86 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/host.jvm.lux b/new-luxc/source/luxc/host.jvm.lux
new file mode 100644
index 000000000..c46e1cf1f
--- /dev/null
+++ b/new-luxc/source/luxc/host.jvm.lux
@@ -0,0 +1,86 @@
+(;module:
+  lux
+  (lux (control monad)
+       (concurrency ["A" atom])
+       (data ["R" result]
+             [text]
+             text/format
+             (coll ["d" dict]
+                   [array #+ Array]))
+       [macro #+ Monad<Lux>]
+       host
+       [io])
+  (luxc ["&" base]
+        (generator ["&&;" common])
+        ))
+
+(jvm-import java.lang.reflect.AccessibleObject
+  (setAccessible [boolean] void))
+
+(jvm-import java.lang.reflect.Method
+  (invoke [Object (Array Object)] #try Object))
+
+(jvm-import (java.lang.Class a)
+  (getDeclaredMethod [String (Array (Class Object))] #try Method))
+
+(jvm-import java.lang.Object
+  (getClass [] (Class Object)))
+
+(jvm-import java.lang.Integer
+  (#static TYPE (Class Integer)))
+
+(jvm-import java.lang.ClassLoader)
+
+(def: ClassLoader::defineClass
+  Method
+  (case (Class.getDeclaredMethod ["defineClass"
+                                  (|> (array (Class Object) +4)
+                                      (array-store +0 (:! (Class Object) (class-for String)))
+                                      (array-store +1 (Object.getClass [] (array byte +0)))
+                                      (array-store +2 (:! (Class Object) Integer.TYPE))
+                                      (array-store +3 (:! (Class Object) Integer.TYPE)))]
+                                 (class-for java.lang.ClassLoader))
+    (#R;Success method)
+    (do-to method
+      (AccessibleObject.setAccessible [true]))
+
+    (#R;Error error)
+    (error! error)))
+
+(def: (define-class class-name byte-code loader)
+  (-> Text &&common;Bytecode ClassLoader (R;Result Object))
+  (Method.invoke [loader
+                  (array;from-list (list (:! Object class-name)
+                                         (:! Object byte-code)
+                                         (:! Object (l2i 0))
+                                         (:! Object (l2i (nat-to-int (array-length byte-code))))))]
+                 ClassLoader::defineClass))
+
+(def: (fetch-byte-code class-name store)
+  (-> Text &&common;Class-Store &&common;Bytecode)
+  (|> store A;get io;run (d;get class-name) assume))
+
+(def: (assume!! input)
+  (All [a] (-> (R;Result a) a))
+  (case input
+    (#R;Success output)
+    output
+    
+    (#R;Error error)
+    (error! error)))
+
+(def: (memory-class-loader store)
+  (-> &&common;Class-Store ClassLoader)
+  (object ClassLoader []
+    []
+    (ClassLoader (findClass [class-name String]) Class
+                 (:!! (assume!! (define-class class-name (fetch-byte-code class-name store) (:! ClassLoader _jvm_this))))
+                 )))
+
+(def: #export (init-host _)
+  (-> Top &&common;Host)
+  (let [store (: &&common;Class-Store
+                 (A;atom (d;new text;Hash<Text>)))]
+    {#&&common;visitor #;None
+     #&&common;loader (memory-class-loader store)
+     #&&common;store store}))