aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/procedure
diff options
context:
space:
mode:
authorEduardo Julian2017-10-12 18:14:19 -0400
committerEduardo Julian2017-10-12 18:14:19 -0400
commit4b672d27a1a1a79643c43cf06917072cc97c1289 (patch)
tree6136e952c0e87172921ad4bf5c0ee128a085a0ba /new-luxc/source/luxc/generator/procedure
parent50c370878c0f9985a8b6d1003af9e9f6282b853e (diff)
- Compilation and tests for arrays.
Diffstat (limited to 'new-luxc/source/luxc/generator/procedure')
-rw-r--r--new-luxc/source/luxc/generator/procedure/common.jvm.lux4
-rw-r--r--new-luxc/source/luxc/generator/procedure/host.jvm.lux97
2 files changed, 99 insertions, 2 deletions
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)
)))