aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/abstract/equivalence.lux14
-rw-r--r--stdlib/source/lux/target/jvm/class.lux2
-rw-r--r--stdlib/source/lux/target/jvm/constant.lux61
-rw-r--r--stdlib/source/lux/target/jvm/descriptor.lux41
-rw-r--r--stdlib/source/lux/world/binary.lux26
-rw-r--r--stdlib/source/test/lux/target/jvm.lux78
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)