diff options
Diffstat (limited to 'lux-jvm/source/luxc/lang/translation/jvm.lux')
| -rw-r--r-- | lux-jvm/source/luxc/lang/translation/jvm.lux | 182 |
1 files changed, 182 insertions, 0 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux new file mode 100644 index 000000000..141e70184 --- /dev/null +++ b/lux-jvm/source/luxc/lang/translation/jvm.lux @@ -0,0 +1,182 @@ +(.module: + [lux (#- Module Definition) + ["." host (#+ import: do-to object)] + [abstract + [monad (#+ do)]] + [control + pipe + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["." io (#+ IO io)] + [concurrency + ["." atom (#+ Atom atom)]]] + [data + [binary (#+ Binary)] + ["." product] + ["." text ("#@." hash) + ["%" format (#+ format)]] + [collection + ["." array] + ["." dictionary (#+ Dictionary)]]] + [target + [jvm + ["." loader (#+ Library)] + ["." type + ["." descriptor]]]] + [tool + [compiler + [language + [lux + ["." generation]]] + ["." meta + [io (#+ lux-context)] + [archive + [descriptor (#+ Module)] + ["." artifact]]]]]] + [/// + [host + ["." jvm (#+ Inst Definition Host State) + ["." def] + ["." inst]]]] + ) + +(import: #long java/lang/reflect/Field + (get [#? java/lang/Object] #try #? java/lang/Object)) + +(import: #long (java/lang/Class a) + (getField [java/lang/String] #try java/lang/reflect/Field)) + +(import: #long java/lang/Object + (getClass [] (java/lang/Class java/lang/Object))) + +(import: #long java/lang/ClassLoader) + +(type: #export ByteCode Binary) + +(def: #export value-field Text "_value") +(def: #export $Value (type.class "java.lang.Object" (list))) + +(exception: #export (cannot-load {class Text} {error Text}) + (exception.report + ["Class" class] + ["Error" error])) + +(exception: #export (invalid-field {class Text} {field Text} {error Text}) + (exception.report + ["Class" class] + ["Field" field] + ["Error" error])) + +(exception: #export (invalid-value {class Text}) + (exception.report + ["Class" class])) + +(def: (class-value class-name class) + (-> Text (java/lang/Class java/lang/Object) (Try Any)) + (case (java/lang/Class::getField ..value-field class) + (#try.Success field) + (case (java/lang/reflect/Field::get #.None field) + (#try.Success ?value) + (case ?value + (#.Some value) + (#try.Success value) + + #.None + (exception.throw ..invalid-value class-name)) + + (#try.Failure error) + (exception.throw ..cannot-load [class-name error])) + + (#try.Failure error) + (exception.throw ..invalid-field [class-name ..value-field error]))) + +(def: class-path-separator ".") + +(def: #export bytecode-name + (-> Text Text) + (text.replace-all ..class-path-separator .module-separator)) + +(def: #export (class-name [module-id artifact-id]) + (-> generation.Context Text) + (format lux-context + ..class-path-separator (%.nat meta.version) + ..class-path-separator (%.nat module-id) + ..class-path-separator (%.nat artifact-id))) + +(def: (evaluate! library loader eval-class valueI) + (-> Library java/lang/ClassLoader Text Inst (Try [Any Definition])) + (let [bytecode-name (..bytecode-name eval-class) + bytecode (def.class #jvm.V1_6 + #jvm.Public jvm.noneC + bytecode-name + (list) $Value + (list) + (|>> (def.field #jvm.Public ($_ jvm.++F jvm.finalF jvm.staticF) + ..value-field ..$Value) + (def.method #jvm.Public ($_ jvm.++M jvm.staticM jvm.strictM) + "<clinit>" + (type.method [(list) type.void (list)]) + (|>> valueI + (inst.PUTSTATIC (type.class bytecode-name (list)) ..value-field ..$Value) + inst.RETURN))))] + (io.run (do (try.with io.monad) + [_ (loader.store eval-class bytecode library) + class (loader.load eval-class loader) + value (:: io.monad wrap (..class-value eval-class class))] + (wrap [value + [eval-class bytecode]]))))) + +(def: (execute! library loader temp-label [class-name class-bytecode]) + (-> Library java/lang/ClassLoader Text Definition (Try Any)) + (io.run (do (try.with io.monad) + [existing-class? (|> (atom.read library) + (:: io.monad map (dictionary.contains? class-name)) + (try.lift io.monad) + (: (IO (Try Bit)))) + _ (if existing-class? + (wrap []) + (loader.store class-name class-bytecode library))] + (loader.load class-name loader)))) + +(def: (define! library loader context valueI) + (-> Library java/lang/ClassLoader generation.Context Inst (Try [Text Any Definition])) + (let [class-name (..class-name context)] + (do try.monad + [[value definition] (evaluate! library loader class-name valueI)] + (wrap [class-name value definition])))) + +(def: #export host + (IO Host) + (io (let [library (loader.new-library []) + loader (loader.memory library)] + (: Host + (structure + (def: (evaluate! temp-label valueI) + (:: try.monad map product.left + (..evaluate! library loader (text.replace-all " " "$" temp-label) valueI))) + + (def: execute! + (..execute! library loader)) + + (def: define! + (..define! library loader)) + + (def: (ingest context bytecode) + [(..class-name context) bytecode]) + + (def: (re-learn context [_ bytecode]) + (io.run + (loader.store (..class-name context) bytecode library))) + + (def: (re-load context [_ bytecode]) + (io.run + (do (try.with io.monad) + [#let [class-name (..class-name context)] + _ (loader.store class-name bytecode library) + class (loader.load class-name loader)] + (:: io.monad wrap (..class-value class-name class)))))))))) + +(def: #export $Variant (type.array ..$Value)) +(def: #export $Tuple (type.array ..$Value)) +(def: #export $Runtime (type.class (..class-name [0 0]) (list))) +(def: #export $Function (type.class (..class-name [0 1]) (list))) |