diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm.lux')
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm.lux | 182 |
1 files changed, 0 insertions, 182 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux deleted file mode 100644 index 141e70184..000000000 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ /dev/null @@ -1,182 +0,0 @@ -(.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))) |