Improved machinery for working with constant pools.

1 files changed, 68 insertions, 0 deletions

diff --git a/stdlib/source/lux/host/jvm/constant/pool.lux b/stdlib/source/lux/host/jvm/constant/pool.lux
new file mode 100644
index 000000000..8d221712b
--- /dev/null
+++ b/stdlib/source/lux/host/jvm/constant/pool.lux
@@ -0,0 +1,68 @@
+(.module:
+  [lux #*
+   [data
+    [text ("text/." Equivalence<Text>)]
+    [format
+     ["." binary (#+ Format)]]
+    [collection
+     [list ("list/." Fold<List>)]
+     ["." row (#+ Row)]]]]
+  ["." // (#+ Constant)
+   [//
+    ["." encoding ("u2/." Equivalence<U2>)]
+    ["." index (#+ Index)]]])
+
+(def: offset 1)
+
+(type: #export Pool (Row Constant))
+
+(def: #export (utf8 value pool)
+  (-> Text Pool [Pool Index])
+  (with-expansions [<index> (as-is (index.index (n/+ offset idx)))
+                    <try-again> (as-is (recur (.inc idx)))]
+    (loop [idx 0]
+      (case (row.nth idx pool)
+        (#.Some entry)
+        (case entry
+          (#//.UTF8 reference)
+          (if (text/= reference value)
+            [pool
+             <index>]
+            <try-again>)
+          
+          _
+          <try-again>)
+        
+        #.None
+        [(row.add (#//.UTF8 value) pool)
+         <index>]))))
+
+(def: (class' value pool)
+  (-> Index Pool [Pool Index])
+  (with-expansions [<index> (as-is (index.index (n/+ offset idx)))
+                    <try-again> (as-is (recur (.inc idx)))]
+    (loop [idx 0]
+      (case (row.nth idx pool)
+        (#.Some entry)
+        (case entry
+          (#//.Class reference)
+          (if (u2/= reference value)
+            [pool
+             <index>]
+            <try-again>)
+          
+          _
+          <try-again>)
+        
+        #.None
+        [(row.add (#//.Class value) pool)
+         <index>]))))
+
+(def: #export (class name pool)
+  (-> Text Pool [Pool Index])
+  (let [[pool @name] (utf8 name pool)]
+    (class' @name pool)))
+
+(def: #export format
+  (Format Pool)
+  (binary.row/16' ..offset //.format))