aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/data/format/binary.lux15
-rw-r--r--stdlib/source/lux/data/number/i64.lux4
-rw-r--r--stdlib/source/lux/target/jvm/attribute/code.lux17
-rw-r--r--stdlib/source/lux/target/jvm/attribute/code/exception.lux21
-rw-r--r--stdlib/source/lux/target/jvm/code.lux328
-rw-r--r--stdlib/source/lux/target/jvm/code/condition.lux75
-rw-r--r--stdlib/source/lux/target/jvm/code/label.lux (renamed from stdlib/source/lux/target/jvm/attribute/code/label.lux)12
-rw-r--r--stdlib/source/lux/target/jvm/code/resources.lux51
-rw-r--r--stdlib/source/lux/target/jvm/constant.lux30
-rw-r--r--stdlib/source/lux/target/jvm/encoding/unsigned.lux27
-rw-r--r--stdlib/source/lux/target/jvm/method.lux14
11 files changed, 530 insertions, 64 deletions
diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux
index 67f36609e..b1f0d56cd 100644
--- a/stdlib/source/lux/data/format/binary.lux
+++ b/stdlib/source/lux/data/format/binary.lux
@@ -30,13 +30,16 @@
(|>> (n/* i64.bits-per-byte) i64.mask))
(type: #export Mutation
+ (-> [Offset Binary] [Offset Binary]))
+
+(type: #export Specification
[Size (-> [Offset Binary] [Offset Binary])])
(def: #export no-op
- Mutation
+ Specification
[0 function.identity])
-(structure: #export monoid (Monoid Mutation)
+(structure: #export monoid (Monoid Specification)
(def: identity
..no-op)
@@ -46,7 +49,7 @@
(|>> mutL mutR)]))
(type: #export (Writer a)
- (-> a Mutation))
+ (-> a Specification))
(def: #export (run writer value)
(All [a] (-> (Writer a) a Binary))
@@ -176,13 +179,13 @@
value (if (n/= original-count capped-count)
value
(|> value row.to-list (list.take capped-count) row.from-list))
- (^open "mutation@.") ..monoid
+ (^open "specification@.") ..monoid
[size mutation] (|> value
(row@map valueW)
(:: row.fold fold
(function (_ post pre)
- (mutation@compose pre post))
- mutation@identity))]
+ (specification@compose pre post))
+ specification@identity))]
[(n/+ <size> size)
(function (_ [offset binary])
(error.assume
diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux
index 31289c96a..9d431769b 100644
--- a/stdlib/source/lux/data/number/i64.lux
+++ b/stdlib/source/lux/data/number/i64.lux
@@ -34,8 +34,8 @@
(xor (:coerce I64 -1)))
(def: #export (mask bits)
- (-> Nat (I64 Any))
- (|> 1 (..left-shift (n/% ..width bits)) .dec))
+ (-> Nat I64)
+ (|> 1 .i64 (..left-shift (n/% ..width bits)) .dec))
(def: (add-shift shift value)
(-> Nat Nat Nat)
diff --git a/stdlib/source/lux/target/jvm/attribute/code.lux b/stdlib/source/lux/target/jvm/attribute/code.lux
index 88b4eb7c9..68c651ba5 100644
--- a/stdlib/source/lux/target/jvm/attribute/code.lux
+++ b/stdlib/source/lux/target/jvm/attribute/code.lux
@@ -13,14 +13,15 @@
[collection
["." row (#+ Row) ("#@." functor fold)]]]]
["." /// #_
+ [code
+ ["#." resources (#+ Resources)]]
[encoding
["#." unsigned (#+ U2)]]]
["." / #_
["#." exception (#+ Exception)]])
(type: #export (Code Attribute)
- {#max-stack U2
- #max-locals U2
+ {#resources Resources
#code Binary
#exception-table (Row Exception)
#attributes (Row Attribute)})
@@ -29,9 +30,8 @@
(All [Attribute] (-> (-> Attribute Nat) (Code Attribute) Nat))
($_ n/+
## u2 max_stack;
- ///unsigned.u2-bytes
## u2 max_locals;
- ///unsigned.u2-bytes
+ ///resources.length
## u4 code_length;
///unsigned.u4-bytes
## u1 code[code_length];
@@ -55,8 +55,7 @@
(All [attribute]
(-> (Equivalence attribute) (Equivalence (Code attribute))))
($_ equivalence.product
- ///unsigned.equivalence
- ///unsigned.equivalence
+ ///resources.equivalence
binary.equivalence
(row.equivalence /exception.equivalence)
(row.equivalence attribute-equivalence)
@@ -67,9 +66,8 @@
(All [Attribute] (-> (Parser Attribute) (Parser (Code Attribute))))
($_ <>.and
## u2 max_stack;
- ///unsigned.u2-parser
## u2 max_locals;
- ///unsigned.u2-parser
+ ///resources.parser
## u4 code_length;
## u1 code[code_length];
<2>.binary/32
@@ -85,9 +83,8 @@
(All [Attribute] (-> (Writer Attribute) (Writer (Code Attribute))))
($_ binaryF@compose
## u2 max_stack;
- (///unsigned.u2-writer (get@ #max-stack code))
## u2 max_locals;
- (///unsigned.u2-writer (get@ #max-locals code))
+ (///resources.writer (get@ #resources code))
## u4 code_length;
## u1 code[code_length];
(binaryF.binary/32 (get@ #code code))
diff --git a/stdlib/source/lux/target/jvm/attribute/code/exception.lux b/stdlib/source/lux/target/jvm/attribute/code/exception.lux
index 6f6b8a0be..14dd13d6e 100644
--- a/stdlib/source/lux/target/jvm/attribute/code/exception.lux
+++ b/stdlib/source/lux/target/jvm/attribute/code/exception.lux
@@ -9,10 +9,11 @@
[format
[".F" binary (#+ Writer)]]]]
["." // #_
- ["#." label (#+ Label)]
["//#" /// #_
[constant (#+ Class)]
["#." index (#+ Index)]
+ [code
+ ["#." label (#+ Label)]]
[encoding
["#." unsigned (#+ U2)]]]])
@@ -25,9 +26,9 @@
(def: #export equivalence
(Equivalence Exception)
($_ equivalence.product
- //label.equivalence
- //label.equivalence
- //label.equivalence
+ ////label.equivalence
+ ////label.equivalence
+ ////label.equivalence
////index.equivalence
))
@@ -48,17 +49,17 @@
(def: #export parser
(Parser Exception)
($_ <>.and
- //label.parser
- //label.parser
- //label.parser
+ ////label.parser
+ ////label.parser
+ ////label.parser
////index.parser
))
(def: #export writer
(Writer Exception)
($_ binaryF.and
- //label.writer
- //label.writer
- //label.writer
+ ////label.writer
+ ////label.writer
+ ////label.writer
////index.writer
))
diff --git a/stdlib/source/lux/target/jvm/code.lux b/stdlib/source/lux/target/jvm/code.lux
new file mode 100644
index 000000000..6217a1c6c
--- /dev/null
+++ b/stdlib/source/lux/target/jvm/code.lux
@@ -0,0 +1,328 @@
+(.module:
+ [lux #*
+ [abstract
+ [monad (#+ do)]
+ [monoid (#+ Monoid)]]
+ [control
+ ["." exception (#+ exception:)]]
+ [data
+ [number (#+ hex)]
+ ["." error (#+ Error)]
+ ["." binary]
+ [text
+ ["%" format (#+ format)]]
+ [format
+ [".F" binary (#+ Mutation Specification)]]]
+ [macro
+ ["." template]]]
+ ["." // #_
+ ["#." index (#+ Index)]
+ [constant (#+ Class Field)]
+ [encoding
+ ["#." unsigned (#+ U1 U2 U4)]]]
+ ["." / #_
+ ["#." resources (#+ Resources)]
+ ["#" condition (#+ Environment Condition Local) ("#@." monoid)]
+ ["#." label (#+ Label Wide-Label)]])
+
+(type: #export Instruction
+ (-> [Environment Specification] (Error [Environment Specification])))
+
+(def: (instruction condition transform)
+ (-> Condition (-> Specification Specification) Instruction)
+ (function (_ [environment specification])
+ (do error.monad
+ [environment' (condition environment)]
+ (wrap [environment'
+ (transform specification)]))))
+
+(def: (nullary' code)
+ (-> Nat Mutation)
+ (function (_ [offset binary])
+ [(n/+ 1 offset)
+ (error.assume
+ (binary.write/8 offset code binary))]))
+
+(def: (nullary code [size mutation])
+ (-> Nat (-> Specification Specification))
+ [(n/+ 1 size)
+ (|>> mutation ((nullary' code)))])
+
+(def: (unary/1' code input0)
+ (-> Nat U1 Mutation)
+ (function (_ [offset binary])
+ [(n/+ 2 offset)
+ (error.assume
+ (do error.monad
+ [_ (binary.write/8 offset code binary)]
+ (binary.write/8 (n/+ 1 offset) (//unsigned.nat input0) binary)))]))
+
+(def: (unary/1 code input0 [size mutation])
+ (-> Nat U1 (-> Specification Specification))
+ [(n/+ 2 size)
+ (|>> mutation ((unary/1' code input0)))])
+
+(def: (unary/2' code input0)
+ (-> Nat U2 Mutation)
+ (function (_ [offset binary])
+ [(n/+ 3 offset)
+ (error.assume
+ (do error.monad
+ [_ (binary.write/8 offset code binary)]
+ (binary.write/16 (n/+ 1 offset) (//unsigned.nat input0) binary)))]))
+
+(def: (unary/2 code input0 [size mutation])
+ (-> Nat U2 (-> Specification Specification))
+ [(n/+ 3 size)
+ (|>> mutation ((unary/2' code input0)))])
+
+(def: (unary/4' code input0)
+ (-> Nat U4 Mutation)
+ (function (_ [offset binary])
+ [(n/+ 5 offset)
+ (error.assume
+ (do error.monad
+ [_ (binary.write/8 offset code binary)]
+ (binary.write/16 (n/+ 1 offset) (//unsigned.nat input0) binary)))]))
+
+(def: (unary/4 code input0 [size mutation])
+ (-> Nat U4 (-> Specification Specification))
+ [(n/+ 5 size)
+ (|>> mutation ((unary/4' code input0)))])
+
+## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-6.html#jvms-6.5
+(with-expansions [<constants> (template [<code> <name> <output-size>]
+ [[<code> <name> [] [] 0 <output-size> []]]
+
+ ["01" aconst-null 1]
+
+ ["02" iconst-m1 1]
+ ["03" iconst-0 1]
+ ["04" iconst-1 1]
+ ["05" iconst-2 1]
+ ["06" iconst-3 1]
+ ["07" iconst-4 1]
+ ["08" iconst-5 1]
+
+ ["0B" fconst-0 1]
+ ["0C" fconst-1 1]
+ ["0D" fconst-2 1]
+
+ ["0E" dconst-0 2]
+ ["0F" dconst-1 2])
+ <local-loads> (template [<code> <name> <output-size>]
+ [[<code> <name> [[local Local]] [local] 0 <output-size> [[local]]]]
+
+ ["17" fload 1]
+ ["18" dload 2]
+ ["19" aload 1])
+ <simple-local-loads> (template [<code> <name> <output-size> <local-end>]
+ [[<code> <name> [] [] 0 <output-size> [[(//unsigned.u1 <local-end>)]]]]
+
+ ["22" fload-0 1 0]
+ ["23" fload-1 1 1]
+ ["24" fload-2 1 2]
+ ["25" fload-3 1 3]
+
+ ["26" dload-0 2 1]
+ ["27" dload-1 2 2]
+ ["28" dload-2 2 3]
+ ["29" dload-3 2 4]
+
+ ["2A" aload-0 1 0]
+ ["2B" aload-1 1 1]
+ ["2C" aload-2 1 2]
+ ["2D" aload-3 1 3])
+ <local-stores> (template [<code> <name> <input-size>]
+ [[<code> <name> [[local Local]] [local] <input-size> 0 [[local]]]]
+
+ ["38" fstore 1]
+ ["39" dstore 2]
+ ["3A" astore 1])
+ <simple-local-stores> (template [<code> <name> <input-size> <local-end>]
+ [[<code> <name> [] [] <input-size> 0 [[(//unsigned.u1 <local-end>)]]]]
+
+ ["43" fstore-0 1 0]
+ ["44" fstore-1 1 1]
+ ["45" fstore-2 1 2]
+ ["46" fstore-3 1 3]
+
+ ["47" dstore-0 2 1]
+ ["48" dstore-1 2 2]
+ ["49" dstore-2 2 3]
+ ["4A" dstore-3 2 4]
+
+ ["4B" astore-0 1 0]
+ ["4C" astore-1 1 1]
+ ["4D" astore-2 1 2]
+ ["4E" astore-3 1 3])
+ <array-loads> (template [<code> <name> <output-size>]
+ [[<code> <name> [] [] 2 <output-size> []]]
+
+ ["2e" iaload 1]
+ ["30" faload 1]
+ ["31" daload 2]
+ ["32" aaload 1]
+ ["33" baload 1]
+ ["34" caload 1])
+ <array-stores> (template [<code> <name> <input-size>]
+ [[<code> <name> [] [] <input-size> 0 []]]
+
+ ["4f" iastore 3]
+ ["51" fastore 3]
+ ["52" dastore 4]
+ ["53" aastore 3]
+ ["54" bastore 3]
+ ["55" castore 3])
+ <arithmetic> (template [<code> <name> <input-size> <output-size>]
+ [[<code> <name> [] [] <input-size> <output-size> []]]
+
+ ["60" iadd 2 1]
+ ["6c" idiv 2 1]
+ ["7e" iand 2 1]
+
+ ["62" fadd 2 1]
+ ["66" fsub 2 1]
+ ["6A" fmul 2 1]
+ ["6E" fdiv 2 1]
+ ["72" frem 2 1]
+ ["76" fneg 1 1]
+
+ ["63" dadd 4 2]
+ ["67" dsub 4 2]
+ ["6B" dmul 4 2]
+ ["6F" ddiv 4 2]
+ ["73" drem 4 2]
+ ["77" dneg 2 2])
+ <conversions> (template [<code> <name> <input-size> <output-size>]
+ [[<code> <name> [] [] <input-size> <output-size> []]]
+
+ ["8B" f2i 1 1]
+ ["8C" f2l 1 2]
+ ["8D" f2d 1 2]
+
+ ["8E" d2i 2 1]
+ ["8F" d2l 2 2]
+ ["90" d2f 2 1]
+
+ ["85" i2l 1 2]
+ ["86" i2f 1 1]
+ ["87" i2d 1 2]
+ ["91" i2b 1 1]
+ ["92" i2c 1 1]
+ ["93" i2s 1 1])
+ <comparisons> (template [<code> <name> <input-size>]
+ [[<code> <name> [] [] <input-size> 1 []]]
+
+ ["95" fcmpl 2]
+ ["96" fcmpg 2]
+
+ ["97" dcmpl 4]
+ ["98" dcmpg 4])
+ <returns> (template [<code> <name> <input-size>]
+ [[<code> <name> [] [] <input-size> 0 []]]
+
+ ["AE" freturn 1]
+ ["AF" dreturn 2]
+ ["B0" areturn 1]
+ )
+ <jumps> (template [<code> <name> <input-size>]
+ [[<code> <name> [[label Label]] [label] <input-size> 0 []]]
+
+ ["99" ifeq 2]
+ ["9A" ifne 2]
+ ["9B" iflt 2]
+ ["9C" ifge 2]
+ ["9D" ifgt 2]
+ ["9E" ifle 2]
+
+ ["9F" if-icmpeq 2]
+ ["A0" if-icmpne 2]
+ ["A1" if-icmplt 2]
+ ["A2" if-icmpge 2]
+ ["A3" if-icmpgt 2]
+ ["A4" if-icmple 2]
+
+ ["A5" if-acmpeq 2]
+ ["A6" if-acmpne 2]
+
+ ["A7" goto 2]
+
+ ["C6" ifnull 1]
+ ["C7" ifnonnull 1])]
+ (template [<arity> <definitions>]
+ [(with-expansions [<definitions>' (template.splice <definitions>)]
+ (template [<code> <name> <instruction-inputs> <arity-inputs> <consumes> <produces> <locals>]
+ [(with-expansions [<inputs>' (template.splice <instruction-inputs>)
+ <input-types> (template [<input-name> <input-type>]
+ [<input-type>]
+
+ <inputs>')
+ <input-names> (template [<input-name> <input-type>]
+ [<input-name>]
+
+ <inputs>')
+ <locals>' (template.splice <locals>)]
+ (def: #export (<name> <input-names>)
+ (-> <input-types> Instruction)
+ (..instruction
+ (`` ($_ /@compose
+ (/.consumes <consumes>)
+ (/.produces <produces>)
+ (~~ (template [<local>]
+ [(/.has-local <local>)]
+
+ <locals>'))))
+ (`` (<arity> (hex <code>) (~~ (template.splice <arity-inputs>)))))))]
+
+ <definitions>'
+ ))]
+
+ [..nullary
+ [["00" nop [] [] 0 0 []]
+ ["59" dup [] [] 1 2 []]
+ ["5A" dup-x1 [] [] 2 3 []]
+ ["5B" dup-x2 [] [] 3 4 []]
+ ["5C" dup2 [] [] 2 4 []]
+ ["5D" dup2-x1 [] [] 3 5 []]
+ ["5E" dup2-x2 [] [] 4 6 []]
+ <constants>
+ <simple-local-loads>
+ <array-loads>
+ <simple-local-stores>
+ <array-stores>
+ <arithmetic>
+ <conversions>
+ <comparisons>
+ <returns>
+ ["BE" arraylength [] [] 1 1 []]
+ ["BF" athrow [] [] 1 0 []]]]
+
+ [..unary/1
+ [["10" bipush [[byte U1]] [byte] 0 1 []]
+ <local-loads>
+ <local-stores>]]
+
+ [..unary/2
+ [<jumps>
+ ["BD" anewarray [[index (Index Class)]] [(//index.number index)] 1 1 []]
+ ["C0" checkcast [[index (Index Class)]] [(//index.number index)] 1 1 []]
+ ["B2" getstatic/1 [[index (Index Field)]] [(//index.number index)] 0 1 []]
+ ["B2" getstatic/2 [[index (Index Field)]] [(//index.number index)] 0 2 []]
+ ["B4" getfield/1 [[index (Index Field)]] [(//index.number index)] 1 1 []]
+ ["B4" getfield/2 [[index (Index Field)]] [(//index.number index)] 1 2 []]]]
+
+ [..unary/4
+ [["C8" goto-w [[label Wide-Label]] [label] 0 0 []]]]
+ ))
+
+(structure: #export monoid
+ (Monoid Instruction)
+
+ (def: identity ..nop)
+
+ (def: (compose left right)
+ (function (_ input)
+ (do error.monad
+ [temp (left input)]
+ (right temp)))))
diff --git a/stdlib/source/lux/target/jvm/code/condition.lux b/stdlib/source/lux/target/jvm/code/condition.lux
new file mode 100644
index 000000000..5769efc79
--- /dev/null
+++ b/stdlib/source/lux/target/jvm/code/condition.lux
@@ -0,0 +1,75 @@
+(.module:
+ [lux #*
+ [abstract
+ [monad (#+ do)]
+ [monoid (#+ Monoid)]]
+ [control
+ ["." exception (#+ exception:)]]
+ [data
+ [number (#+ hex)]
+ ["." error (#+ Error)]
+ ["." binary]
+ [text
+ ["%" format (#+ format)]]
+ [format
+ [".F" binary (#+ Mutation Specification)]]]]
+ ["." // #_
+ ["#." resources (#+ Resources)]
+ ["/#" // #_
+ [encoding
+ ["#." unsigned (#+ U1 U2)]]]])
+
+(type: #export Environment
+ {#resources Resources
+ #stack U2})
+
+(type: #export Condition
+ (-> Environment (Error Environment)))
+
+(structure: #export monoid
+ (Monoid Condition)
+
+ (def: identity (|>> #error.Success))
+
+ (def: (compose left right)
+ (function (_ environment)
+ (do error.monad
+ [environment (left environment)]
+ (right environment)))))
+
+(def: #export (produces amount env)
+ (-> Nat Condition)
+ (let [stack (n/+ amount
+ (///unsigned.nat (get@ #stack env)))
+ max-stack (n/max stack
+ (///unsigned.nat (get@ [#resources #//resources.max-stack] env)))]
+ (|> env
+ (set@ #stack (///unsigned.u2 stack))
+ (set@ [#resources #//resources.max-stack] (///unsigned.u2 max-stack))
+ #error.Success)))
+
+(exception: #export (cannot-pop-stack {stack-size Nat}
+ {wanted-pops Nat})
+ (exception.report
+ ["Stack Size" (%.nat stack-size)]
+ ["Wanted Pops" (%.nat wanted-pops)]))
+
+(def: #export (consumes wanted-pops env)
+ (-> Nat Condition)
+ (let [stack-size (///unsigned.nat (get@ #stack env))]
+ (if (n/<= stack-size wanted-pops)
+ (#error.Success (update@ #stack
+ (|>> ///unsigned.nat (n/- wanted-pops) ///unsigned.u2)
+ env))
+ (exception.throw ..cannot-pop-stack [stack-size wanted-pops]))))
+
+(type: #export Local U1)
+
+(def: #export (has-local local environment)
+ (-> Local Condition)
+ (let [max-locals (n/max (///unsigned.nat (get@ [#resources #//resources.max-locals] environment))
+ (///unsigned.nat local))]
+ (|> environment
+ (set@ [#resources #//resources.max-locals]
+ (///unsigned.u2 max-locals))
+ #error.Success)))
diff --git a/stdlib/source/lux/target/jvm/attribute/code/label.lux b/stdlib/source/lux/target/jvm/code/label.lux
index 69a8d55c3..7aaff5739 100644
--- a/stdlib/source/lux/target/jvm/attribute/code/label.lux
+++ b/stdlib/source/lux/target/jvm/code/label.lux
@@ -2,17 +2,19 @@
[lux #*
[abstract
[equivalence (#+ Equivalence)]]]
- ["." //// #_
+ ["." /// #_
[encoding
- ["#." unsigned (#+ U2)]]])
+ ["#." unsigned (#+ U2 U4)]]])
(type: #export Label U2)
(def: #export equivalence
- ////unsigned.equivalence)
+ ///unsigned.equivalence)
(def: #export parser
- ////unsigned.u2-parser)
+ ///unsigned.u2-parser)
(def: #export writer
- ////unsigned.u2-writer)
+ ///unsigned.u2-writer)
+
+(type: #export Wide-Label U4)
diff --git a/stdlib/source/lux/target/jvm/code/resources.lux b/stdlib/source/lux/target/jvm/code/resources.lux
new file mode 100644
index 000000000..fed6d4ce7
--- /dev/null
+++ b/stdlib/source/lux/target/jvm/code/resources.lux
@@ -0,0 +1,51 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." equivalence (#+ Equivalence)]]
+ [control
+ ["<>" parser
+ ["<2>" binary (#+ Parser)]]]
+ [data
+ [format
+ [".F" binary (#+ Writer) ("#@." monoid)]]]]
+ ["." /// #_
+ [encoding
+ ["#." unsigned (#+ U2)]]])
+
+(type: #export Resources
+ {#max-stack U2
+ #max-locals U2})
+
+(def: #export length
+ ($_ n/+
+ ## u2 max_stack;
+ ///unsigned.u2-bytes
+ ## u2 max_locals;
+ ///unsigned.u2-bytes))
+
+(def: #export equivalence
+ (Equivalence Resources)
+ ($_ equivalence.product
+ ## u2 max_stack;
+ ///unsigned.equivalence
+ ## u2 max_locals;
+ ///unsigned.equivalence
+ ))
+
+(def: #export parser
+ (Parser Resources)
+ ($_ <>.and
+ ## u2 max_stack;
+ ///unsigned.u2-parser
+ ## u2 max_locals;
+ ///unsigned.u2-parser
+ ))
+
+(def: #export (writer resources)
+ (Writer Resources)
+ ($_ binaryF@compose
+ ## u2 max_stack;
+ (///unsigned.u2-writer (get@ #max-stack resources))
+ ## u2 max_locals;
+ (///unsigned.u2-writer (get@ #max-locals resources))
+ ))
diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux
index ee4dc5849..4dc021a3d 100644
--- a/stdlib/source/lux/target/jvm/constant.lux
+++ b/stdlib/source/lux/target/jvm/constant.lux
@@ -20,7 +20,7 @@
["." / #_
["#." tag ("#;." equivalence)]
["." // #_
- [descriptor (#+ Descriptor)]
+ ["#." descriptor (#+ Descriptor)]
["#." index (#+ Index)]
[encoding
[unsigned (#+ U4)]]]])
@@ -105,29 +105,29 @@
)
)
-(type: #export Name-And-Type
+(type: #export (Name-And-Type of)
{#name (Index UTF8)
- #descriptor (Index (Descriptor Any))})
+ #descriptor (Index (Descriptor of))})
-(type: #export Reference
+(type: #export (Reference of)
{#class (Index Class)
- #name-and-type (Index Name-And-Type)})
+ #name-and-type (Index (Name-And-Type of))})
(template [<type> <equivalence> <parser> <writer>]
- [(def: #export <equivalence>
- (Equivalence <type>)
+ [(def: <equivalence>
+ (Equivalence (<type> Any))
($_ equivalence.product
//index.equivalence
//index.equivalence))
- (def: #export <parser>
+ (def: <parser>
(Parser <type>)
($_ <>.and
//index.parser
//index.parser))
- (def: #export <writer>
- (Writer <type>)
+ (def: <writer>
+ (Writer (<type> Any))
($_ binaryF.and
//index.writer
//index.writer))]
@@ -136,16 +136,18 @@
[Reference reference-equivalence reference-parser reference-writer]
)
+(type: #export Field (//descriptor.Value Any))
+
(type: #export Constant
(#UTF8 UTF8)
(#Long Long)
(#Double Double)
(#Class Class)
(#String String)
- (#Field Reference)
- (#Method Reference)
- (#Interface-Method Reference)
- (#Name-And-Type Name-And-Type))
+ (#Field (Reference Field))
+ (#Method (Reference //descriptor.Method))
+ (#Interface-Method (Reference //descriptor.Method))
+ (#Name-And-Type (Name-And-Type Any)))
(def: #export equivalence
(Equivalence Constant)
diff --git a/stdlib/source/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/lux/target/jvm/encoding/unsigned.lux
index 15dd7a07e..86495f38e 100644
--- a/stdlib/source/lux/target/jvm/encoding/unsigned.lux
+++ b/stdlib/source/lux/target/jvm/encoding/unsigned.lux
@@ -17,18 +17,18 @@
(abstract: #export (Unsigned brand)
{}
- (I64 Any)
+ Nat
(def: #export nat
- (-> (Unsigned Any) (I64 Any))
+ (-> (Unsigned Any) Nat)
(|>> :representation))
(structure: #export equivalence
(All [brand] (Equivalence (Unsigned brand)))
(def: (= reference sample)
- ("lux i64 =" (:representation reference) (:representation sample))))
+ (n/= (:representation reference) (:representation sample))))
- (template [<bytes> <name> <size> <constructor> <max>]
+ (template [<bytes> <name> <size> <constructor> <max> <+>]
[(with-expansions [<raw> (template.identifier [<name> "'"])]
(abstract: #export <raw> {} Any)
(type: #export <name> (Unsigned <raw>)))
@@ -40,19 +40,26 @@
(|> <bytes> (n/* i64.bits-per-byte) i64.mask :abstraction))
(def: #export <constructor>
- (-> (I64 Any) <name>)
- (|>> (i64.and (:representation <max>)) :abstraction))]
+ (-> Nat <name>)
+ (|>> (i64.and (:representation <max>)) :abstraction))
- [1 U1 u1-bytes u1 max-u1]
- [2 U2 u2-bytes u2 max-u2]
- [4 U4 u4-bytes u4 max-u4]
+ (def: #export (<+> parameter subject)
+ (-> <name> <name> <name>)
+ (:abstraction
+ (i64.and (:representation <max>)
+ (n/+ (:representation parameter)
+ (:representation subject)))))]
+
+ [1 U1 u1-bytes u1 max-u1 u1/+]
+ [2 U2 u2-bytes u2 max-u2 u2/+]
+ [4 U4 u4-bytes u4 max-u4 u4/+]
)
)
(template [<parser-name> <writer-name> <type> <parser> <writer> <post-read>]
[(def: #export <parser-name>
(Parser <type>)
- (<>@map <post-read> <parser>))
+ (<>@map (|>> .nat <post-read>) <parser>))
(def: #export <writer-name>
(Writer <type>)
diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux
index c59bf7d58..e6ee82617 100644
--- a/stdlib/source/lux/target/jvm/method.lux
+++ b/stdlib/source/lux/target/jvm/method.lux
@@ -18,12 +18,12 @@
[type
[abstract (#+)]]]
["." // #_
- ["." modifier (#+ Modifier modifiers:)]
- ["#." constant (#+ UTF8)
- [pool (#+ Pool)]]
+ ["#." modifier (#+ Modifier modifiers:)]
["#." index (#+ Index)]
["#." attribute (#+ Attribute)]
- ["#." descriptor (#+ Descriptor)]])
+ ["#." descriptor (#+ Descriptor)]
+ ["#." constant (#+ UTF8)
+ [pool (#+ Pool)]]])
(type: #export #rec Method
{#modifier (Modifier Method)
@@ -49,7 +49,7 @@
(def: #export equivalence
(Equivalence Method)
($_ equivalence.product
- modifier.equivalence
+ //modifier.equivalence
//index.equivalence
//index.equivalence
(row.equivalence //attribute.equivalence)))
@@ -57,7 +57,7 @@
(def: #export (parser pool)
(-> Pool (Parser Method))
($_ <>.and
- modifier.parser
+ //modifier.parser
//index.parser
//index.parser
(<2>.row/16 (//attribute.parser pool))))
@@ -68,7 +68,7 @@
(~~ (template [<writer> <slot>]
[(<writer> (get@ <slot> field))]
- [modifier.writer #modifier]
+ [//modifier.writer #modifier]
[//index.writer #name]
[//index.writer #descriptor]
[(binaryF.row/16 //attribute.writer) #attributes]))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 14:23:53 +0000