aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm.lux3
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/def.lux173
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux47
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux30
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux6
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>]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 11:16:19 +0000