From fa37f5d17184db1ed95949352e71542af8fb4ce1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 24 Dec 2019 23:05:30 -0400 Subject: Ported program generation, host environment and packaging machinery to stdlib. --- new-luxc/source/luxc/lang/translation/jvm.lux | 154 -------------------------- 1 file changed, 154 deletions(-) delete mode 100644 new-luxc/source/luxc/lang/translation/jvm.lux (limited to 'new-luxc/source/luxc/lang/translation/jvm.lux') 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 fccbd14bf..000000000 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ /dev/null @@ -1,154 +0,0 @@ -(.module: - [lux (#- 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 - ["." name]]]] - [/// - [host - ["." jvm (#+ Inst Definition Host State) - ["." def] - ["." inst]]]] - ) - -(import: org/objectweb/asm/Label) - -(import: java/lang/reflect/Field - (get [#? Object] #try #? Object)) - -(import: (java/lang/Class a) - (getField [String] #try Field)) - -(import: java/lang/Object - (getClass [] (Class Object))) - -(import: 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 (Class Object) (Try Any)) - (case (Class::getField ..value-field class) - (#try.Success field) - (case (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: (evaluate! library loader eval-class valueI) - (-> Library ClassLoader Text Inst (Try [Any Definition])) - (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) $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 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 [module name] valueI) - (-> Library ClassLoader Name Inst (Try [Text Any Definition])) - (let [class-name (format (text.replace-all .module-separator class-path-separator module) - class-path-separator (name.normalize name) - "___" (%.nat (text@hash name)))] - (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) - (let [eval-class (|> temp-label name.normalize (text.replace-all " " "$"))] - (:: try.monad map product.left - (..evaluate! library loader eval-class valueI)))) - - (def: execute! - (..execute! library loader)) - - (def: define! - (..define! library loader))))))) - -(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))) -- cgit v1.2.3