aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/procedure/host.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/generator/procedure/host.jvm.lux97
1 files changed, 97 insertions, 0 deletions
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)
)))