From a7fc50b1906fa97fb56d5ebe3d3fff7baee276da Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 5 Mar 2022 04:30:09 -0400
Subject: Optimizations for the pure-Lux JVM compiler. [Part 5]

---
 stdlib/source/unsafe/lux/data/binary.lux           | 483 ++++++++++-----------
 stdlib/source/unsafe/lux/data/collection/array.lux | 409 +++++++++++++++++
 2 files changed, 650 insertions(+), 242 deletions(-)
 create mode 100644 stdlib/source/unsafe/lux/data/collection/array.lux

(limited to 'stdlib/source/unsafe')

diff --git a/stdlib/source/unsafe/lux/data/binary.lux b/stdlib/source/unsafe/lux/data/binary.lux
index 3f542ce73..f5e4d5b4e 100644
--- a/stdlib/source/unsafe/lux/data/binary.lux
+++ b/stdlib/source/unsafe/lux/data/binary.lux
@@ -8,7 +8,8 @@
      [inline {"+" inline:}]]]
    [data
     [collection
-     ["[0]" array]]]
+     ["[0]" array "_"
+      ["[1]" \\unsafe]]]]
    [math
     [number {"+" hex}
      ["[0]" i64]]]]])
@@ -53,273 +54,271 @@
        (type: .public Binary
          (array.Array (I64 Any)))))
 
-(with_expansions [<size> (: Nat size)
-                  <jvm> (ffi.array byte <size>)
-                  <jvm> (: ..Binary <jvm>)]
-  (template: .public (empty size)
-    [(: ..Binary
-        (for [@.old <jvm>
-              @.jvm <jvm>
-
-              @.js
-              (|> <size>
-                  .int
-                  "lux i64 f64"
-                  []
-                  ("js object new" ("js constant" "ArrayBuffer"))
-                  []
-                  ("js object new" ("js constant" "Uint8Array"))
-                  (:as ..Binary))
-
-              @.python
-              (|> <size>
-                  ("python apply" (:as ffi.Function ("python constant" "bytearray")))
-                  (:as ..Binary))
-
-              @.scheme
-              (..make-bytevector <size>)]
-
-             ... Default
-             (array.empty <size>)))]))
-
-(with_expansions [<it> (: ..Binary it)
-                  <jvm> (ffi.length <it>)]
-  (template: .public (size it)
-    [(: Nat
-        (for [@.old <jvm>
-              @.jvm <jvm>
-
-              @.js
-              (|> <it>
-                  ("js object get" "length")
-                  (:as Frac)
-                  "lux f64 i64"
-                  .nat)
-
-              @.python
-              (|> <it>
-                  (:as (array.Array (I64 Any)))
-                  "python array length")
-
-              @.scheme
-              (..bytevector-length [<it>])]
-
-             ... Default
-             (array.size <it>)))]))
+(`` (with_expansions [<size> (.: .Nat size)
+                      <jvm> (ffi.array byte <size>)
+                      <jvm> (.: ..Binary <jvm>)]
+      (template: .public (empty size)
+        [(: ..Binary
+            (for [(~~ (.static @.old)) <jvm>
+                  (~~ (.static @.jvm)) <jvm>
+
+                  (~~ (.static @.js))
+                  (.|> <size>
+                       .int
+                       "lux i64 f64"
+                       []
+                       ("js object new" ("js constant" "ArrayBuffer"))
+                       []
+                       ("js object new" ("js constant" "Uint8Array"))
+                       (.:as ..Binary))
+
+                  (~~ (.static @.python))
+                  (.|> <size>
+                       ("python apply" (.:as ffi.Function ("python constant" "bytearray")))
+                       (.:as ..Binary))
+
+                  (~~ (.static @.scheme))
+                  (..make-bytevector <size>)]
+
+                 ... Default
+                 (array.empty <size>)))])))
+
+(`` (with_expansions [<it> (.: ..Binary it)
+                      <jvm> (ffi.length <it>)]
+      (template: .public (size it)
+        [(.: .Nat
+             (.for [(~~ (.static @.old)) <jvm>
+                    (~~ (.static @.jvm)) <jvm>
+
+                    (~~ (.static @.js))
+                    (.|> <it>
+                         ("js object get" "length")
+                         (.:as .Frac)
+                         "lux f64 i64"
+                         .nat)
+
+                    (~~ (.static @.python))
+                    (.|> <it>
+                         (.:as (array.Array (.I64 .Any)))
+                         "python array length")
+
+                    (~~ (.static @.scheme))
+                    (..bytevector-length [<it>])]
+
+                   ... Default
+                   (array.size <it>)))])))
 
 (def: byte_mask
   Nat
   (i64.mask i64.bits_per_byte))
 
 (with_expansions [<byte_mask> (.static ..byte_mask)
-                  <it> (: ..Binary it)
-                  <index> (: Nat index)
+                  <it> (.: ..Binary it)
+                  <index> (.: .Nat index)
                   <jvm> (ffi.read! <index> <it>)
                   <jvm> (ffi.byte_to_long <jvm>)
-                  <jvm> (|> <jvm>
-                            (:as I64)
-                            ("lux i64 and" <byte_mask>))]
+                  <jvm> (.|> <jvm>
+                             (.:as .I64)
+                             ("lux i64 and" <byte_mask>))]
   (template: .public (bytes/1 index it)
-    [(<| (:as .I64)
-         (: (.I64 .Any))
-         (`` (for [@.old (~~ <jvm>)
-                   @.jvm (~~ <jvm>)
-
-                   @.js
-                   (|> <it>
-                       (:as (array.Array .Frac))
-                       ("js array read" <index>)
-                       "lux f64 i64"
-                       .i64)
-
-                   @.python
-                   (|> <it>
-                       (:as (array.Array .I64))
-                       ("python array read" <index>))
-
-                   @.scheme
-                   (..bytevector-u8-ref [<it> <index>])]
-
-                  ... Default
-                  (.case (array.read! <index> <it>)
-                    {.#Some it}
-                    it
-
-                    {.#None}
-                    (.i64 (: (I64 Any) 0))))))]))
+    [(.<| (.:as .I64)
+          (.: (.I64 .Any))
+          (`` (.for [(~~ (.static @.old)) (~~ <jvm>)
+                     (~~ (.static @.jvm)) (~~ <jvm>)
+
+                     (~~ (.static @.js))
+                     (.|> <it>
+                          (.:as (array.Array .Frac))
+                          ("js array read" <index>)
+                          "lux f64 i64"
+                          .i64)
+
+                     (~~ (.static @.python))
+                     (.|> <it>
+                          (.:as (array.Array .I64))
+                          ("python array read" <index>))
+
+                     (~~ (.static @.scheme))
+                     (..bytevector-u8-ref [<it> <index>])]
+
+                    ... Default
+                    (.if (array.lacks? <index> <it>)
+                      (.i64 0)
+                      (array.item <index> <it>)))))]))
 
 (template: .public (bytes/2 index' it')
-  [(<| (let [index (: Nat index')
-             it (: ..Binary it')])
-       (:as .I64)
-       (: (.I64 .Any))
-       ($_ "lux i64 or"
-           ("lux i64 left-shift" 8 (..bytes/1 index it))
-           (..bytes/1 ("lux i64 +" 1 index) it)))])
+  [(.<| (.let [index (.: Nat index')
+               it (.: ..Binary it')])
+        (.:as .I64)
+        (.: (.I64 .Any))
+        (.$_ "lux i64 or"
+             ("lux i64 left-shift" 8 (..bytes/1 index it))
+             (..bytes/1 ("lux i64 +" 1 index) it)))])
 
 (template: .public (bytes/4 index' it')
-  [(<| (let [index (: Nat index')
-             it (: ..Binary it')])
-       (:as .I64)
-       (: (.I64 .Any))
-       ($_ "lux i64 or"
-           ("lux i64 left-shift" 24 (..bytes/1 index it))
-           ("lux i64 left-shift" 16 (..bytes/1 ("lux i64 +" 1 index) it))
-           ("lux i64 left-shift" 8 (..bytes/1 ("lux i64 +" 2 index) it))
-           (..bytes/1 ("lux i64 +" 3 index) it)))])
+  [(.<| (.let [index (.: Nat index')
+               it (.: ..Binary it')])
+        (.:as .I64)
+        (.: (.I64 .Any))
+        (.$_ "lux i64 or"
+             ("lux i64 left-shift" 24 (..bytes/1 index it))
+             ("lux i64 left-shift" 16 (..bytes/1 ("lux i64 +" 1 index) it))
+             ("lux i64 left-shift" 8 (..bytes/1 ("lux i64 +" 2 index) it))
+             (..bytes/1 ("lux i64 +" 3 index) it)))])
 
 (template: .public (bytes/8 index' it')
-  [(<| (let [index (: Nat index')
-             it (: ..Binary it')])
-       (:as .I64)
-       (: (.I64 .Any))
-       ($_ "lux i64 or"
-           ("lux i64 left-shift" 56 (..bytes/1 index it))
-           ("lux i64 left-shift" 48 (..bytes/1 ("lux i64 +" 1 index) it))
-           ("lux i64 left-shift" 40 (..bytes/1 ("lux i64 +" 2 index) it))
-           ("lux i64 left-shift" 32 (..bytes/1 ("lux i64 +" 3 index) it))
-           ("lux i64 left-shift" 24 (..bytes/1 ("lux i64 +" 4 index) it))
-           ("lux i64 left-shift" 16 (..bytes/1 ("lux i64 +" 5 index) it))
-           ("lux i64 left-shift" 8 (..bytes/1 ("lux i64 +" 6 index) it))
-           (..bytes/1 ("lux i64 +" 7 index) it)))])
+  [(.<| (.let [index (.: Nat index')
+               it (.: ..Binary it')])
+        (.:as .I64)
+        (.: (.I64 .Any))
+        (.$_ "lux i64 or"
+             ("lux i64 left-shift" 56 (..bytes/1 index it))
+             ("lux i64 left-shift" 48 (..bytes/1 ("lux i64 +" 1 index) it))
+             ("lux i64 left-shift" 40 (..bytes/1 ("lux i64 +" 2 index) it))
+             ("lux i64 left-shift" 32 (..bytes/1 ("lux i64 +" 3 index) it))
+             ("lux i64 left-shift" 24 (..bytes/1 ("lux i64 +" 4 index) it))
+             ("lux i64 left-shift" 16 (..bytes/1 ("lux i64 +" 5 index) it))
+             ("lux i64 left-shift" 8 (..bytes/1 ("lux i64 +" 6 index) it))
+             (..bytes/1 ("lux i64 +" 7 index) it)))])
 
 (with_expansions [<byte> (hex "FF")
-                  <it> (: ..Binary it)
-                  <index> (: Nat index)
-                  <value> (: (I64 Any) value)
-                  <jvm_value> (for [@.old
-                                    (:as Int <value>)
-
-                                    @.jvm
-                                    (:as (Primitive "java.lang.Long") <value>)]
-                                   <value>)
+                  <it> (.: ..Binary it)
+                  <index> (.: .Nat index)
+                  <value> (.: (.I64 .Any) value)
+                  <jvm_value> (`` (.for [(~~ (.static @.old))
+                                         (.:as .Int <value>)
+
+                                         (~~ (.static @.jvm))
+                                         (.:as (.Primitive "java.lang.Long") <value>)]
+                                        <value>))
+                  <jvm_value> <jvm_value>
                   <jvm_value> (ffi.long_to_byte <jvm_value>)
                   <jvm> (ffi.write! <index> <jvm_value> <it>)]
-  (template: .public (with/1! index value it)
-    [(: ..Binary
-        (for [@.old <jvm>
-              @.jvm <jvm>
-
-              @.js
-              (|> <it>
-                  (: ..Binary)
-                  (:as (array.Array .Frac))
-                  ("js array write" <index>
-                   (|> <value>
-                       .int
-                       ("lux i64 and" (.int <byte>))
-                       "lux i64 f64"))
-                  (:as ..Binary))
-              
-              @.python
-              (|> <it>
-                  (: ..Binary)
-                  (:as (array.Array (I64 Any)))
-                  ("python array write" <index> (|> <value> ("lux i64 and" <byte>) (: (I64 Any))))
-                  (:as ..Binary))
-              
-              @.scheme
-              (let [it' <it>]
-                (exec
-                  (..bytevector-u8-set! [it' <index> <value>])
-                  it'))]
-
-             ... Default
-             (array.write! <index> (|> <value> .int ("lux i64 and" (.int <byte>))) <it>)))]))
+  (`` (template: .public (with/1! index value it)
+        [(.: ..Binary
+             (.for [(~~ (.static @.old)) <jvm>
+                    (~~ (.static @.jvm)) <jvm>
+
+                    (~~ (.static @.js))
+                    (.|> <it>
+                         (.: ..Binary)
+                         (.:as (array.Array .Frac))
+                         ("js array write" <index>
+                          (.|> <value>
+                               .int
+                               ("lux i64 and" (.int <byte>))
+                               "lux i64 f64"))
+                         (.:as ..Binary))
+                    
+                    (~~ (.static @.python))
+                    (.|> <it>
+                         (.: ..Binary)
+                         (.:as (array.Array (.I64 .Any)))
+                         ("python array write" <index> (.|> <value> ("lux i64 and" <byte>) (.: (.I64 .Any))))
+                         (.:as ..Binary))
+                    
+                    (~~ (.static @.scheme))
+                    (.let [it' <it>]
+                      (.exec
+                        (..bytevector-u8-set! [it' <index> <value>])
+                        it'))]
+
+                   ... Default
+                   (array.has! <index> (.|> <value> .int ("lux i64 and" (.int <byte>))) <it>)))])))
 
 (template: .public (with/2! index' value' it)
-  [(let [index (: Nat index')
-         value (: (I64 Any) value')]
-     (|> it
-         (..with/1! index ("lux i64 right-shift" 8 value))
-         (..with/1! ("lux i64 +" 1 index) value)))])
+  [(.let [index (.: .Nat index')
+          value (.: (.I64 .Any) value')]
+     (.|> it
+          (..with/1! index ("lux i64 right-shift" 8 value))
+          (..with/1! ("lux i64 +" 1 index) value)))])
 
 (template: .public (with/4! index' value' it)
-  [(let [index (: Nat index')
-         value (: (I64 Any) value')]
-     (|> it
-         (..with/1! index ("lux i64 right-shift" 24 value))
-         (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 16 value))
-         (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 8 value))
-         (..with/1! ("lux i64 +" 3 index) value)))])
-
-(template: .public (with/8! index' value' it)
-  [(let [index (: Nat index')
-         value (: (I64 Any) value')]
-     (for [@.scheme (let [write_high (: (-> ..Binary ..Binary)
-                                        (|>> (..with/1! index ("lux i64 right-shift" 56 value))
-                                             (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value))
-                                             (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value))
-                                             (..with/1! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value))))
-                          write_low (: (-> ..Binary ..Binary)
-                                       (|>> (..with/1! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value))
-                                            (..with/1! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value))
-                                            (..with/1! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value))
-                                            (..with/1! ("lux i64 +" 7 index) value)))]
-                      (|> it
-                          write_high
-                          write_low))]
-          (|> it
-              (..with/1! index ("lux i64 right-shift" 56 value))
-              (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value))
-              (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value))
-              (..with/1! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value))
-              (..with/1! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value))
-              (..with/1! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value))
-              (..with/1! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value))
-              (..with/1! ("lux i64 +" 7 index) value))))])
-
-(with_expansions [<reference> (: ..Binary reference')
-                  <sample> (: ..Binary sample')
+  [(.let [index (.: .Nat index')
+          value (.: (.I64 .Any) value')]
+     (.|> it
+          (..with/1! index ("lux i64 right-shift" 24 value))
+          (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 16 value))
+          (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 8 value))
+          (..with/1! ("lux i64 +" 3 index) value)))])
+
+(`` (template: .public (with/8! index' value' it)
+      [(.let [index (.: .Nat index')
+              value (.: (.I64 .Any) value')]
+         (.for [(~~ (.static @.scheme)) (.let [write_high (.: (.-> ..Binary ..Binary)
+                                                              (.|>> (..with/1! index ("lux i64 right-shift" 56 value))
+                                                                    (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value))
+                                                                    (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value))
+                                                                    (..with/1! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value))))
+                                               write_low (.: (.-> ..Binary ..Binary)
+                                                             (.|>> (..with/1! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value))
+                                                                   (..with/1! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value))
+                                                                   (..with/1! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value))
+                                                                   (..with/1! ("lux i64 +" 7 index) value)))]
+                                          (.|> it
+                                               write_high
+                                               write_low))]
+               (.|> it
+                    (..with/1! index ("lux i64 right-shift" 56 value))
+                    (..with/1! ("lux i64 +" 1 index) ("lux i64 right-shift" 48 value))
+                    (..with/1! ("lux i64 +" 2 index) ("lux i64 right-shift" 40 value))
+                    (..with/1! ("lux i64 +" 3 index) ("lux i64 right-shift" 32 value))
+                    (..with/1! ("lux i64 +" 4 index) ("lux i64 right-shift" 24 value))
+                    (..with/1! ("lux i64 +" 5 index) ("lux i64 right-shift" 16 value))
+                    (..with/1! ("lux i64 +" 6 index) ("lux i64 right-shift" 8 value))
+                    (..with/1! ("lux i64 +" 7 index) value))))]))
+
+(with_expansions [<reference> (.: ..Binary reference')
+                  <sample> (.: ..Binary sample')
                   <jvm> (java/util/Arrays::equals <reference> <sample>)
                   <jvm> (ffi.of_boolean <jvm>)]
-  (template: .public (= reference' sample')
-    [(for [@.old <jvm>
-           @.jvm <jvm>]
-          (let [reference <reference>
-                sample <sample>
-                limit (..size reference)]
-            (and ("lux i64 =" limit (..size sample))
-                 (loop [index 0]
-                   (if ("lux i64 =" limit index)
-                     true
-                     (and ("lux i64 ="
-                           (..bytes/1 index reference)
-                           (..bytes/1 index sample))
-                          (again (++ index))))))))]))
+  (`` (template: .public (= reference' sample')
+        [(.for [(~~ (.static @.old)) <jvm>
+                (~~ (.static @.jvm)) <jvm>]
+               (.let [reference <reference>
+                      sample <sample>
+                      limit (..size reference)]
+                 (.and ("lux i64 =" limit (..size sample))
+                       (.loop [index 0]
+                         (.if ("lux i64 =" limit index)
+                           .true
+                           (.and ("lux i64 ="
+                                  (..bytes/1 index reference)
+                                  (..bytes/1 index sample))
+                                 (again ("lux i64 +" 1 index))))))))])))
 
 ... TODO: Turn into a template ASAP.
-(inline: .public (copy! bytes source_offset source target_offset target)
-  (-> Nat Nat ..Binary Nat ..Binary ..Binary)
-  (with_expansions [<jvm> (java/lang/System::arraycopy source (ffi.as_int (.int source_offset))
-                                                       target (ffi.as_int (.int target_offset))
-                                                       (ffi.as_int (.int bytes)))
-                    <jvm> (exec
-                            <jvm>
-                            target)]
-    (for [@.old <jvm>
-          @.jvm <jvm>]
-         
-         ... Default
-         (loop [index 0]
-           (if ("lux i64 <" (.int bytes) (.int index))
-             (exec
-               (..with/1! ("lux i64 +" target_offset index)
-                          (..bytes/1 ("lux i64 +" source_offset index) source)
-                          target)
-               (again (++ index)))
-             target)))))
+(`` (inline: .public (copy! bytes source_offset source target_offset target)
+      (-> .Nat .Nat ..Binary Nat ..Binary ..Binary)
+      (with_expansions [<jvm> (java/lang/System::arraycopy source (ffi.as_int (.int source_offset))
+                                                           target (ffi.as_int (.int target_offset))
+                                                           (ffi.as_int (.int bytes)))
+                        <jvm> (.exec
+                                <jvm>
+                                target)]
+        (.for [(~~ (.static @.old)) <jvm>
+               (~~ (.static @.jvm)) <jvm>]
+              
+              ... Default
+              (.loop [index 0]
+                (.if ("lux i64 <" (.int bytes) (.int index))
+                  (.exec
+                    (..with/1! ("lux i64 +" target_offset index)
+                               (..bytes/1 ("lux i64 +" source_offset index) source)
+                               target)
+                    (again ("lux i64 +" 1 index)))
+                  target))))))
 
 ... TODO: Turn into a template ASAP.
-(with_expansions [<jvm> (java/util/Arrays::copyOfRange binary
-                                                       (ffi.as_int (.int offset))
-                                                       (ffi.as_int (.int limit)))
-                  <jvm> (let [limit ("lux i64 +" size offset)]
-                          <jvm>)]
-  (inline: .public (slice offset size binary)
-    (-> Nat Nat ..Binary ..Binary)
-    (for [@.old <jvm>
-          @.jvm <jvm>]
-         
-         ... Default
-         (..copy! size offset binary 0 (..empty size)))))
+(`` (with_expansions [<jvm> (java/util/Arrays::copyOfRange binary
+                                                           (ffi.as_int (.int offset))
+                                                           (ffi.as_int (.int limit)))
+                      <jvm> (.let [limit ("lux i64 +" size offset)]
+                              <jvm>)]
+      (inline: .public (slice offset size binary)
+        (-> .Nat .Nat ..Binary ..Binary)
+        (.for [(~~ (.static @.old)) <jvm>
+               (~~ (.static @.jvm)) <jvm>]
+              
+              ... Default
+              (..copy! size offset binary 0 (..empty size))))))
diff --git a/stdlib/source/unsafe/lux/data/collection/array.lux b/stdlib/source/unsafe/lux/data/collection/array.lux
new file mode 100644
index 000000000..cd6bebf63
--- /dev/null
+++ b/stdlib/source/unsafe/lux/data/collection/array.lux
@@ -0,0 +1,409 @@
+(.using
+ [library
+  [lux {"-" type list}
+   ["@" target]
+   [abstract
+    ["[0]" functor]]
+   [data
+    [collection
+     ["[0]" list]]]]])
+
+(def: .public type
+  "#Array")
+
+(type: .public (Array a)
+  {.#Primitive ..type {.#Item a {.#End}}})
+
+(with_expansions [<index_type> (.Primitive "java.lang.Long")
+                  <elem_type> (.Primitive "java.lang.Object")
+                  <array_type> (.type (..Array <elem_type>))]
+  (for [@.jvm
+        (template: (int! value)
+          [(.|> value
+                (.:as <index_type>)
+                "jvm object cast"
+                "jvm conversion long-to-int")])]
+       (as_is))
+  
+  (`` (template: .public (empty <size>)
+        [((.: (.All (_ a) (.-> .Nat (..Array a)))
+              (.function (empty size)
+                (.for [(~~ (.static @.old))
+                       (.:expected ("jvm anewarray" "(java.lang.Object )" size))
+
+                       (~~ (.static @.jvm))
+                       (|> (~~ (..int! size))
+                           "jvm array new object"
+                           (.: <array_type>)
+                           .:expected)
+
+                       (~~ (.static @.js)) ("js array new" size)
+                       (~~ (.static @.python)) ("python array new" size)
+                       (~~ (.static @.lua)) ("lua array new" size)
+                       (~~ (.static @.ruby)) ("ruby array new" size)
+                       (~~ (.static @.php)) ("php array new" size)
+                       (~~ (.static @.scheme)) ("scheme array new" size)])))
+          <size>)]))
+
+  (`` (template: .public (size <array>)
+        [((.: (.All (_ a) (.-> (..Array a) .Nat))
+              (.function (size array)
+                (.for [(~~ (.static @.old))
+                       ("jvm arraylength" array)
+
+                       (~~ (.static @.jvm))
+                       (.|> array
+                            (.:as <array_type>)
+                            "jvm array length object"
+                            "jvm conversion int-to-long"
+                            "jvm object cast"
+                            (.: <index_type>)
+                            (.:as .Nat))
+
+                       (~~ (.static @.js)) ("js array length" array)
+                       (~~ (.static @.python)) ("python array length" array)
+                       (~~ (.static @.lua)) ("lua array length" array)
+                       (~~ (.static @.ruby)) ("ruby array length" array)
+                       (~~ (.static @.php)) ("php array length" array)
+                       (~~ (.static @.scheme)) ("scheme array length" array)])))
+          <array>)]))
+
+  (template: (lacks?' <read!> <null?> index array)
+    [(<null?> (<read!> index array))])
+
+  (`` (template: .public (lacks? <index> <array>)
+        [((.: (.All (_ a)
+                (.-> .Nat (..Array a) .Bit))
+              (.function (lacks? index array)
+                (.let [size (..size array)]
+                  (.if ("lux i64 <" (.int size) (.int index))
+                    (.for [(~~ (.static @.old))
+                           ("jvm object null?" ("jvm aaload" array index))
+
+                           (~~ (.static @.jvm))
+                           (.|> array
+                                (.:as <array_type>)
+                                ("jvm array read object" (~~ (int! index)))
+                                "jvm object null?")
+
+                           (~~ (.static @.js)) (~~ (lacks?' "js array read" "js object undefined?" index array))
+                           (~~ (.static @.python)) (~~ (lacks?' "python array read" "python object none?" index array))
+                           (~~ (.static @.lua)) (~~ (lacks?' "lua array read" "lua object nil?" index array))
+                           (~~ (.static @.ruby)) (~~ (lacks?' "ruby array read" "ruby object nil?" index array))
+                           (~~ (.static @.php)) (~~ (lacks?' "php array read" "php object null?" index array))
+                           (~~ (.static @.scheme)) (~~ (lacks?' "scheme array read" "scheme object nil?" index array))])
+                    .true))))
+          <index> <array>)]))
+
+  (`` (template: .public (item <index> <array>)
+        [((.: (.All (_ a)
+                (.-> .Nat (..Array a) a))
+              (.function (item index array)
+                (.for [(~~ (.static @.old))
+                       ("jvm aaload" array index)
+
+                       (~~ (.static @.jvm))
+                       (.|> array
+                            (.:as <array_type>)
+                            ("jvm array read object" (~~ (int! index)))
+                            .:expected)
+
+                       (~~ (.static @.js)) ("js array read" index array)
+                       (~~ (.static @.python)) ("python array read" index array)
+                       (~~ (.static @.lua)) ("lua array read" index array)
+                       (~~ (.static @.ruby)) ("ruby array read" index array)
+                       (~~ (.static @.php)) ("php array read" index array)
+                       (~~ (.static @.scheme)) ("scheme array read" index array)])))
+          <index> <array>)]))
+
+  (`` (template: .public (has! <index> <value> <array>)
+        [((.: (.All (_ a)
+                (.-> .Nat a (..Array a) (..Array a)))
+              (.function (has! index value array)
+                (.for [(~~ (.static @.old))
+                       ("jvm aastore" array index value)
+
+                       (~~ (.static @.jvm))
+                       (.|> array
+                            (.:as <array_type>)
+                            ("jvm array write object" (~~ (int! index)) (.:as <elem_type> value))
+                            .:expected)
+
+                       (~~ (.static @.js)) ("js array write" index value array)
+                       (~~ (.static @.python)) ("python array write" index value array)
+                       (~~ (.static @.lua)) ("lua array write" index value array)
+                       (~~ (.static @.ruby)) ("ruby array write" index value array)
+                       (~~ (.static @.php)) ("php array write" index value array)
+                       (~~ (.static @.scheme)) ("scheme array write" index value array)])))
+          <index> <value> <array>)]))
+
+  (`` (template: .public (lacks! <index> <array>)
+        [((.: (.All (_ a)
+                (.-> .Nat (..Array a) (..Array a)))
+              (.function (lacks! index array)
+                (.let [size (..size array)]
+                  (.if ("lux i64 <" (.int size) (.int index))
+                    (.for [(~~ (.static @.old))
+                           (..has! index (.:expected ("jvm object null")) array)
+                           
+                           (~~ (.static @.jvm))
+                           (..has! index (.:expected (: <elem_type> ("jvm object null"))) array)
+
+                           (~~ (.static @.js)) ("js array delete" index array)
+                           (~~ (.static @.python)) ("python array delete" index array)
+                           (~~ (.static @.lua)) ("lua array delete" index array)
+                           (~~ (.static @.ruby)) ("ruby array delete" index array)
+                           (~~ (.static @.php)) ("php array delete" index array)
+                           (~~ (.static @.scheme)) ("scheme array delete" index array)])
+                    array))))
+          <index> <array>)]))
+  )
+
+(template: .public (revised! <index> <$> <array>)
+  [((.: (.All (_ a)
+          (.-> .Nat (.-> a a) (..Array a) (..Array a)))
+        (.function (revised! index $ array)
+          (.if (..lacks? index array)
+            array
+            (..has! index ($ (..item index array)) array))))
+    <index> <$> <array>)])
+
+(template: .public (upsert! <index> <default> <$> <array>)
+  [((.: (.All (_ a)
+          (.-> .Nat a (.-> a a) (..Array a) (..Array a)))
+        (.function (upsert! index default $ array)
+          (..has! index
+                  ($ (.if (..lacks? index array)
+                       default
+                       (..item index array)))
+                  array)))
+    <index> <default> <$> <array>)])
+
+(template: .public (copy! <length> <src_start> <src_array> <dest_start> <dest_array>)
+  [((.: (.All (_ a)
+          (.-> .Nat .Nat (..Array a) .Nat (..Array a)
+               (..Array a)))
+        (.function (copy! length src_start src_array dest_start dest_array)
+          (.loop [offset 0]
+            (.if ("lux i64 <" (.int length) (.int offset))
+              (.exec
+                (.if (..lacks? ("lux i64 +" offset src_start) src_array)
+                  (..lacks! ("lux i64 +" offset dest_start) dest_array)
+                  (..has! ("lux i64 +" offset dest_start)
+                          (..item ("lux i64 +" offset src_start) src_array)
+                          dest_array))
+                (again ("lux i64 +" 1 offset)))
+              dest_array))))
+    <length> <src_start> <src_array> <dest_start> <dest_array>)])
+
+(template [<name> <when_lacks> <when_has>]
+  [(template: .public (<name> <array>)
+     [((.: (.All (_ a) (.-> (..Array a) .Nat))
+           (.function (occupancy array)
+             (.let [size (..size array)]
+               (.loop [index 0
+                       it 0]
+                 (.if ("lux i64 <" (.int size) (.int index))
+                   (.if (..lacks? index array)
+                     (again ("lux i64 +" 1 index) <when_lacks>)
+                     (again ("lux i64 +" 1 index) <when_has>))
+                   it)))))
+       <array>)])]
+
+  [occupancy it ("lux i64 +" 1 it)]
+  [vacancy ("lux i64 +" 1 it) it]
+  )
+
+(template: .public (only! <?> <it>)
+  [((.: (.All (_ a)
+          (.-> (.-> a .Bit) (..Array a) (..Array a)))
+        (.function (only! ? it)
+          (.let [size (..size it)]
+            (.loop [index 0]
+              (.if ("lux i64 <" (.int size) (.int index))
+                (.exec
+                  (.if (..lacks? index it)
+                    it
+                    (.if (? (..item index it))
+                      it
+                      (..lacks! index it)))
+                  (again ("lux i64 +" 1 index)))
+                it)))))
+    <?> <it>)])
+
+(template [<name> <predicate> <test> <type> <term>]
+  [(template: .public (<name> <?> <it>)
+     [((.: (.All (_ a)
+             (.-> <predicate> (..Array a) (.Maybe <type>)))
+           (.function (<name> ? it)
+             (.let [size (..size it)]
+               (.loop [index 0]
+                 (.if ("lux i64 <" (.int size) (.int index))
+                   (.if (..lacks? index it)
+                     (again ("lux i64 +" 1 index))
+                     (.let [it (..item index it)]
+                       (.if <test>
+                         {.#Some <term>}
+                         (again ("lux i64 +" 1 index)))))
+                   {.#None})))))
+       <?> <it>)])]
+
+  [example (.-> a .Bit) (? it) a it]
+  [example' (.-> Nat a .Bit) (? index it) [Nat a] [index it]]
+  )
+
+(template: .public (clone <it>)
+  [((.: (.All (_ a) (.-> (..Array a) (..Array a)))
+        (.function (clone it)
+          (.let [size (..size it)]
+            (..copy! size 0 it 0 (..empty size)))))
+    <it>)])
+
+(template: .public (of_list <input>)
+  [((.: (.All (_ a) (.-> (.List a) (..Array a)))
+        (.function (of_list input)
+          (.let [size (list.size input)
+                 output (..empty size)]
+            (.loop [index 0
+                    input input]
+              (.case input
+                {.#End}
+                output
+                
+                {.#Item head tail}
+                (.exec
+                  (..has! index head output)
+                  (again ("lux i64 +" 1 index) tail)))))))
+    <input>)])
+
+(def: underflow
+  Nat
+  (-- 0))
+
+(`` (template: (list|-default <empty> <array>)
+      [((.: (.All (_ a) (.-> (.List a) (..Array a) (.List a)))
+            (.function (list|-default empty array)
+              (.loop [index ("lux i64 -" 1 (..size array))
+                      output empty]
+                (.if ("lux i64 =" (~~ (.static ..underflow)) index)
+                  output
+                  (again ("lux i64 -" 1 index)
+                         (.if (..lacks? index array)
+                           output
+                           {.#Item (..item index array) output}))))))
+        <empty> <array>)]))
+
+(`` (template: (list|+default <default> <array>)
+      [((.: (.All (_ a) (.-> a (..Array a) (.List a)))
+            (.function (list|+default default array)
+              (.loop [index ("lux i64 -" 1 (..size array))
+                      output (`` (.: (.List (~~ (.as_is (~~ (.:of default)))))
+                                     {.#End}))]
+                (.if ("lux i64 =" (~~ (.static ..underflow)) index)
+                  output
+                  (again ("lux i64 -" 1 index)
+                         {.#Item (.if (..lacks? index array)
+                                   default
+                                   (..item index array))
+                                 output})))))
+        <default> <array>)]))
+
+(`` (template: .public (list <default> <array>)
+      [((.: (.All (_ a) (.-> (.Maybe a) (..Array a) (.List a)))
+            (.function (list default array)
+              (.case default
+                {.#Some default}
+                (~~ (..list|+default default array))
+
+                {.#None}
+                (~~ (..list|-default {.#End} array)))))
+        <default> <array>)]))
+
+(template: .public (= <//#=> <left/*> <right/*>)
+  [((.: (.All (_ a) (.-> (.-> a a .Bit) (..Array a) (..Array a) .Bit))
+        (.function (= //#= left/* right/*)
+          (.let [size (..size left/*)]
+            (.and ("lux i64 =" (..size right/*) size)
+                  (.loop [index 0]
+                    (.if ("lux i64 <" (.int size) (.int index))
+                      (.if (..lacks? index left/*)
+                        (..lacks? index right/*)
+                        (.if (..lacks? index right/*)
+                          .false
+                          (.and (//#= (..item index left/*)
+                                      (..item index right/*))
+                                (again ("lux i64 +" 1 index)))))
+                      true))))))
+    <//#=> <left/*> <right/*>)])
+
+(template: .public (composite <left/*> <right/*>)
+  [((.: (.All (_ a) (.-> (..Array a) (..Array a) (..Array a)))
+        (.function (composite left/* right/*)
+          (.let [|left| (..size left/*)
+                 |right| (..size right/*)]
+            (.|> (..empty ("lux i64 +" |left| |right|))
+                 (..copy! |left| 0 left/* 0)
+                 (..copy! |right| 0 right/* |left|)))))
+    <left/*> <right/*>)])
+
+(template: .public (mix <$> <init> <it>)
+  [((.: (.All (_ a b)
+          (.-> (.-> Nat b a a) a (..Array b) a))
+        (.function (mix $ init it)
+          (.let [size (..size it)]
+            (.loop [index 0
+                    so_far init]
+              (.if ("lux i64 <" (.int size) (.int index))
+                (.if (..lacks? index it)
+                  (again ("lux i64 +" 1 index) so_far)
+                  (again ("lux i64 +" 1 index) ($ index (..item index it) so_far)))
+                so_far)))))
+    <$> <init> <it>)])
+
+(template: .public (each <$> <input>)
+  [((.: (functor.Functor ..Array)
+        (.function (each $ input)
+          (..mix (.function (_ index item output)
+                   (..has! index ($ item) output))
+                 (..empty (..size input))
+                 input)))
+    <$> <input>)])
+
+(template [<name> <init> <op>]
+  [(template: .public (<name> <?> <it>)
+     [((.: (.All (_ a)
+             (.-> (.-> a .Bit)
+                  (.-> (..Array a) .Bit)))
+           (.function (<name> ? it)
+             (.let [size (..size it)]
+               (.loop [index 0]
+                 (.if ("lux i64 <" (.int size) (.int index))
+                   (.if (..lacks? index it)
+                     (again ("lux i64 +" 1 index))
+                     (<op> (? (..item index it))
+                           (again ("lux i64 +" 1 index))))
+                   <init>)))))
+       <?> <it>)])]
+
+  [every? .true  and]
+  [any?   .false or]
+  )
+
+(template: .public (one <?> <it>)
+  [((.: (.All (_ a b)
+          (.-> (.-> a (.Maybe b)) (..Array a) (.Maybe b)))
+        (.function (one ? it)
+          (.let [size (..size it)]
+            (.loop [index 0]
+              (.if ("lux i64 <" (.int size) (.int index))
+                (with_expansions [<again> (again ("lux i64 +" 1 index))]
+                  (.if (..lacks? index it)
+                    <again>
+                    (.case (? (..item index it))
+                      {.#None}
+                      <again>
+
+                      output
+                      output)))
+                {.#None})))))
+    <?> <it>)])
-- 
cgit v1.2.3