Fixes and adaptations for the JavaScript compiler.

1 files changed, 170 insertions, 80 deletions

diff --git a/stdlib/source/lux/world/binary.lux b/stdlib/source/lux/world/binary.lux
index 9599ae2f0..463f99a5a 100644
--- a/stdlib/source/lux/world/binary.lux
+++ b/stdlib/source/lux/world/binary.lux
@@ -1,6 +1,6 @@
 (.module:
   [lux (#- i64)
-   ["." host (#+ import:)]
+   ["." host]
    ["@" target]
    [abstract
     [monad (#+ do)]
@@ -15,7 +15,7 @@
     [text
      format]
     [collection
-     [array (#+)]]]])
+     ["." array]]]])
 
 (exception: #export (index-out-of-bounds {size Nat} {index Nat})
   (exception.report
@@ -35,42 +35,83 @@
 
 (with-expansions [<for-jvm> (as-is (type: #export Binary (host.type [byte]))
 
-                                   (import: #long java/lang/Object)
+                                   (host.import: #long java/lang/Object)
                                    
-                                   (import: #long java/lang/System
+                                   (host.import: #long java/lang/System
                                      (#static arraycopy [java/lang/Object int java/lang/Object int int] #try void))
 
-                                   (import: #long java/util/Arrays
+                                   (host.import: #long java/util/Arrays
                                      (#static copyOfRange [[byte] int int] [byte])
-                                     (#static equals [[byte] [byte]] boolean)))]
+                                     (#static equals [[byte] [byte]] boolean))
+
+                                   (def: byte-mask
+                                     Nat
+                                     (|> i64.bits-per-byte i64.mask .nat))
+
+                                   (def: i64
+                                     (-> (primitive "java.lang.Byte") Nat)
+                                     (|>> host.byte-to-long (:coerce Nat) (i64.and ..byte-mask)))
+
+                                   (def: byte
+                                     (-> Nat (primitive "java.lang.Byte"))
+                                     (`` (for {(~~ (static @.old))
+                                               (|>> .int host.long-to-byte)
+
+                                               (~~ (static @.jvm))
+                                               (|>> .int (:coerce (primitive "java.lang.Long")) host.long-to-byte)}))))]
   (`` (for {(~~ (static @.old))
             (as-is <for-jvm>)
 
             (~~ (static @.jvm))
-            (as-is <for-jvm>)})))
+            (as-is <for-jvm>)
+
+            (~~ (static @.js))
+            (as-is (host.import: ArrayBuffer
+                     (new [host.Number]))
+                   
+                   (host.import: Uint8Array
+                     (new [ArrayBuffer])
+                     (length host.Number))
+                   
+                   (type: #export Binary Uint8Array))})))
 
-(def: byte-mask
-  I64
-  (|> i64.bits-per-byte i64.mask .i64))
+(template: (!size binary)
+  (`` (for {(~~ (static @.old))
+            (host.array-length binary)
+
+            (~~ (static @.jvm))
+            (host.array-length binary)
 
-(def: i64
-  (-> (primitive "java.lang.Byte") I64)
-  (|>> host.byte-to-long (:coerce I64) (i64.and ..byte-mask)))
+            (~~ (static @.js))
+            (.frac-to-nat (Uint8Array::length binary))})))
 
-(def: byte
-  (-> (I64 Any) (primitive "java.lang.Byte"))
+(template: (!read idx binary)
   (`` (for {(~~ (static @.old))
-            (|>> .int host.long-to-byte)
+            (..i64 (host.array-read idx binary))
 
             (~~ (static @.jvm))
-            (|>> .int (:coerce (primitive "java.lang.Long")) host.long-to-byte)})))
+            (..i64 (host.array-read idx binary))
 
-(template: (!size binary)
+            (~~ (static @.js))
+            (|> binary
+                (: ..Binary)
+                (:coerce (array.Array .Frac))
+                ("js array read" idx)
+                .frac-to-nat)})))
+
+(template: (!write idx value binary)
   (`` (for {(~~ (static @.old))
-            (host.array-length binary)
+            (host.array-write idx (..byte value) binary)
 
             (~~ (static @.jvm))
-            (host.array-length binary)})))
+            (host.array-write idx (..byte value) binary)
+
+            (~~ (static @.js))
+            (|> binary
+                (: ..Binary)
+                (:coerce (array.Array .Frac))
+                ("js array write" idx (.nat-to-frac value))
+                (:coerce ..Binary))})))
 
 (def: #export size
   (-> Binary Nat)
@@ -82,116 +123,165 @@
             (|>> (host.array byte))
 
             (~~ (static @.jvm))
-            (|>> (host.array byte))})))
+            (|>> (host.array byte))
+
+            (~~ (static @.js))
+            (|>> .nat-to-frac [] ArrayBuffer::new Uint8Array::new)})))
 
 (def: #export (read/8 idx binary)
-  (-> Nat Binary (Error I64))
+  (-> Nat Binary (Error Nat))
   (if (n/< (..!size binary) idx)
-    (#error.Success (..i64 (host.array-read idx binary)))
+    (#error.Success (!read idx binary))
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (read/16 idx binary)
-  (-> Nat Binary (Error I64))
+  (-> Nat Binary (Error Nat))
   (if (n/< (..!size binary) (n/+ 1 idx))
     (#error.Success ($_ i64.or
-                        (i64.left-shift 8 (..i64 (host.array-read idx binary)))
-                        (..i64 (host.array-read (n/+ 1 idx) binary))))
+                        (i64.left-shift 8 (!read idx binary))
+                        (!read (n/+ 1 idx) binary)))
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (read/32 idx binary)
-  (-> Nat Binary (Error I64))
+  (-> Nat Binary (Error Nat))
   (if (n/< (..!size binary) (n/+ 3 idx))
     (#error.Success ($_ i64.or
-                        (i64.left-shift 24 (..i64 (host.array-read idx binary)))
-                        (i64.left-shift 16 (..i64 (host.array-read (n/+ 1 idx) binary)))
-                        (i64.left-shift 8 (..i64 (host.array-read (n/+ 2 idx) binary)))
-                        (..i64 (host.array-read (n/+ 3 idx) binary))))
+                        (i64.left-shift 24 (!read idx binary))
+                        (i64.left-shift 16 (!read (n/+ 1 idx) binary))
+                        (i64.left-shift 8 (!read (n/+ 2 idx) binary))
+                        (!read (n/+ 3 idx) binary)))
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (read/64 idx binary)
-  (-> Nat Binary (Error I64))
+  (-> Nat Binary (Error Nat))
   (if (n/< (..!size binary) (n/+ 7 idx))
     (#error.Success ($_ i64.or
-                        (i64.left-shift 56 (..i64 (host.array-read idx binary)))
-                        (i64.left-shift 48 (..i64 (host.array-read (n/+ 1 idx) binary)))
-                        (i64.left-shift 40 (..i64 (host.array-read (n/+ 2 idx) binary)))
-                        (i64.left-shift 32 (..i64 (host.array-read (n/+ 3 idx) binary)))
-                        (i64.left-shift 24 (..i64 (host.array-read (n/+ 4 idx) binary)))
-                        (i64.left-shift 16 (..i64 (host.array-read (n/+ 5 idx) binary)))
-                        (i64.left-shift 8 (..i64 (host.array-read (n/+ 6 idx) binary)))
-                        (..i64 (host.array-read (n/+ 7 idx) binary))))
+                        (i64.left-shift 56 (!read idx binary))
+                        (i64.left-shift 48 (!read (n/+ 1 idx) binary))
+                        (i64.left-shift 40 (!read (n/+ 2 idx) binary))
+                        (i64.left-shift 32 (!read (n/+ 3 idx) binary))
+                        (i64.left-shift 24 (!read (n/+ 4 idx) binary))
+                        (i64.left-shift 16 (!read (n/+ 5 idx) binary))
+                        (i64.left-shift 8 (!read (n/+ 6 idx) binary))
+                        (!read (n/+ 7 idx) binary)))
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (write/8 idx value binary)
-  (-> Nat (I64 Any) Binary (Error Binary))
+  (-> Nat Nat Binary (Error Binary))
   (if (n/< (..!size binary) idx)
     (exec (|> binary
-              (host.array-write idx (..byte value)))
+              (!write idx value))
       (#error.Success binary))
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (write/16 idx value binary)
-  (-> Nat (I64 Any) Binary (Error Binary))
+  (-> Nat Nat Binary (Error Binary))
   (if (n/< (..!size binary) (n/+ 1 idx))
     (exec (|> binary
-              (host.array-write idx (..byte (i64.logic-right-shift 8 value)))
-              (host.array-write (n/+ 1 idx) (..byte value)))
+              (!write idx (i64.logic-right-shift 8 value))
+              (!write (n/+ 1 idx) value))
       (#error.Success binary))
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (write/32 idx value binary)
-  (-> Nat (I64 Any) Binary (Error Binary))
+  (-> Nat Nat Binary (Error Binary))
   (if (n/< (..!size binary) (n/+ 3 idx))
     (exec (|> binary
-              (host.array-write idx (..byte (i64.logic-right-shift 24 value)))
-              (host.array-write (n/+ 1 idx) (..byte (i64.logic-right-shift 16 value)))
-              (host.array-write (n/+ 2 idx) (..byte (i64.logic-right-shift 8 value)))
-              (host.array-write (n/+ 3 idx) (..byte value)))
+              (!write idx (i64.logic-right-shift 24 value))
+              (!write (n/+ 1 idx) (i64.logic-right-shift 16 value))
+              (!write (n/+ 2 idx) (i64.logic-right-shift 8 value))
+              (!write (n/+ 3 idx) value))
       (#error.Success binary))
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (write/64 idx value binary)
-  (-> Nat (I64 Any) Binary (Error Binary))
+  (-> Nat Nat Binary (Error Binary))
   (if (n/< (..!size binary) (n/+ 7 idx))
     (exec (|> binary
-              (host.array-write idx (..byte (i64.logic-right-shift 56 value)))
-              (host.array-write (n/+ 1 idx) (..byte (i64.logic-right-shift 48 value)))
-              (host.array-write (n/+ 2 idx) (..byte (i64.logic-right-shift 40 value)))
-              (host.array-write (n/+ 3 idx) (..byte (i64.logic-right-shift 32 value)))
-              (host.array-write (n/+ 4 idx) (..byte (i64.logic-right-shift 24 value)))
-              (host.array-write (n/+ 5 idx) (..byte (i64.logic-right-shift 16 value)))
-              (host.array-write (n/+ 6 idx) (..byte (i64.logic-right-shift 8 value)))
-              (host.array-write (n/+ 7 idx) (..byte value)))
+              (!write idx (i64.logic-right-shift 56 value))
+              (!write (n/+ 1 idx) (i64.logic-right-shift 48 value))
+              (!write (n/+ 2 idx) (i64.logic-right-shift 40 value))
+              (!write (n/+ 3 idx) (i64.logic-right-shift 32 value))
+              (!write (n/+ 4 idx) (i64.logic-right-shift 24 value))
+              (!write (n/+ 5 idx) (i64.logic-right-shift 16 value))
+              (!write (n/+ 6 idx) (i64.logic-right-shift 8 value))
+              (!write (n/+ 7 idx) value))
       (#error.Success binary))
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
-(def: #export (slice from to binary)
-  (-> Nat Nat Binary (Error Binary))
-  (let [size (..!size binary)]
-    (cond (not (n/<= to from))
-          (exception.throw inverted-slice [size from to])
-
-          (not (and (n/< size from)
-                    (n/< size to)))
-          (exception.throw slice-out-of-bounds [size from to])
-
-          ## else
-          (#error.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))))
-
-(def: #export (slice' from binary)
-  (-> Nat Binary (Error Binary))
-  (slice from (dec (..!size binary)) binary))
-
 (structure: #export equivalence (Equivalence Binary)
   (def: (= reference sample)
     (`` (for {(~~ (static @.old))
               (java/util/Arrays::equals reference sample)
 
               (~~ (static @.jvm))
-              (java/util/Arrays::equals reference sample)}))))
+              (java/util/Arrays::equals reference sample)}
+             (let [limit (!size reference)]
+               (and (n/= limit
+                         (!size sample))
+                    (loop [idx 0]
+                      (if (n/< limit idx)
+                        (and (n/= (!read idx reference)
+                                  (!read idx sample))
+                             (recur (inc idx)))
+                        true))))))))
+
+(`` (for {(~~ (static @.old))
+          (as-is)
+
+          (~~ (static @.jvm))
+          (as-is)}
+
+         ## Default
+         (exception: #export (cannot-copy-bytes {source-input Nat}
+                                                {target-output Nat})
+           (exception.report
+            ["Source input space" (%n source-input)]
+            ["Target output space" (%n target-output)]))))
 
 (def: #export (copy bytes source-offset source target-offset target)
   (-> Nat Nat Binary Nat Binary (Error Binary))
-  (do error.monad
-    [_ (java/lang/System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))]
-    (wrap target)))
+  (with-expansions [<for-jvm> (as-is (do error.monad
+                                       [_ (java/lang/System::arraycopy source (.int source-offset) target (.int target-offset) (.int bytes))]
+                                       (wrap target)))]
+    (`` (for {(~~ (static @.old))
+              <for-jvm>
+
+              (~~ (static @.jvm))
+              <for-jvm>}
+             
+             ## Default
+             (let [source-input (n/- source-offset (!size source))
+                   target-output (n/- target-offset (!size target))]
+               (if (n/<= target-output source-input)
+                 (loop [idx 0]
+                   (if (n/< source-input idx)
+                     (exec (!write (n/+ target-offset idx)
+                                   (!read (n/+ source-offset idx) source)
+                                   target)
+                       (recur (inc idx)))
+                     (#error.Success target)))
+                 (exception.throw ..cannot-copy-bytes [source-input target-output])))))))
+
+(def: #export (slice from to binary)
+  (-> Nat Nat Binary (Error Binary))
+  (let [size (..!size binary)]
+    (if (n/<= to from)
+      (if (and (n/< size from)
+               (n/< size to))
+        (with-expansions [<for-jvm> (as-is (#error.Success (java/util/Arrays::copyOfRange binary (.int from) (.int (inc to)))))]
+          (`` (for {(~~ (static @.old))
+                    <for-jvm>
+
+                    (~~ (static @.jvm))
+                    <for-jvm>}
+                   
+                   ## Default
+                   (let [how-many (n/- from to)]
+                     (..copy how-many from binary 0 (..create how-many))))))
+        (exception.throw slice-out-of-bounds [size from to]))
+      (exception.throw inverted-slice [size from to]))))
+
+(def: #export (slice' from binary)
+  (-> Nat Binary (Error Binary))
+  (slice from (dec (..!size binary)) binary))