aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux154
1 files changed, 0 insertions, 154 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 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)
- "<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 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)))