From 4b672d27a1a1a79643c43cf06917072cc97c1289 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 12 Oct 2017 18:14:19 -0400
Subject: - Compilation and tests for arrays.

---
 .../source/luxc/generator/procedure/common.jvm.lux |  4 +-
 .../source/luxc/generator/procedure/host.jvm.lux   | 97 ++++++++++++++++++++++
 2 files changed, 99 insertions(+), 2 deletions(-)

(limited to 'new-luxc/source/luxc/generator/procedure')

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)
           )))
-- 
cgit v1.2.3