diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm.lux | 140 |
1 files changed, 31 insertions, 109 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index 47fbbefcf..9a6eb25ed 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -14,7 +14,9 @@ ["." array] [list ("list/." Functor<List>)] ["." dictionary (#+ Dictionary)]]] - ["." host (#+ import: do-to object)] + ["." host (#+ import: do-to object) + [jvm + ["." loader]]] ["." io (#+ IO io)] [world [binary (#+ Binary)]] @@ -33,99 +35,19 @@ (import: org/objectweb/asm/Label) -(import: java/lang/reflect/AccessibleObject - (setAccessible [boolean] void)) - (import: java/lang/reflect/Field (get [#? Object] #try #? Object)) -(import: java/lang/reflect/Method - (invoke [Object (Array Object)] #try Object)) - (import: (java/lang/Class a) - (getField [String] #try Field) - (getDeclaredMethod [String (Array (Class Object))] #try Method)) + (getField [String] #try Field)) (import: java/lang/Object (getClass [] (Class Object))) -(import: java/lang/Integer - (#static TYPE (Class Integer))) - -(import: java/lang/ClassLoader - (loadClass [String] #try (Class Object))) - -(def: ClassLoader::defineClass - Method - (case (Class::getDeclaredMethod "defineClass" - (|> (host.array (Class Object) 4) - (host.array-write 0 (:coerce (Class Object) (host.class-for String))) - (host.array-write 1 (Object::getClass (host.array byte 0))) - (host.array-write 2 (:coerce (Class Object) (Integer::TYPE))) - (host.array-write 3 (:coerce (Class Object) (Integer::TYPE)))) - (host.class-for java/lang/ClassLoader)) - (#error.Success method) - (do-to method - (AccessibleObject::setAccessible #1)) - - (#error.Error error) - (error! error))) +(import: java/lang/ClassLoader) (type: #export ByteCode Binary) -(def: (define-class class-name bytecode loader) - (-> Text ByteCode ClassLoader (Error Object)) - (Method::invoke loader - (array.from-list (list (:coerce Object class-name) - (:coerce Object bytecode) - (:coerce Object (host.long-to-int +0)) - (:coerce Object (host.long-to-int (.int (host.array-length bytecode)))))) - ClassLoader::defineClass)) - -(type: Store (Atom (Dictionary Text ByteCode))) - -(exception: #export (class-already-stored {class Text}) - (ex.report ["Class" class])) - -(exception: #export (unknown-class {class Text} {known-classes (List Text)}) - (ex.report ["Class" class] - ["Known Classes" (|> known-classes - (list/map (|>> (format "\n\t"))) - (text.join-with ""))])) - -(exception: #export (cannot-define-class {class Text} {error Text}) - (ex.report ["Class" class] - ["Error" error])) - -(def: (memory-class-loader store) - (-> Store ClassLoader) - (object [] ClassLoader [] - [] - (ClassLoader (findClass {class-name String}) Class - (let [classes (|> store atom.read io.run)] - (case (dictionary.get class-name classes) - (#.Some bytecode) - (case (define-class class-name bytecode (:coerce ClassLoader _jvm_this)) - (#error.Success class) - (:assume class) - - (#error.Error error) - (error! (ex.construct cannot-define-class [class-name error]))) - - #.None - (error! (ex.construct unknown-class [class-name (dictionary.keys classes)]))))))) - -(def: (store! name bytecode store) - (-> Text ByteCode Store (Error Any)) - (if (|> store atom.read io.run (dictionary.contains? name)) - (ex.throw class-already-stored name) - (exec (io.run (atom.update (dictionary.put name bytecode) store)) - (#error.Success [])))) - -(def: (load! name loader) - (-> Text ClassLoader (Error (Class Object))) - (ClassLoader::loadClass name loader)) - (def: #export value-field Text "_value") (def: #export $Object jvm.Type (type.class "java.lang.Object" (list))) @@ -165,30 +87,30 @@ (def: (evaluate! store loader eval-class valueI) (-> Store ClassLoader Text Inst (Error Any)) - (do error.Monad<Error> - [#let [bytecode-name (text.replace-all class-path-separator module-separator eval-class) - bytecode (def.class #jvm.V1_6 - #jvm.Public jvm.noneC - bytecode-name - (list) ["java.lang.Object" (list)] - (list) - (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF) - ..value-field ..$Object) - (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM) - "<clinit>" - (type.method (list) #.None (list)) - (|>> valueI - (inst.PUTSTATIC bytecode-name ..value-field ..$Object) - inst.RETURN))))] - _ (..store! eval-class bytecode store) - class (..load! eval-class loader)] - (class-value eval-class class))) + (let [bytecode-name (text.replace-all class-path-separator module-separator eval-class) + bytecode (def.class #jvm.V1_6 + #jvm.Public jvm.noneC + bytecode-name + (list) ["java.lang.Object" (list)] + (list) + (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF) + ..value-field ..$Object) + (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM) + "<clinit>" + (type.method (list) #.None (list)) + (|>> valueI + (inst.PUTSTATIC bytecode-name ..value-field ..$Object) + inst.RETURN))))] + (io.run (do (error.ErrorT io.Monad<IO>) + [_ (loader.store eval-class bytecode store) + class (loader.load eval-class loader)] + (:: io.Monad<IO> wrap (class-value eval-class class)))))) (def: (execute! store loader temp-label [class-name class-bytecode]) (-> Store ClassLoader Text Definition (Error Any)) - (do error.Monad<Error> - [_ (..store! class-name class-bytecode store)] - (..load! class-name loader))) + (io.run (do (error.ErrorT io.Monad<IO>) + [_ (loader.store class-name class-bytecode store)] + (loader.load class-name loader)))) (def: (define! store loader [module name] valueI) (-> Store ClassLoader Name Inst (Error [Text Any])) @@ -201,15 +123,15 @@ (def: #export init (IO Host) - (io (let [store (: Store (atom (dictionary.new text.Hash<Text>))) - loader (memory-class-loader store)] + (io (let [library (loader.new-library []) + loader (loader.memory library)] (: Host (structure (def: (evaluate! temp-label valueI) (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))] - (..evaluate! store loader eval-class valueI))) - (def: execute! (..execute! store loader)) - (def: define! (..define! store loader))))))) + (..evaluate! library loader eval-class valueI))) + (def: execute! (..execute! library loader)) + (def: define! (..define! library loader))))))) (def: #export runtime-class "LuxRuntime") (def: #export function-class "LuxFunction") |