diff options
Diffstat (limited to 'new-luxc/source/luxc')
-rw-r--r-- | new-luxc/source/luxc/lang/host/jvm.lux | 3 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/def.lux | 173 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/inst.lux | 47 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm.lux | 30 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux | 6 |
5 files changed, 131 insertions, 128 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm.lux b/new-luxc/source/luxc/lang/host/jvm.lux index cb5bb46fb..49f02c0f0 100644 --- a/new-luxc/source/luxc/lang/host/jvm.lux +++ b/new-luxc/source/luxc/lang/host/jvm.lux @@ -151,7 +151,8 @@ ## Labels (def: #export new-label (-> Any Label) - org/objectweb/asm/Label::new) + (function (_ _) + (org/objectweb/asm/Label::new))) (def: #export (simple-class name) (-> Text Class) diff --git a/new-luxc/source/luxc/lang/host/jvm/def.lux b/new-luxc/source/luxc/lang/host/jvm/def.lux index ff31157b0..e8efe306b 100644 --- a/new-luxc/source/luxc/lang/host/jvm/def.lux +++ b/new-luxc/source/luxc/lang/host/jvm/def.lux @@ -77,43 +77,43 @@ (def: (version-flag version) (-> $.Version Int) (case version - #$.V1_1 Opcodes::V1_1 - #$.V1_2 Opcodes::V1_2 - #$.V1_3 Opcodes::V1_3 - #$.V1_4 Opcodes::V1_4 - #$.V1_5 Opcodes::V1_5 - #$.V1_6 Opcodes::V1_6 - #$.V1_7 Opcodes::V1_7 - #$.V1_8 Opcodes::V1_8)) + #$.V1_1 (Opcodes::V1_1) + #$.V1_2 (Opcodes::V1_2) + #$.V1_3 (Opcodes::V1_3) + #$.V1_4 (Opcodes::V1_4) + #$.V1_5 (Opcodes::V1_5) + #$.V1_6 (Opcodes::V1_6) + #$.V1_7 (Opcodes::V1_7) + #$.V1_8 (Opcodes::V1_8))) (def: (visibility-flag visibility) (-> $.Visibility Int) (case visibility - #$.Public Opcodes::ACC_PUBLIC - #$.Protected Opcodes::ACC_PROTECTED - #$.Private Opcodes::ACC_PRIVATE + #$.Public (Opcodes::ACC_PUBLIC) + #$.Protected (Opcodes::ACC_PROTECTED) + #$.Private (Opcodes::ACC_PRIVATE) #$.Default +0)) (def: (class-flags config) (-> $.Class-Config Int) ($_ i/+ - (if (get@ #$.finalC config) Opcodes::ACC_FINAL +0))) + (if (get@ #$.finalC config) (Opcodes::ACC_FINAL) +0))) (def: (method-flags config) (-> $.Method-Config Int) ($_ i/+ - (if (get@ #$.staticM config) Opcodes::ACC_STATIC +0) - (if (get@ #$.finalM config) Opcodes::ACC_FINAL +0) - (if (get@ #$.synchronizedM config) Opcodes::ACC_SYNCHRONIZED +0) - (if (get@ #$.strictM config) Opcodes::ACC_STRICT +0))) + (if (get@ #$.staticM config) (Opcodes::ACC_STATIC) +0) + (if (get@ #$.finalM config) (Opcodes::ACC_FINAL) +0) + (if (get@ #$.synchronizedM config) (Opcodes::ACC_SYNCHRONIZED) +0) + (if (get@ #$.strictM config) (Opcodes::ACC_STRICT) +0))) (def: (field-flags config) (-> $.Field-Config Int) ($_ i/+ - (if (get@ #$.staticF config) Opcodes::ACC_STATIC +0) - (if (get@ #$.finalF config) Opcodes::ACC_FINAL +0) - (if (get@ #$.transientF config) Opcodes::ACC_TRANSIENT +0) - (if (get@ #$.volatileF config) Opcodes::ACC_VOLATILE +0))) + (if (get@ #$.staticF config) (Opcodes::ACC_STATIC) +0) + (if (get@ #$.finalF config) (Opcodes::ACC_FINAL) +0) + (if (get@ #$.transientF config) (Opcodes::ACC_TRANSIENT) +0) + (if (get@ #$.volatileF config) (Opcodes::ACC_VOLATILE) +0))) (def: class-to-type (-> $.Class $.Type) @@ -150,8 +150,8 @@ (def: class-computes Int ($_ i/+ - ClassWriter::COMPUTE_MAXS - ## ClassWriter::COMPUTE_FRAMES + (ClassWriter::COMPUTE_MAXS) + ## (ClassWriter::COMPUTE_FRAMES) )) (do-template [<name> <flag>] @@ -160,24 +160,24 @@ (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) $.Class (List $.Class) $.Def (host.type (Array byte))) (let [writer (|> (do-to (ClassWriter::new class-computes) - (ClassWriter::visit [(version-flag version) - ($_ i/+ - Opcodes::ACC_SUPER - <flag> - (visibility-flag visibility) - (class-flags config)) - ($t.binary-name name) - (parameters-signature parameters super interfaces) - (|> super product.left $t.binary-name) - (|> interfaces - (list/map (|>> product.left $t.binary-name)) - string-array)])) + (ClassWriter::visit (version-flag version) + ($_ i/+ + (Opcodes::ACC_SUPER) + <flag> + (visibility-flag visibility) + (class-flags config)) + ($t.binary-name name) + (parameters-signature parameters super interfaces) + (|> super product.left $t.binary-name) + (|> interfaces + (list/map (|>> product.left $t.binary-name)) + string-array))) definitions) - _ (ClassWriter::visitEnd [] writer)] - (ClassWriter::toByteArray [] writer)))] + _ (ClassWriter::visitEnd writer)] + (ClassWriter::toByteArray writer)))] [class +0] - [abstract Opcodes::ACC_ABSTRACT] + [abstract (Opcodes::ACC_ABSTRACT)] ) (def: $Object $.Class ["java.lang.Object" (list)]) @@ -187,82 +187,83 @@ (-> $.Version $.Visibility $.Class-Config Text (List $.Parameter) (List $.Class) $.Def (host.type (Array byte))) (let [writer (|> (do-to (ClassWriter::new class-computes) - (ClassWriter::visit [(version-flag version) - ($_ i/+ - Opcodes::ACC_SUPER - Opcodes::ACC_INTERFACE - (visibility-flag visibility) - (class-flags config)) - ($t.binary-name name) - (parameters-signature parameters $Object interfaces) - (|> $Object product.left $t.binary-name) - (|> interfaces - (list/map (|>> product.left $t.binary-name)) - string-array)])) + (ClassWriter::visit (version-flag version) + ($_ i/+ + (Opcodes::ACC_SUPER) + (Opcodes::ACC_INTERFACE) + (visibility-flag visibility) + (class-flags config)) + ($t.binary-name name) + (parameters-signature parameters $Object interfaces) + (|> $Object product.left $t.binary-name) + (|> interfaces + (list/map (|>> product.left $t.binary-name)) + string-array))) definitions) - _ (ClassWriter::visitEnd [] writer)] - (ClassWriter::toByteArray [] writer))) + _ (ClassWriter::visitEnd writer)] + (ClassWriter::toByteArray writer))) (def: #export (method visibility config name type then) (-> $.Visibility $.Method-Config Text $.Method $.Inst $.Def) (function (_ writer) - (let [=method (ClassWriter::visitMethod [($_ i/+ - (visibility-flag visibility) - (method-flags config)) - ($t.binary-name name) - ($t.method-descriptor type) - ($t.method-signature type) - (exceptions-array type)] + (let [=method (ClassWriter::visitMethod ($_ i/+ + (visibility-flag visibility) + (method-flags config)) + ($t.binary-name name) + ($t.method-descriptor type) + ($t.method-signature type) + (exceptions-array type) writer) - _ (MethodVisitor::visitCode [] =method) + _ (MethodVisitor::visitCode =method) _ (then =method) - _ (MethodVisitor::visitMaxs [+0 +0] =method) - _ (MethodVisitor::visitEnd [] =method)] + _ (MethodVisitor::visitMaxs +0 +0 =method) + _ (MethodVisitor::visitEnd =method)] writer))) (def: #export (abstract-method visibility config name type) (-> $.Visibility $.Method-Config Text $.Method $.Def) (function (_ writer) - (let [=method (ClassWriter::visitMethod [($_ i/+ - (visibility-flag visibility) - (method-flags config) - Opcodes::ACC_ABSTRACT) - ($t.binary-name name) - ($t.method-descriptor type) - ($t.method-signature type) - (exceptions-array type)] + (let [=method (ClassWriter::visitMethod ($_ i/+ + (visibility-flag visibility) + (method-flags config) + (Opcodes::ACC_ABSTRACT)) + ($t.binary-name name) + ($t.method-descriptor type) + ($t.method-signature type) + (exceptions-array type) writer) - _ (MethodVisitor::visitEnd [] =method)] + _ (MethodVisitor::visitEnd =method)] writer))) (def: #export (field visibility config name type) (-> $.Visibility $.Field-Config Text $.Type $.Def) (function (_ writer) - (let [=field (do-to (ClassWriter::visitField [($_ i/+ - (visibility-flag visibility) - (field-flags config)) - ($t.binary-name name) - ($t.descriptor type) - ($t.signature type) - (host.null)] writer) - (FieldVisitor::visitEnd []))] + (let [=field (do-to (ClassWriter::visitField ($_ i/+ + (visibility-flag visibility) + (field-flags config)) + ($t.binary-name name) + ($t.descriptor type) + ($t.signature type) + (host.null) + writer) + (FieldVisitor::visitEnd))] writer))) (do-template [<name> <lux-type> <jvm-type> <prepare>] [(def: #export (<name> visibility config name value) (-> $.Visibility $.Field-Config Text <lux-type> $.Def) (function (_ writer) - (let [=field (do-to (ClassWriter::visitField [($_ i/+ - (visibility-flag visibility) - (field-flags config)) - ($t.binary-name name) - ($t.descriptor <jvm-type>) - ($t.signature <jvm-type>) - (<prepare> value)] + (let [=field (do-to (ClassWriter::visitField ($_ i/+ + (visibility-flag visibility) + (field-flags config)) + ($t.binary-name name) + ($t.descriptor <jvm-type>) + ($t.signature <jvm-type>) + (<prepare> value) writer) - (FieldVisitor::visitEnd []))] + (FieldVisitor::visitEnd))] writer)))] [boolean-field Bit $t.boolean id] diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux index cb8d47960..44ce0839a 100644 --- a/new-luxc/source/luxc/lang/host/jvm/inst.lux +++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux @@ -121,18 +121,18 @@ (def: #export make-label (All [s] (Operation s Label)) (function (_ state) - (#error.Success [state (Label::new [])]))) + (#error.Success [state (Label::new)]))) (def: #export (with-label action) (-> (-> Label Inst) Inst) - (action (Label::new []))) + (action (Label::new))) (do-template [<name> <type> <prepare>] [(def: #export (<name> value) (-> <type> Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitLdcInsn [(<prepare> value)]))))] + (MethodVisitor::visitLdcInsn (<prepare> value)))))] [boolean Bit id] [int Int host.long-to-int] @@ -143,20 +143,20 @@ ) (syntax: (prefix {base s.local-identifier}) - (wrap (list (code.local-identifier (format "Opcodes::" base))))) + (wrap (list (` ((~ (code.local-identifier (format "Opcodes::" base)))))))) (def: #export NULL Inst (function (_ visitor) (do-to visitor - (MethodVisitor::visitInsn [(prefix ACONST_NULL)])))) + (MethodVisitor::visitInsn (prefix ACONST_NULL))))) (do-template [<name>] [(def: #export <name> Inst (function (_ visitor) (do-to visitor - (MethodVisitor::visitInsn [(prefix <name>)]))))] + (MethodVisitor::visitInsn (prefix <name>)))))] [NOP] @@ -217,7 +217,7 @@ (-> Nat Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitVarInsn [(prefix <name>) (.int register)]))))] + (MethodVisitor::visitVarInsn (prefix <name>) (.int register)))))] [ILOAD] [LLOAD] [DLOAD] [ALOAD] [ISTORE] [LSTORE] [ASTORE] @@ -228,7 +228,7 @@ (-> Text Text //.Type Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitFieldInsn [<inst> (type.binary-name class) field (type.descriptor type)]))))] + (MethodVisitor::visitFieldInsn (<inst>) (type.binary-name class) field (type.descriptor type)))))] [GETSTATIC Opcodes::GETSTATIC] [PUTSTATIC Opcodes::PUTSTATIC] @@ -242,7 +242,7 @@ (-> Text Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitTypeInsn [<inst> (type.binary-name class)]))))] + (MethodVisitor::visitTypeInsn (<inst>) (type.binary-name class)))))] [CHECKCAST Opcodes::CHECKCAST] [NEW Opcodes::NEW] @@ -254,22 +254,23 @@ (-> Primitive Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitIntInsn [Opcodes::NEWARRAY (case type - #//.Boolean Opcodes::T_BOOLEAN - #//.Byte Opcodes::T_BYTE - #//.Short Opcodes::T_SHORT - #//.Int Opcodes::T_INT - #//.Long Opcodes::T_LONG - #//.Float Opcodes::T_FLOAT - #//.Double Opcodes::T_DOUBLE - #//.Char Opcodes::T_CHAR)])))) + (MethodVisitor::visitIntInsn (Opcodes::NEWARRAY) + (case type + #//.Boolean (Opcodes::T_BOOLEAN) + #//.Byte (Opcodes::T_BYTE) + #//.Short (Opcodes::T_SHORT) + #//.Int (Opcodes::T_INT) + #//.Long (Opcodes::T_LONG) + #//.Float (Opcodes::T_FLOAT) + #//.Double (Opcodes::T_DOUBLE) + #//.Char (Opcodes::T_CHAR)))))) (do-template [<name> <inst>] [(def: #export (<name> class method-name method-signature interface?) (-> Text Text //.Method Bit Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitMethodInsn [<inst> (type.binary-name class) method-name (type.method-descriptor method-signature) interface?]))))] + (MethodVisitor::visitMethodInsn (<inst>) (type.binary-name class) method-name (type.method-descriptor method-signature) interface?))))] [INVOKESTATIC Opcodes::INVOKESTATIC] [INVOKEVIRTUAL Opcodes::INVOKEVIRTUAL] @@ -282,7 +283,7 @@ (-> //.Label Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitJumpInsn [(prefix <name>) @where]))))] + (MethodVisitor::visitJumpInsn (prefix <name>) @where))))] [IF_ICMPEQ] [IF_ICMPGT] [IF_ICMPLT] [IF_ACMPEQ] [IFNULL] [IFEQ] [IFNE] [IFLT] [IFLE] [IFGT] [IFGE] @@ -302,19 +303,19 @@ (recur (inc idx))) []))] (do-to visitor - (MethodVisitor::visitTableSwitchInsn [min max default labels-array]))))) + (MethodVisitor::visitTableSwitchInsn min max default labels-array))))) (def: #export (try @from @to @handler exception) (-> //.Label //.Label //.Label Text Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitTryCatchBlock [@from @to @handler (type.binary-name exception)])))) + (MethodVisitor::visitTryCatchBlock @from @to @handler (type.binary-name exception))))) (def: #export (label @label) (-> //.Label Inst) (function (_ visitor) (do-to visitor - (MethodVisitor::visitLabel [@label])))) + (MethodVisitor::visitLabel @label)))) (def: #export (array type) (-> //.Type Inst) diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index b8c00c8a4..560994256 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -57,16 +57,16 @@ (def: ClassLoader::defineClass Method - (case (Class::getDeclaredMethod ["defineClass" - (|> (host.array (Class Object) 4) - (host.array-write 0 (:coerce (Class Object) (host.class-for String))) - (host.array-write 1 (Object::getClass [] (host.array byte 0))) - (host.array-write 2 (:coerce (Class Object) Integer::TYPE)) - (host.array-write 3 (:coerce (Class Object) Integer::TYPE)))] + (case (Class::getDeclaredMethod "defineClass" + (|> (host.array (Class Object) 4) + (host.array-write 0 (:coerce (Class Object) (host.class-for String))) + (host.array-write 1 (Object::getClass (host.array byte 0))) + (host.array-write 2 (:coerce (Class Object) (Integer::TYPE))) + (host.array-write 3 (:coerce (Class Object) (Integer::TYPE)))) (host.class-for java/lang/ClassLoader)) (#error.Success method) (do-to method - (AccessibleObject::setAccessible [#1])) + (AccessibleObject::setAccessible #1)) (#error.Error error) (error! error))) @@ -75,11 +75,11 @@ (def: (define-class class-name bytecode loader) (-> Text ByteCode ClassLoader (Error Object)) - (Method::invoke [loader - (array.from-list (list (:coerce Object class-name) - (:coerce Object bytecode) - (:coerce Object (host.long-to-int +0)) - (:coerce Object (host.long-to-int (.int (host.array-length bytecode))))))] + (Method::invoke loader + (array.from-list (list (:coerce Object class-name) + (:coerce Object bytecode) + (:coerce Object (host.long-to-int +0)) + (:coerce Object (host.long-to-int (.int (host.array-length bytecode)))))) ClassLoader::defineClass)) (type: Store (Atom (Dictionary Text ByteCode))) @@ -124,7 +124,7 @@ (def: (load! name loader) (-> Text ClassLoader (Error (Class Object))) - (ClassLoader::loadClass [name] loader)) + (ClassLoader::loadClass name loader)) (def: #export value-field Text "_value") (def: #export $Object jvm.Type (type.class "java.lang.Object" (list))) @@ -143,9 +143,9 @@ (def: (class-value class-name class) (-> Text (Class Object) (Error Any)) - (case (Class::getField [..value-field] class) + (case (Class::getField ..value-field class) (#error.Success field) - (case (Field::get [#.None] field) + (case (Field::get #.None field) (#error.Success ?value) (case ?value (#.Some value) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index e45a6f8cf..e439ecdd6 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -149,9 +149,9 @@ Nullary (|>> <const> (_.wrap <type>)))] - [frac::smallest (_.double Double::MIN_VALUE) #$.Double] - [frac::min (_.double (f/* -1.0 Double::MAX_VALUE)) #$.Double] - [frac::max (_.double Double::MAX_VALUE) #$.Double] + [frac::smallest (_.double (Double::MIN_VALUE)) #$.Double] + [frac::min (_.double (f/* -1.0 (Double::MAX_VALUE))) #$.Double] + [frac::max (_.double (Double::MAX_VALUE)) #$.Double] ) (do-template [<name> <type> <op>] |