diff options
author | Eduardo Julian | 2017-06-12 21:14:55 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-06-12 21:14:55 -0400 |
commit | 9cd2927a4f6175784e081d6b512d3e900c8069e7 (patch) | |
tree | d1fe512bc84ea1e3a50ad86eeb3265771edd23c6 /new-luxc/source/luxc/host.jvm.lux | |
parent | c50667a431a5ca67328a230f0c59956dc6ff43fa (diff) |
- Renamed the "compilation" phase as the "generation" phase.
- Implemented compilation of primitives.
- Implemented compilation of structures.
Diffstat (limited to '')
-rw-r--r-- | new-luxc/source/luxc/host.jvm.lux | 86 |
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})) |