aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/target/jvm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/target/jvm/constant.lux9
-rw-r--r--stdlib/source/lux/target/jvm/constant/pool.lux91
-rw-r--r--stdlib/source/lux/target/jvm/program.lux12
-rw-r--r--stdlib/source/lux/target/jvm/program/instruction.lux4
4 files changed, 69 insertions, 47 deletions
diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux
index c157d4abb..0f4aca590 100644
--- a/stdlib/source/lux/target/jvm/constant.lux
+++ b/stdlib/source/lux/target/jvm/constant.lux
@@ -127,6 +127,15 @@
(#Interface-Method (Reference //descriptor.Method))
(#Name-And-Type (Name-And-Type Any)))
+(def: #export (size constant)
+ (-> Constant Nat)
+ (case constant
+ (^or (#Long _) (#Double _))
+ 2
+
+ _
+ 1))
+
(def: #export equivalence
(Equivalence Constant)
## TODO: Delete the explicit "structure" and use the combinator
diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux
index 062f7553b..a03bba71b 100644
--- a/stdlib/source/lux/target/jvm/constant/pool.lux
+++ b/stdlib/source/lux/target/jvm/constant/pool.lux
@@ -29,43 +29,45 @@
["#." index (#+ Index)]
["#." descriptor (#+ Field Method Descriptor)]]])
-(def: offset 1)
-
-(type: #export Pool (Row Constant))
+(type: #export Pool [Index (Row [Index Constant])])
(def: #export equivalence
(Equivalence Pool)
- (row.equivalence //.equivalence))
+ (equivalence.product //index.equivalence
+ (row.equivalence (equivalence.product //index.equivalence
+ //.equivalence))))
(template: (!add <tag> <=> <value>)
- (function (_ pool)
- (with-expansions [<index> (as-is (//index.index (//unsigned.u2 (n/+ offset idx))))
- <try-again> (as-is (recur (.inc idx)))]
+ (function (_ [next pool])
+ (with-expansions [<try-again> (as-is (recur (.inc idx)))]
(loop [idx 0]
(case (row.nth idx pool)
(#.Some entry)
(case entry
- (<tag> reference)
+ [index (<tag> reference)]
(if (:: <=> = reference <value>)
- [pool
- <index>]
+ [[next pool]
+ index]
<try-again>)
_
<try-again>)
#.None
- [(row.add (<tag> <value>) pool)
- <index>])))))
+ (let [new (<tag> <value>)]
+ [[(|> next
+ //index.number
+ (//unsigned.u2/+ (//unsigned.u2 (//.size new)))
+ //index.index)
+ (row.add [next new] pool)]
+ next]))))))
(template: (!raw-index <index>)
- (|> <index> //index.number //unsigned.nat .nat))
+ (|> <index> //index.number //unsigned.nat))
-(exception: #export (invalid-index {index (Index Any)}
- {maximum Nat})
+(exception: #export (invalid-index {index (Index Any)})
(exception.report
- ["Index" (|> index !raw-index %.nat)]
- ["Maximum" (%.nat maximum)]))
+ ["Index" (|> index !raw-index %.nat)]))
(exception: #export (invalid-constant {index (Index Any)}
{tag Name})
@@ -74,19 +76,30 @@
["Expected tag" (%.name tag)]))
(template: (!fetch <tag> <index>)
- (function (_ pool)
- (case (row.nth (|> <index> !raw-index (n/- offset))
- pool)
- (#.Some entry)
- (case entry
- (<tag> value)
- [pool (#try.Success value)]
+ (with-expansions [<failure> (as-is [[next pool] (exception.throw ..invalid-index [<index>])])]
+ (function (_ [next pool])
+ (loop [idx 0]
+ (case (row.nth idx pool)
+ (#.Some [index entry])
+ (let [index' (!raw-index index)
+ <index>' (!raw-index <index>)]
+ (cond (n/< index' <index>')
+ (recur (inc idx))
- _
- [pool (exception.throw ..invalid-constant [<index> (name-of <tag>)])])
+ (n/= index' <index>')
+ (case entry
+ (<tag> value)
+ [[next pool] (#try.Success value)]
- #.None
- [pool (exception.throw ..invalid-index [<index> (row.size pool)])])))
+ _
+ [[next pool] (exception.throw ..invalid-constant [<index> (name-of <tag>)])])
+
+ ## (n/> index' <index>')
+ <failure>))
+
+ #.None
+ <failure>))
+ )))
(exception: #export (cannot-find {tag Name} {value Text})
(exception.report
@@ -94,24 +107,23 @@
["Value" value]))
(template: (!find <tag> <=> <%> <expected>)
- (function (_ pool)
- (with-expansions [<index> (as-is (//index.index (//unsigned.u2 (n/+ offset idx))))
- <try-again> (as-is (recur (.inc idx)))]
+ (function (_ [next pool])
+ (with-expansions [<try-again> (as-is (recur (.inc idx)))]
(loop [idx 0]
(case (row.nth idx pool)
- (#.Some entry)
+ (#.Some [index entry])
(case entry
(<tag> actual)
(if (:: <=> = actual <expected>)
- [pool
- (#try.Success <index>)]
+ [[next pool]
+ (#try.Success index)]
<try-again>)
_
<try-again>)
#.None
- [pool
+ [[next pool]
(exception.throw ..cannot-find [(name-of <tag>) (<%> <expected>)])])))))
(type: (Adder of)
@@ -193,12 +205,13 @@
(def: #export writer
(Writer Pool)
- (function (_ pool)
- (row@fold (function (_ post pre)
+ (function (_ [next pool])
+ (row@fold (function (_ [_index post] pre)
(specification@compose pre (//.writer post)))
- (binaryF.bits/16 (n/+ ..offset (row.size pool)))
+ (binaryF.bits/16 (!raw-index next))
pool)))
(def: #export empty
Pool
- row.empty)
+ [(|> 1 //unsigned.u2 //index.index)
+ row.empty])
diff --git a/stdlib/source/lux/target/jvm/program.lux b/stdlib/source/lux/target/jvm/program.lux
index 85f21a152..aeb3e0b0a 100644
--- a/stdlib/source/lux/target/jvm/program.lux
+++ b/stdlib/source/lux/target/jvm/program.lux
@@ -484,12 +484,12 @@
(//constant/pool.method class)
{#//constant/pool.name method
#//constant/pool.descriptor (//descriptor.method inputs output)})]
- (wrap (/instruction.invokestatic
- index
- (|> inputs
- (list@map descriptor-size)
- (list@fold //unsigned.u1/+ (//unsigned.u1 (if <static?> 0 1))))
- (descriptor-size output)))))]
+ (..nullary (<instruction>
+ index
+ (|> inputs
+ (list@map descriptor-size)
+ (list@fold //unsigned.u1/+ (//unsigned.u1 (if <static?> 0 1))))
+ (descriptor-size output)))))]
[#1 invokestatic /instruction.invokestatic]
[#0 invokevirtual /instruction.invokevirtual]
diff --git a/stdlib/source/lux/target/jvm/program/instruction.lux b/stdlib/source/lux/target/jvm/program/instruction.lux
index 07f769082..4f9c43f56 100644
--- a/stdlib/source/lux/target/jvm/program/instruction.lux
+++ b/stdlib/source/lux/target/jvm/program/instruction.lux
@@ -449,8 +449,8 @@
["13" ldc-w/integer [[index (Index ///constant.Integer)]] [(///index.number index)] 0 1 []]
["13" ldc-w/float [[index (Index ///constant.Float)]] [(///index.number index)] 0 1 []]
["13" ldc-w/string [[index (Index ///constant.String)]] [(///index.number index)] 0 1 []]
- ["14" ldc2-w/long [[index (Index ///constant.Long)]] [(///index.number index)] 0 1 []]
- ["14" ldc2-w/double [[index (Index ///constant.Double)]] [(///index.number index)] 0 1 []]
+ ["14" ldc2-w/long [[index (Index ///constant.Long)]] [(///index.number index)] 0 2 []]
+ ["14" ldc2-w/double [[index (Index ///constant.Double)]] [(///index.number index)] 0 2 []]
<fields>
["BB" new [[index (Index Class)]] [(///index.number index)] 0 1 []]
["BD" anewarray [[index (Index Class)]] [(///index.number index)] 1 1 []]
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-14 02:24:14 +0000