diff options
Diffstat (limited to 'stdlib/source/lux/target/jvm/constant/pool.lux')
-rw-r--r-- | stdlib/source/lux/target/jvm/constant/pool.lux | 92 |
1 files changed, 84 insertions, 8 deletions
diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux index a304d5ac4..8fbf5550e 100644 --- a/stdlib/source/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/lux/target/jvm/constant/pool.lux @@ -4,9 +4,12 @@ ["." equivalence (#+ Equivalence)] [monad (#+ do)]] [control - ["." state (#+ State)]] + ["." state (#+ State)] + ["." exception (#+ exception:)]] [data - ["." text ("#;." equivalence)] + ["." error (#+ Error)] + ["." text ("#;." equivalence) + ["%" format]] [format ["." binary (#+ Format)]] [collection @@ -28,7 +31,7 @@ (Equivalence Pool) (row.equivalence //.equivalence)) -(template: (!add <value> <tag> <=>) +(template: (!add <tag> <=> <value>) (function (_ pool) (with-expansions [<index> (as-is (index.index (encoding.to-u2 (n/+ offset idx)))) <try-again> (as-is (recur (.inc idx)))] @@ -49,13 +52,86 @@ [(row.add (<tag> <value>) pool) <index>]))))) +(template: (!raw-index <index>) + (|> <index> index.number encoding.from-u2 .nat)) + +(exception: #export (invalid-index {index (Index Any)} + {maximum Nat}) + (exception.report + ["Index" (|> index !raw-index %.%n)] + ["Maximum" (%.%n maximum)])) + +(exception: #export (invalid-constant {index (Index Any)} + {tag Name}) + (exception.report + ["Index" (|> index !raw-index %.%n)] + ["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 (#error.Success value)] + + _ + [pool (exception.throw ..invalid-constant [<index> (name-of <tag>)])]) + + #.None + [pool (exception.throw ..invalid-index [<index> (row.size pool)])]))) + +(exception: #export (cannot-find {tag Name} {value Text}) + (exception.report + ["Expected tag" (%.%name tag)] + ["Value" value])) + +(template: (!find <tag> <=> <%> <expected>) + (function (_ pool) + (with-expansions [<index> (as-is (index.index (encoding.to-u2 (n/+ offset idx)))) + <try-again> (as-is (recur (.inc idx)))] + (loop [idx 0] + (case (row.nth idx pool) + (#.Some entry) + (case entry + (<tag> actual) + (if (<=> actual <expected>) + [pool + (#error.Success <index>)] + <try-again>) + + _ + <try-again>) + + #.None + [pool + (exception.throw ..cannot-find [(name-of <tag>) (<%> <expected>)])]))))) + +(type: (Adder of) + (-> of (State Pool (Index of)))) + +(type: (Fetcher of) + (-> (Index of) (State Pool (Error of)))) + +(type: (Finder of) + (-> of (State Pool (Error (Index of))))) + (def: #export (utf8 value) - (-> UTF8 (State Pool (Index UTF8))) - (!add value #//.UTF8 text;=)) + (Adder UTF8) + (!add #//.UTF8 text;= value)) + +(def: #export (fetch-utf8 index) + (Fetcher UTF8) + (!fetch #//.UTF8 index)) + +(def: #export (find-utf8 reference) + (Finder UTF8) + (!find #//.UTF8 text;= %.%t reference)) (def: (class' value) - (-> Class (State Pool (Index Class))) - (!add value #//.Class //;=)) + (Adder Class) + (!add #//.Class //;= value)) (def: #export (class name) (-> UTF8 (State Pool (Index Class))) @@ -68,7 +144,7 @@ (-> (Descriptor kind) (State Pool (Index (Descriptor kind))))) (let [value (descriptor.descriptor value)] - (!add value #//.UTF8 text;=))) + (!add #//.UTF8 text;= value))) (def: #export format (Format Pool) |