diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/abstract/equivalence.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/lux/target/jvm/class.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/target/jvm/constant.lux | 61 | ||||
| -rw-r--r-- | stdlib/source/lux/target/jvm/descriptor.lux | 41 | ||||
| -rw-r--r-- | stdlib/source/lux/world/binary.lux | 26 | ||||
| -rw-r--r-- | stdlib/source/test/lux/target/jvm.lux | 78 |
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) |