aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/generator/host/jvm/inst.lux40
-rw-r--r--new-luxc/source/luxc/generator/procedure/common.jvm.lux4
-rw-r--r--new-luxc/source/luxc/generator/procedure/host.jvm.lux97
-rw-r--r--new-luxc/source/luxc/generator/runtime.jvm.lux3
-rw-r--r--new-luxc/source/luxc/generator/structure.jvm.lux4
5 files changed, 129 insertions, 19 deletions
diff --git a/new-luxc/source/luxc/generator/host/jvm/inst.lux b/new-luxc/source/luxc/generator/host/jvm/inst.lux
index 7a6215804..efc66f130 100644
--- a/new-luxc/source/luxc/generator/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/generator/host/jvm/inst.lux
@@ -42,6 +42,15 @@
DADD DSUB DMUL DDIV DREM DCMPG DCMPL)
<bit-wise> (declare IAND IOR IXOR ISHL ISHR IUSHR
LAND LOR LXOR LSHL LSHR LUSHR)
+ <array> (declare ARRAYLENGTH NEWARRAY ANEWARRAY
+ AALOAD AASTORE
+ BALOAD BASTORE
+ SALOAD SASTORE
+ IALOAD IASTORE
+ LALOAD LASTORE
+ FALOAD FASTORE
+ DALOAD DASTORE
+ CALOAD CASTORE)
<return> (declare RETURN IRETURN LRETURN DRETURN ARETURN)]
(host;import org.objectweb.asm.Opcodes
(#static NOP int)
@@ -51,8 +60,6 @@
(#static CHECKCAST int)
(#static NEW int)
- (#static NEWARRAY int)
- (#static ANEWARRAY int)
<stack>
<jump>
@@ -64,9 +71,7 @@
<arithmethic>
<bit-wise>
- (#static AALOAD int)
- (#static AASTORE int)
- (#static ARRAYLENGTH int)
+ <array>
(#static GETSTATIC int)
(#static PUTSTATIC int)
@@ -178,7 +183,15 @@
[DCMPG] [DCMPL]
## Array
- [AALOAD] [AASTORE] [ARRAYLENGTH]
+ [ARRAYLENGTH]
+ [AALOAD] [AASTORE]
+ [BALOAD] [BASTORE]
+ [SALOAD] [SASTORE]
+ [IALOAD] [IASTORE]
+ [LALOAD] [LASTORE]
+ [FALOAD] [FASTORE]
+ [DALOAD] [DASTORE]
+ [CALOAD] [CASTORE]
## Exceptions
[ATHROW]
@@ -230,7 +243,7 @@
(do-to visitor
(MethodVisitor.visitIntInsn [Opcodes.NEWARRAY (case type
#$;Boolean Opcodes.T_BOOLEAN
- #$;Byte Opcodes.T_SHORT
+ #$;Byte Opcodes.T_BYTE
#$;Short Opcodes.T_SHORT
#$;Int Opcodes.T_INT
#$;Long Opcodes.T_LONG
@@ -289,12 +302,11 @@
(do-to visitor
(MethodVisitor.visitLabel [@label]))))
-(def: #export (array type size)
- (-> $;Type Nat $;Inst)
+(def: #export (array type)
+ (-> $;Type $;Inst)
(case type
(#$;Primitive prim)
- (|>. (int (nat-to-int size))
- (NEWARRAY prim))
+ (NEWARRAY prim)
(#$;Generic generic)
(let [elem-class (case generic
@@ -303,12 +315,10 @@
_
($t;binary-name "java.lang.Object"))]
- (|>. (int (nat-to-int size))
- (ANEWARRAY elem-class)))
+ (ANEWARRAY elem-class))
_
- (|>. (int (nat-to-int size))
- (ANEWARRAY ($t;descriptor type)))))
+ (ANEWARRAY ($t;descriptor type))))
(def: (primitive-wrapper type)
(-> $;Primitive Text)
diff --git a/new-luxc/source/luxc/generator/procedure/common.jvm.lux b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
index 70f38f962..e3a46a9ea 100644
--- a/new-luxc/source/luxc/generator/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/common.jvm.lux
@@ -81,8 +81,8 @@
(do @
[g!input+ (monad;seq @ (list;repeat arity (macro;gensym "input")))]
(wrap (list (` (def: #export ((~ (code;local-symbol name)) (~ g!proc))
- (-> (-> (Vector (~ (code;nat arity)) $;Inst) $;Inst)
- (-> Text Proc))
+ (-> (-> (;;Vector (~ (code;nat arity)) $;Inst) $;Inst)
+ (-> Text ;;Proc))
(function [(~ g!name)]
(function [(~ g!generate) (~ g!inputs)]
(case (~ g!inputs)
diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
index c99c23385..128e8b517 100644
--- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux
@@ -261,6 +261,102 @@
(@;install "<" (@;binary char//<))
)))
+(def: (array//length arrayI)
+ @;Unary
+ (|>. arrayI
+ $i;ARRAYLENGTH
+ $i;I2L
+ ($i;wrap #$;Long)))
+
+(def: (array//new proc generate inputs)
+ (-> Text @;Proc)
+ (case inputs
+ (^ (list (#ls;Nat level) (#ls;Text class) lengthS))
+ (do macro;Monad<Lux>
+ [lengthI (generate lengthS)
+ #let [arrayJT ($t;array level (case class
+ "boolean" $t;boolean
+ "byte" $t;byte
+ "short" $t;short
+ "int" $t;int
+ "long" $t;long
+ "float" $t;float
+ "double" $t;double
+ "char" $t;char
+ _ ($t;class class (list))))]]
+ (wrap (|>. lengthI
+ ($i;unwrap #$;Long)
+ $i;L2I
+ ($i;array arrayJT))))
+
+ _
+ (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: (array//read proc generate inputs)
+ (-> Text @;Proc)
+ (case inputs
+ (^ (list (#ls;Text class) idxS arrayS))
+ (do macro;Monad<Lux>
+ [arrayI (generate arrayS)
+ idxI (generate idxS)
+ #let [loadI (case class
+ "boolean" (|>. $i;BALOAD ($i;wrap #$;Boolean))
+ "byte" (|>. $i;BALOAD ($i;wrap #$;Byte))
+ "short" (|>. $i;SALOAD ($i;wrap #$;Short))
+ "int" (|>. $i;IALOAD ($i;wrap #$;Int))
+ "long" (|>. $i;LALOAD ($i;wrap #$;Long))
+ "float" (|>. $i;FALOAD ($i;wrap #$;Float))
+ "double" (|>. $i;DALOAD ($i;wrap #$;Double))
+ "char" (|>. $i;CALOAD ($i;wrap #$;Char))
+ _ $i;AALOAD)]]
+ (wrap (|>. arrayI
+ idxI
+ ($i;unwrap #$;Long)
+ $i;L2I
+ loadI)))
+
+ _
+ (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: (array//write proc generate inputs)
+ (-> Text @;Proc)
+ (case inputs
+ (^ (list (#ls;Text class) idxS valueS arrayS))
+ (do macro;Monad<Lux>
+ [arrayI (generate arrayS)
+ idxI (generate idxS)
+ valueI (generate valueS)
+ #let [storeI (case class
+ "boolean" (|>. ($i;unwrap #$;Boolean) $i;BASTORE)
+ "byte" (|>. ($i;unwrap #$;Byte) $i;BASTORE)
+ "short" (|>. ($i;unwrap #$;Short) $i;SASTORE)
+ "int" (|>. ($i;unwrap #$;Int) $i;IASTORE)
+ "long" (|>. ($i;unwrap #$;Long) $i;LASTORE)
+ "float" (|>. ($i;unwrap #$;Float) $i;FASTORE)
+ "double" (|>. ($i;unwrap #$;Double) $i;DASTORE)
+ "char" (|>. ($i;unwrap #$;Char) $i;CASTORE)
+ _ $i;AASTORE)]]
+ (wrap (|>. arrayI
+ $i;DUP
+ idxI
+ ($i;unwrap #$;Long)
+ $i;L2I
+ valueI
+ storeI)))
+
+ _
+ (&;fail (format "Wrong syntax for '" proc "'."))))
+
+(def: array-procs
+ @;Bundle
+ (<| (@;prefix "array")
+ (|> (dict;new text;Hash<Text>)
+ (@;install "length" (@;unary array//length))
+ (@;install "new" array//new)
+ (@;install "read" array//read)
+ (@;install "write" array//write)
+ )))
+
(def: #export procedures
@;Bundle
(<| (@;prefix "jvm")
@@ -271,4 +367,5 @@
(dict;merge float-procs)
(dict;merge double-procs)
(dict;merge char-procs)
+ (dict;merge array-procs)
)))
diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux
index c073e7da0..4c8784364 100644
--- a/new-luxc/source/luxc/generator/runtime.jvm.lux
+++ b/new-luxc/source/luxc/generator/runtime.jvm.lux
@@ -94,7 +94,8 @@
($t;method (list $t;int $Object $Object)
(#;Some $Variant)
(list))
- (|>. ($i;array $Object +3)
+ (|>. ($i;int 3)
+ ($i;array $Object)
store-tagI
store-flagI
store-valueI
diff --git a/new-luxc/source/luxc/generator/structure.jvm.lux b/new-luxc/source/luxc/generator/structure.jvm.lux
index a89f3083f..6aca0dca1 100644
--- a/new-luxc/source/luxc/generator/structure.jvm.lux
+++ b/new-luxc/source/luxc/generator/structure.jvm.lux
@@ -36,7 +36,9 @@
memberI
$i;AASTORE)))))
(:: @ map $i;fuse))]
- (wrap (|>. ($i;array $Object size) membersI))))
+ (wrap (|>. ($i;int (nat-to-int size))
+ ($i;array $Object)
+ membersI))))
(def: (flagI tail?)
(-> Bool $;Inst)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 15:35:27 +0000