From a85bfc405e7acaf86c61fcd8f7987da0200d7b03 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 May 2019 23:34:17 -0400 Subject: Various fixes and tweaks. --- stdlib/source/lux/host.jvm.lux | 6 +-- stdlib/source/lux/host.old.lux | 4 +- stdlib/source/lux/target/jvm/attribute.lux | 6 +-- stdlib/source/lux/target/jvm/loader.lux | 59 ++++++++++++++++++------------ 4 files changed, 44 insertions(+), 31 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index eb81a408e..9578288c2 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -1007,7 +1007,7 @@ (code.local-identifier "?") (#.Some [bound bound]) - (` [(~ (..bound$ bound)) (~ (generic$ bound))])))) + (` ((~ (..bound$ bound)) (~ (generic$ bound))))))) (def: (type$ type) (-> Type Code) @@ -1464,8 +1464,8 @@ ## else (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))] (` (let [(~ g!temp) (~ return-term)] - (if (not (null? (:coerce (primitive "java.lang.Object") - (~ g!temp)))) + (if (not (..null? (:coerce (primitive "java.lang.Object") + (~ g!temp)))) (~ g!temp) (error! "Cannot produce null references from method calls.")))))) diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index 5c2ac40d9..db8145ab2 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -1569,8 +1569,8 @@ (` (??? (~ return-term))) (let [g!temp (` ((~' ~') (~ (code.identifier ["" " Ω "]))))] (` (let [(~ g!temp) (~ return-term)] - (if (not (null? (:coerce (primitive "java.lang.Object") - (~ g!temp)))) + (if (not (..null? (:coerce (primitive "java.lang.Object") + (~ g!temp)))) (~ g!temp) (error! "Cannot produce null references from method calls.")))))) diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux index bcd3a3734..024f0ec3f 100644 --- a/stdlib/source/lux/target/jvm/attribute.lux +++ b/stdlib/source/lux/target/jvm/attribute.lux @@ -86,9 +86,9 @@ (State Pool Attribute)) (do state.monad [@name (//constant/pool.utf8 "ConstantValue")] - (wrap (#Constant {#name @name - #length (//encoding.to-u4 //encoding.u2-bytes) - #info index})))) + (wrap {#name @name + #length (//encoding.to-u4 //encoding.u2-bytes) + #info index}))) ## (def: #export (code specification) ## (-> Code' (State Pool Attribute)) diff --git a/stdlib/source/lux/target/jvm/loader.lux b/stdlib/source/lux/target/jvm/loader.lux index 882a5c7dd..5aa4bc271 100644 --- a/stdlib/source/lux/target/jvm/loader.lux +++ b/stdlib/source/lux/target/jvm/loader.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["@" target] [abstract [monad (#+ do)]] [control @@ -45,7 +46,7 @@ (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object)) (import: #long (java/lang/Class a) - (getDeclaredMethod [java/lang/String [(java/lang/Class java/lang/Object)]] #try java/lang/reflect/Method)) + (getDeclaredMethod [java/lang/String [(java/lang/Class java/lang/Object)]] java/lang/reflect/Method)) (import: #long java/lang/Integer (#static TYPE (java/lang/Class java/lang/Integer))) @@ -68,10 +69,9 @@ (java/lang/Integer::TYPE))) (host.array-write 3 (:coerce (java/lang/Integer::TYPE))))] - (do-to (error.assume - (java/lang/Class::getDeclaredMethod "defineClass" - signature - (host.class-for java/lang/ClassLoader))) + (do-to (java/lang/Class::getDeclaredMethod "defineClass" + signature + (host.class-for java/lang/ClassLoader)) (java/lang/reflect/AccessibleObject::setAccessible true))))) (def: #export (define class-name bytecode loader) @@ -81,9 +81,14 @@ (:coerce java/lang/Object bytecode) (:coerce java/lang/Object - (host.long-to-int +0)) + (|> 0 + (:coerce (primitive "java.lang.Long")) + host.long-to-int)) (:coerce java/lang/Object - (host.long-to-int (.int (binary.size bytecode))))))] + (|> bytecode + binary.size + (:coerce (primitive "java.lang.Long")) + host.long-to-int))))] (java/lang/reflect/Method::invoke loader signature java/lang/ClassLoader::defineClass))) (def: #export (new-library _) @@ -92,22 +97,30 @@ (def: #export (memory library) (-> Library java/lang/ClassLoader) - (object [] java/lang/ClassLoader [] - [] - (java/lang/ClassLoader (findClass self {class-name java/lang/String}) java/lang/Class - (let [classes (|> library atom.read io.run)] - (case (dictionary.get class-name classes) - (#.Some bytecode) - (case (|> self - (..define class-name bytecode)) - (#error.Success class) - (:assume class) - - (#error.Failure error) - (error! (ex.construct ..cannot-define [class-name error]))) - - #.None - (error! (ex.construct ..unknown [class-name (dictionary.keys classes)]))))))) + (`` (with-expansions [ (for {(~~ (static @.old)) + (<|) + + (~~ (static @.jvm)) + "jvm object cast"})] + (<| + (object [] java/lang/ClassLoader [] + [] + (java/lang/ClassLoader (findClass self {class-name java/lang/String}) + (java/lang/Class [? < java/lang/Object]) + #throws [java/lang/ClassNotFoundException] + (let [class-name (:coerce Text class-name) + classes (|> library atom.read io.run)] + (case (dictionary.get class-name classes) + (#.Some bytecode) + (case (..define class-name bytecode (<| self)) + (#error.Success class) + (:assume class) + + (#error.Failure error) + (error! (ex.construct ..cannot-define [class-name error]))) + + #.None + (error! (ex.construct ..unknown [class-name (dictionary.keys classes)])))))))))) (def: #export (store name bytecode library) (-> Text Binary Library (IO (Error Any))) -- cgit v1.2.3