Various fixes.

6 files changed, 136 insertions, 86 deletions

diff --git a/stdlib/source/lux/abstract/equivalence.lux b/stdlib/source/lux/abstract/equivalence.lux
index b773505de..d23f37942 100644
--- a/stdlib/source/lux/abstract/equivalence.lux
+++ b/stdlib/source/lux/abstract/equivalence.lux
@@ -18,16 +18,16 @@
 (def: #export (sum left right)
   (All [l r] (-> (Equivalence l) (Equivalence r) (Equivalence (| l r))))
   (structure
-   (def: (= a|b x|y)
-     (case [a|b x|y]
-       [(0 a) (0 x)]
-       (:: left = a x)
+   (def: (= reference sample)
+     (case [reference sample]
+       [(#.Left reference) (#.Left sample)]
+       (:: left = reference sample)
 
-       [(1 b) (1 y)]
-       (:: right = b y)
+       [(#.Right reference) (#.Right sample)]
+       (:: right = reference sample)
 
        _
-       #0))))
+       false))))
 
 (def: #export (rec sub)
   (All [a] (-> (-> (Equivalence a) (Equivalence a)) (Equivalence a)))
diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux
index 6fb6f48d4..15b2f5392 100644
--- a/stdlib/source/lux/target/jvm/class.lux
+++ b/stdlib/source/lux/target/jvm/class.lux
@@ -86,7 +86,7 @@
     (wrap [@this @super @interfaces])))
 
 (def: #export (class version modifier
-                     super this interfaces
+                     this super interfaces
                      fields methods attributes)
   (-> Major Modifier
       Internal Internal (List Internal)
diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux
index 3af24af55..aae32e757 100644
--- a/stdlib/source/lux/target/jvm/constant.lux
+++ b/stdlib/source/lux/target/jvm/constant.lux
@@ -134,26 +134,47 @@
 
 (def: #export equivalence
   (Equivalence Constant)
-  ($_ equivalence.sum
-      ## #UTF8
-      text.equivalence
-      ## #Long
-      (..value-equivalence int.equivalence)
-      ## #Double
-      (..value-equivalence frac.equivalence)
-      ## #Class
-      ..class-equivalence
-      ## #String
-      (..value-equivalence //index.equivalence)
-      ## #Field
-      ..reference-equivalence
-      ## #Method
-      ..reference-equivalence
-      ## #Interface-Method
-      ..reference-equivalence
-      ## #Name-And-Type
-      ..name-and-type-equivalence
-      ))
+  ## TODO: Delete the explicit "structure" and use the combinator
+  ## version below as soon as the new format for variants is implemented.
+  (structure
+   (def: (= reference sample)
+     (case [reference sample]
+       (^template [<tag> <equivalence>]
+         [(<tag> reference) (<tag> sample)]
+         (:: <equivalence> = reference sample))
+       ([#UTF8 text.equivalence]
+        [#Long (..value-equivalence int.equivalence)]
+        [#Double (..value-equivalence frac.equivalence)]
+        [#Class ..class-equivalence]
+        [#String (..value-equivalence //index.equivalence)]
+        [#Field ..reference-equivalence]
+        [#Method ..reference-equivalence]
+        [#Interface-Method ..reference-equivalence]
+        [#Name-And-Type ..name-and-type-equivalence])
+       
+       _
+       false)))
+  ## ($_ equivalence.sum
+  ##     ## #UTF8
+  ##     text.equivalence
+  ##     ## #Long
+  ##     (..value-equivalence int.equivalence)
+  ##     ## #Double
+  ##     (..value-equivalence frac.equivalence)
+  ##     ## #Class
+  ##     ..class-equivalence
+  ##     ## #String
+  ##     (..value-equivalence //index.equivalence)
+  ##     ## #Field
+  ##     ..reference-equivalence
+  ##     ## #Method
+  ##     ..reference-equivalence
+  ##     ## #Interface-Method
+  ##     ..reference-equivalence
+  ##     ## #Name-And-Type
+  ##     ..name-and-type-equivalence
+  ##     )
+  )
 
 (def: #export format
   (Format Constant)
diff --git a/stdlib/source/lux/target/jvm/descriptor.lux b/stdlib/source/lux/target/jvm/descriptor.lux
index d350cec65..c98a4b853 100644
--- a/stdlib/source/lux/target/jvm/descriptor.lux
+++ b/stdlib/source/lux/target/jvm/descriptor.lux
@@ -5,14 +5,13 @@
      format]
     [collection
      ["." list ("#;." functor)]]]
+   [macro
+    ["." template]]
    [type
     abstract]]
   ["." // #_
    ["#." name (#+ Internal)]])
 
-(abstract: #export Base' {} Any)
-(abstract: #export Object' {} Any)
-(abstract: #export Array' {} Any)
 (abstract: #export Void' {} Any)
 
 (abstract: #export (Value' kind) {} Any)
@@ -28,31 +27,31 @@
   (type: #export (Value kind) (Return (Value' kind)))
   (type: #export Void (Return Void'))
 
-  (template [<refined> <raw>]
-    [(type: #export <refined> (Value <raw>))]
+  (template [<refined>]
+    [(with-expansions [<raw> (template.identifier [<refined> "'"])]
+       (abstract: #export <raw> {} Any)
+       (type: #export <refined> (Value <raw>)))]
 
-    [Base Base']
-    [Object Object']
-    [Array Array'])
+    [Primitive]
+    [Object]
+    [Array]
+    )
 
   (template [<sigil> <name> <kind>]
     [(def: #export <name>
        (Descriptor <kind>)
        (:abstraction <sigil>))]
 
-    ["Z" boolean Base]
-
-    ["B" byte Base]
-    ["S" short Base]
-    ["I" int Base]
-    ["J" long Base]
-
-    ["C" char Base]
-
-    ["F" float Base]
-    ["D" double Base]
-
-    ["V" void Void])
+    ["Z" boolean Primitive]
+    ["B" byte Primitive]
+    ["S" short Primitive]
+    ["I" int Primitive]
+    ["J" long Primitive]
+    ["F" float Primitive]
+    ["D" double Primitive]
+    ["C" char Primitive]
+    ["V" void Void]
+    )
 
   (def: #export object
     (-> Internal (Descriptor Object))
diff --git a/stdlib/source/lux/world/binary.lux b/stdlib/source/lux/world/binary.lux
index 463f99a5a..1b203df73 100644
--- a/stdlib/source/lux/world/binary.lux
+++ b/stdlib/source/lux/world/binary.lux
@@ -45,15 +45,15 @@
                                      (#static equals [[byte] [byte]] boolean))
 
                                    (def: byte-mask
-                                     Nat
-                                     (|> i64.bits-per-byte i64.mask .nat))
+                                     I64
+                                     (|> i64.bits-per-byte i64.mask .i64))
 
                                    (def: i64
-                                     (-> (primitive "java.lang.Byte") Nat)
-                                     (|>> host.byte-to-long (:coerce Nat) (i64.and ..byte-mask)))
+                                     (-> (primitive "java.lang.Byte") I64)
+                                     (|>> host.byte-to-long (:coerce I64) (i64.and ..byte-mask)))
 
                                    (def: byte
-                                     (-> Nat (primitive "java.lang.Byte"))
+                                     (-> (I64 Any) (primitive "java.lang.Byte"))
                                      (`` (for {(~~ (static @.old))
                                                (|>> .int host.long-to-byte)
 
@@ -129,13 +129,13 @@
             (|>> .nat-to-frac [] ArrayBuffer::new Uint8Array::new)})))
 
 (def: #export (read/8 idx binary)
-  (-> Nat Binary (Error Nat))
+  (-> Nat Binary (Error I64))
   (if (n/< (..!size binary) idx)
     (#error.Success (!read idx binary))
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (read/16 idx binary)
-  (-> Nat Binary (Error Nat))
+  (-> Nat Binary (Error I64))
   (if (n/< (..!size binary) (n/+ 1 idx))
     (#error.Success ($_ i64.or
                         (i64.left-shift 8 (!read idx binary))
@@ -143,7 +143,7 @@
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (read/32 idx binary)
-  (-> Nat Binary (Error Nat))
+  (-> Nat Binary (Error I64))
   (if (n/< (..!size binary) (n/+ 3 idx))
     (#error.Success ($_ i64.or
                         (i64.left-shift 24 (!read idx binary))
@@ -153,7 +153,7 @@
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (read/64 idx binary)
-  (-> Nat Binary (Error Nat))
+  (-> Nat Binary (Error I64))
   (if (n/< (..!size binary) (n/+ 7 idx))
     (#error.Success ($_ i64.or
                         (i64.left-shift 56 (!read idx binary))
@@ -167,7 +167,7 @@
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (write/8 idx value binary)
-  (-> Nat Nat Binary (Error Binary))
+  (-> Nat (I64 Any) Binary (Error Binary))
   (if (n/< (..!size binary) idx)
     (exec (|> binary
               (!write idx value))
@@ -175,7 +175,7 @@
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (write/16 idx value binary)
-  (-> Nat Nat Binary (Error Binary))
+  (-> Nat (I64 Any) Binary (Error Binary))
   (if (n/< (..!size binary) (n/+ 1 idx))
     (exec (|> binary
               (!write idx (i64.logic-right-shift 8 value))
@@ -184,7 +184,7 @@
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (write/32 idx value binary)
-  (-> Nat Nat Binary (Error Binary))
+  (-> Nat (I64 Any) Binary (Error Binary))
   (if (n/< (..!size binary) (n/+ 3 idx))
     (exec (|> binary
               (!write idx (i64.logic-right-shift 24 value))
@@ -195,7 +195,7 @@
     (exception.throw index-out-of-bounds [(..!size binary) idx])))
 
 (def: #export (write/64 idx value binary)
-  (-> Nat Nat Binary (Error Binary))
+  (-> Nat (I64 Any) Binary (Error Binary))
   (if (n/< (..!size binary) (n/+ 7 idx))
     (exec (|> binary
               (!write idx (i64.logic-right-shift 56 value))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 47c6f35d9..191af99a7 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -17,51 +17,81 @@
      ["." dictionary]
      ["." row]]]
    [world
-    ["." file (#+ File)]
-    [binary (#+ Binary)]]
+    [binary (#+ Binary)]
+    ["." file (#+ File)]]
    [math
-    ["r" random]]
+    ["r" random (#+ Random) ("#@." monad)]]
    ["_" test (#+ Test)]]
   {1
    ["." / #_
     ["#." loader (#+ Library)]
     ["#." version]
     ["#." name]
-    ["#." descriptor]
+    ["#." descriptor (#+ Descriptor Value)]
     ["#." field]
     ["#." class]
     [modifier
      ["#.M" inner]]]})
 
-(def: (write-class! name bytecode)
-  (-> Text Binary (IO Text))
-  (let [file-path (format name ".class")]
-    (do io.monad
-      [outcome (do (error.with @)
-                 [file (: (IO (Error (File IO)))
-                          (file.get-file io.monad file.system file-path))]
-                 (!.use (:: file over-write) bytecode))]
-      (wrap (case outcome
-              (#error.Success definition)
-              (format "Wrote: " (%t file-path))
-              
-              (#error.Failure error)
-              error)))))
+## (def: (write-class! name bytecode)
+##   (-> Text Binary (IO Text))
+##   (let [file-path (format name ".class")]
+##     (do io.monad
+##       [outcome (do (error.with @)
+##                  [file (: (IO (Error (File IO)))
+##                           (file.get-file io.monad file.system file-path))]
+##                  (!.use (:: file over-write) bytecode))]
+##       (wrap (case outcome
+##               (#error.Success definition)
+##               (format "Wrote: " (%t file-path))
+
+##               (#error.Failure error)
+##               error)))))
+
+(def: descriptor
+  (Random (Descriptor (Value Any)))
+  (r.rec
+   (function (_ descriptor)
+     ($_ r.either
+         (r@wrap /descriptor.boolean)
+         (r@wrap /descriptor.byte)
+         (r@wrap /descriptor.short)
+         (r@wrap /descriptor.int)
+         (r@wrap /descriptor.long)
+         (r@wrap /descriptor.float)
+         (r@wrap /descriptor.double)
+         (r@wrap /descriptor.char)
+         (r@map (|>> (text.join-with /name.external-separator)
+                     /name.internal
+                     /descriptor.object)
+                (r.list 3 (r.ascii/upper-alpha 10)))
+         (r@map /descriptor.array descriptor)
+         ))))
+
+(def: field
+  (Random [Text (Descriptor (Value Any))])
+  ($_ r.and
+      (r.ascii/lower-alpha 10)
+      ..descriptor
+      ))
 
 (def: class
   Test
   (do r.monad
     [_ (wrap [])
-     #let [package "my.package"
-           name "MyClass"
-           full-name (format package "." name)
+     super-package (r.ascii/lower-alpha 10)
+     package (r.ascii/lower-alpha 10)
+     name (r.ascii/upper-alpha 10)
+     [field0 descriptor0] ..field
+     [field1 descriptor1] ..field
+     #let [full-name (format super-package "." package "." name)
            input (/class.class /version.v6_0 /class.public
-                               (/name.internal "java.lang.Object")
                                (/name.internal full-name)
+                               (/name.internal "java.lang.Object")
                                (list (/name.internal "java.io.Serializable")
                                      (/name.internal "java.lang.Runnable"))
-                               (list (/field.field /field.public "foo" /descriptor.long (row.row))
-                                     (/field.field /field.public "bar" /descriptor.double (row.row)))
+                               (list (/field.field /field.public field0 descriptor0 (row.row))
+                                     (/field.field /field.public field1 descriptor1 (row.row)))
                                (row.row)
                                (row.row))
            bytecode (binary.write /class.format input)