(.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 "." (%.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) "" (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 $Function (type.class "LuxFunction" (list))) (def: #export $Runtime (type.class "LuxRuntime" (list)))