aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2019-06-20 01:48:52 -0400
committerEduardo Julian2019-06-20 01:48:52 -0400
commit34c2eff22a81db42fe94becb0c07f8ac62834274 (patch)
tree81d031d95a15019739939d12a6d58c79528782a1
parent252e17e22d3e61e08c01e14ca5365d8195cc51b4 (diff)
Expanded serialization capabilities for JVM bytecode.
-rw-r--r--stdlib/source/lux/data/format/binary.lux70
-rw-r--r--stdlib/source/lux/target/jvm/attribute.lux281
-rw-r--r--stdlib/source/lux/target/jvm/class.lux83
-rw-r--r--stdlib/source/lux/target/jvm/constant/pool.lux92
-rw-r--r--stdlib/source/lux/target/jvm/field.lux41
-rw-r--r--stdlib/source/lux/target/jvm/index.lux10
-rw-r--r--stdlib/source/lux/target/jvm/method.lux40
-rw-r--r--stdlib/source/test/lux/target/jvm.lux6
8 files changed, 498 insertions, 125 deletions
diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux
index 771d9f693..4a2909272 100644
--- a/stdlib/source/lux/data/format/binary.lux
+++ b/stdlib/source/lux/data/format/binary.lux
@@ -7,8 +7,10 @@
[equivalence (#+ Equivalence)]]
[control
["." parser (#+ Parser) ("#;." functor)]
+ ["." function]
["ex" exception (#+ exception:)]]
[data
+ ["." product]
["." error (#+ Error)]
[number
["." i64]
@@ -48,11 +50,11 @@
(Parser [Offset Binary]))
(type: #export Mutation
- [Size (-> Offset Binary Binary)])
+ [Size (-> [Offset Binary] [Offset Binary])])
(def: #export no-op
Mutation
- [0 (function (_ offset data) data)])
+ [0 function.identity])
(structure: #export monoid (Monoid Mutation)
@@ -61,10 +63,7 @@
(def: (compose [sizeL mutL] [sizeR mutR])
[(n/+ sizeL sizeR)
- (function (_ offset data)
- (|> data
- (mutL offset)
- (mutR (n/+ sizeL offset))))]))
+ (|>> mutL mutR)]))
(type: #export (Writer a)
(-> a Mutation))
@@ -98,7 +97,7 @@
(def: #export (write format value)
(All [a] (-> (Format a) a Binary))
(let [[valueS valueT] ((get@ #writer format) value)]
- (|> valueS binary.create (valueT 0))))
+ (|> valueS binary.create [0] valueT product.right)))
(template [<name> <size> <read> <write>]
[(def: #export <name>
@@ -112,10 +111,11 @@
(#error.Failure error)))
#writer (function (_ value)
[<size>
- (function (_ offset binary)
- (|> binary
- (<write> offset value)
- error.assume))])})]
+ (function (_ [offset binary])
+ [(n/+ <size> offset)
+ (|> binary
+ (<write> offset value)
+ error.assume)])])})]
[bits/8 size/8 binary.read/8 binary.write/8]
[bits/16 size/16 binary.read/16 binary.write/16]
@@ -136,32 +136,31 @@
(#.Left leftV)
(let [[leftS leftT] ((get@ #writer leftB) leftV)]
[(.inc leftS)
- (function (_ offset binary)
+ (function (_ [offset binary])
(|> binary
(binary.write/8 offset 0)
error.assume
- (leftT (.inc offset))))])
+ [(.inc offset)]
+ leftT))])
(#.Right rightV)
(let [[rightS rightT] ((get@ #writer rightB) rightV)]
[(.inc rightS)
- (function (_ offset binary)
+ (function (_ [offset binary])
(|> binary
(binary.write/8 offset 1)
error.assume
- (rightT (.inc offset))))])
+ [(.inc offset)]
+ rightT))])
))})
(def: #export (and preB postB)
(All [a b] (-> (Format a) (Format b) (Format [a b])))
{#reader (parser.and (get@ #reader preB) (get@ #reader postB))
#writer (function (_ [preV postV])
- (let [[preS preT] ((get@ #writer preB) preV)
- [postS postT] ((get@ #writer postB) postV)]
- [(n/+ preS postS)
- (function (_ offset)
- (|>> (preT offset)
- (postT (n/+ preS offset))))]))})
+ (:: ..monoid compose
+ ((get@ #writer preB) preV)
+ ((get@ #writer postB) postV)))})
(def: #export (rec body)
(All [a] (-> (-> (Format a) (Format a)) (Format a)))
@@ -201,10 +200,11 @@
(#error.Failure error)))
#writer (function (_ value)
[1
- (function (_ offset binary)
- (|> binary
- (binary.write/8 offset (if value 1 0))
- error.assume))])})
+ (function (_ [offset binary])
+ [(n/+ 1 offset)
+ (|> binary
+ (binary.write/8 offset (if value 1 0))
+ error.assume)])])})
(def: #export nat (Format Nat) (:assume ..bits/64))
(def: #export int (Format Int) (:assume ..bits/64))
@@ -230,13 +230,15 @@
output (binary.slice offset (.dec end) binary)]
(wrap [[end binary] output]))))
#writer (function (_ value)
- (let [size (|> value binary.size (i64.and mask))]
- [(n/+ <size> size)
- (function (_ offset binary)
- (error.assume
- (do error.monad
- [_ (<write> offset size binary)]
- (binary.copy size 0 value (n/+ <size> offset) binary))))]))}))]
+ (let [size (|> value binary.size (i64.and mask))
+ size' (n/+ <size> size)]
+ [size'
+ (function (_ [offset binary])
+ [(n/+ size' offset)
+ (error.assume
+ (do error.monad
+ [_ (<write> offset size binary)]
+ (binary.copy size 0 value (n/+ <size> offset) binary)))])]))}))]
[binary/8 ..bits/8 ..size/8 binary.write/8]
[binary/16 ..bits/16 ..size/16 binary.write/16]
@@ -296,11 +298,11 @@
(mutation;compose pre post))
mutation;identity))]
[(n/+ <size> size)
- (function (_ offset binary)
+ (function (_ [offset binary])
(error.assume
(do error.monad
[_ (<write> offset (n/+ extra-count capped-count) binary)]
- (wrap (mutation (n/+ <size> offset) binary)))))]))})
+ (wrap (mutation [(n/+ <size> offset) binary])))))]))})
(def: #export <name>
(All [v] (-> (Format v) (Format (Row v))))
diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux
index 024f0ec3f..c867f1e57 100644
--- a/stdlib/source/lux/target/jvm/attribute.lux
+++ b/stdlib/source/lux/target/jvm/attribute.lux
@@ -1,17 +1,21 @@
(.module:
[lux (#- Info Code' Code)
[abstract
- ["." equivalence (#+ Equivalence)]
- [monad (#+ do)]]
+ [monad (#+ do)]
+ ["." equivalence (#+ Equivalence)]]
[control
- ["." state (#+ State)]]
+ ["." state (#+ State)]
+ ["." exception (#+ exception:)]
+ ["<>" parser]]
[data
+ ["." product]
+ ["." error]
[format
- ["." binary (#+ Format)]]
+ [".F" binary (#+ Reader Writer Format) ("#@." monoid)]]
[collection
- ["." row (#+ Row)]]]
+ ["." row (#+ Row) ("#@." functor fold)]]]
[world
- [binary (#+ Binary)]]]
+ ["." binary (#+ Binary)]]]
["." // #_
["#." encoding (#+ U2 U4)]
["#." index (#+ Index)]
@@ -32,34 +36,62 @@
//encoding.u4-equivalence
Equivalence<about>))
-(def: (info-format about)
+(def: (info-writer writer)
(All [about]
- (-> (Format about)
- (Format (Info about))))
- ($_ binary.and
- //index.format
- //encoding.u4-format
- about))
+ (-> (Writer about)
+ (Writer (Info about))))
+ (function (_ [name length info])
+ (let [[nameS nameT] ((get@ #binaryF.writer //index.format) name)
+ [lengthS lengthT] ((get@ #binaryF.writer //encoding.u4-format) length)
+ [infoS infoT] (writer info)]
+ [($_ n/+ nameS lengthS infoS)
+ (|>> nameT lengthT infoT)])))
(type: #export Constant
- (Info (Index (Value Any))))
+ (Index (Value Any)))
(def: #export constant-equivalence
(Equivalence Constant)
- (..info-equivalence //index.equivalence))
+ //index.equivalence)
(def: constant-format
(Format Constant)
- (..info-format //index.format))
+ //index.format)
(type: #export Label U2)
+(def: #export label-equivalence
+ (Equivalence Label)
+ //encoding.u2-equivalence)
+
+(def: #export label-format
+ (Format Label)
+ //encoding.u2-format)
+
(type: #export Exception
{#start-pc Label
#end-pc Label
#handler-pc Label
#catch-type (Index Class)})
+(def: #export exception-equivalence
+ (Equivalence Exception)
+ ($_ equivalence.product
+ ..label-equivalence
+ ..label-equivalence
+ ..label-equivalence
+ //index.equivalence
+ ))
+
+(def: exception-format
+ (Format Exception)
+ ($_ binaryF.and
+ ..label-format
+ ..label-format
+ ..label-format
+ //index.format
+ ))
+
(type: #export (Code' Attribute)
{#max-stack U2
#max-locals U2
@@ -67,37 +99,204 @@
#exception-table (Row Exception)
#attributes (Row Attribute)})
-(with-expansions [<Code> (as-is (Info (Code' Attribute)))]
+(def: (code'-equivalence attribute-equivalence)
+ (All [attribute]
+ (-> (Equivalence attribute) (Equivalence (Code' attribute))))
+ ($_ equivalence.product
+ //encoding.u2-equivalence
+ //encoding.u2-equivalence
+ binary.equivalence
+ (row.equivalence ..exception-equivalence)
+ (row.equivalence attribute-equivalence)
+ ))
+
+(with-expansions [<Code> (as-is (Code' Attribute))]
(type: #export #rec Attribute
- (#Constant Constant)
- ## (#Code <Code>)
- )
+ (#Constant (Info Constant))
+ (#Code (Info <Code>)))
- ## (type: #export Code
- ## <Code>)
+ (type: #export Code
+ <Code>)
)
+## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3
+(def: (code-reader reader)
+ (-> (Reader Attribute) (Reader Code))
+ (let [u2-reader (get@ #binaryF.reader
+ //encoding.u2-format)]
+ ($_ <>.and
+ ## u2 max_stack;
+ u2-reader
+ ## u2 max_locals;
+ u2-reader
+ ## u4 code_length;
+ ## u1 code[code_length];
+ (get@ #binaryF.reader
+ binaryF.binary/32)
+ ## u2 exception_table_length;
+ ## exception_table[exception_table_length];
+ (get@ #binaryF.reader
+ (binaryF.row/16 ..exception-format))
+ ## u2 attributes_count;
+ ## attribute_info attributes[attributes_count];
+ (get@ #binaryF.reader
+ (binaryF.row/16 {#binaryF.reader reader
+ ## TODO: Get rid of this dirty hack ASAP
+ #binaryF.writer (function (_ _value)
+ binaryF.no-op)}))
+ )))
+
(def: #export equivalence
(Equivalence Attribute)
- ..constant-equivalence)
+ (equivalence.rec
+ (function (_ equivalence)
+ ($_ equivalence.sum
+ (info-equivalence ..constant-equivalence)
+ (info-equivalence (..code'-equivalence equivalence))))))
+
+(def: #export code-equivalence
+ (Equivalence Code)
+ (code'-equivalence ..equivalence))
+
+## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3
+(def: exception-frame-length
+ ($_ n/+
+ ## u2 start_pc;
+ //encoding.u2-bytes
+ ## u2 end_pc;
+ //encoding.u2-bytes
+ ## u2 handler_pc;
+ //encoding.u2-bytes
+ ## u2 catch_type;
+ //encoding.u2-bytes
+ ))
+
+(def: fixed-attribute-length
+ ($_ n/+
+ ## u2 attribute_name_index;
+ //encoding.u2-bytes
+ ## u4 attribute_length;
+ //encoding.u4-bytes
+ ))
+
+(def: constant-length
+ //encoding.u2-bytes)
+
+(def: (length attribute)
+ (-> Attribute Nat)
+ (case attribute
+ (^template [<tag>]
+ (<tag> [name length info])
+ (|> length //encoding.from-u4 .nat (n/+ fixed-attribute-length)))
+ ([#Constant] [#Code])))
+
+(def: constant-name "ConstantValue")
+
+(def: (constant' @name index)
+ (-> (Index UTF8) Constant Attribute)
+ (#Constant {#name @name
+ #length (//encoding.to-u4 ..constant-length)
+ #info index}))
(def: #export (constant index)
- (-> (Index (Value Any))
- (State Pool Attribute))
+ (-> Constant (State Pool Attribute))
+ (do state.monad
+ [@name (//constant/pool.utf8 ..constant-name)]
+ (wrap (constant' @name index))))
+
+(def: code-name "Code")
+
+(def: (code' @name specification)
+ (-> (Index UTF8) Code Attribute)
+ (#Code {#name @name
+ ## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3
+ #length (//encoding.to-u4
+ ($_ n/+
+ ## u2 max_stack;
+ //encoding.u2-bytes
+ ## u2 max_locals;
+ //encoding.u2-bytes
+ ## u4 code_length;
+ //encoding.u4-bytes
+ ## u1 code[code_length];
+ (binary.size (get@ #code specification))
+ ## u2 exception_table_length;
+ //encoding.u2-bytes
+ ## exception_table[exception_table_length];
+ (|> specification
+ (get@ #exception-table)
+ row.size
+ (n/* exception-frame-length))
+ ## u2 attributes_count;
+ //encoding.u2-bytes
+ ## attribute_info attributes[attributes_count];
+ (|> specification
+ (get@ #attributes)
+ (row@map ..length)
+ (row@fold n/+ 0))))
+ #info specification}))
+
+(def: #export (code specification)
+ (-> Code (State Pool Attribute))
(do state.monad
- [@name (//constant/pool.utf8 "ConstantValue")]
- (wrap {#name @name
- #length (//encoding.to-u4 //encoding.u2-bytes)
- #info index})))
-
-## (def: #export (code specification)
-## (-> Code' (State Pool Attribute))
-## (do state.monad
-## [@name (//constant/pool.utf8 "Code")]
-## (wrap (#Code {#name @name
-## #length (undefined)
-## #info specification}))))
-
-(def: #export format
- (Format Attribute)
- ..constant-format)
+ [@name (//constant/pool.utf8 ..code-name)]
+ (wrap (code' @name specification))))
+
+(exception: #export invalid-attribute)
+
+(def: #export (reader pool)
+ (-> Pool (Reader Attribute))
+ (let [?@constant (|> ..constant-name
+ //constant/pool.find-utf8
+ (state.run pool)
+ product.right)
+ ?@code (|> ..code-name
+ //constant/pool.find-utf8
+ (state.run pool)
+ product.right)
+ (^open "_@.") (error.equivalence //index.equivalence)]
+ (<>.rec
+ (function (_ reader)
+ (do <>.monad
+ [@name (get@ #binaryF.reader //index.format)
+ length (get@ #binaryF.reader //encoding.u4-format)]
+ (cond (_@= ?@constant (#error.Success @name))
+ (:: @ map (..constant' @name) (get@ #binaryF.reader ..constant-format))
+
+ (_@= ?@code (#error.Success @name))
+ (:: @ map (..code' @name) (code-reader reader))
+
+ ## else
+ (<>.fail (exception.construct ..invalid-attribute []))))))))
+
+(def: constant-writer
+ (Writer Constant)
+ (get@ #binaryF.writer //index.format))
+
+(def: (code-writer' writer code)
+ (-> (Writer Attribute) (Writer Code))
+ (let [format (: (Format Attribute)
+ {## TODO: Get rid of this dirty hack ASAP
+ #binaryF.reader (<>.fail "")
+ #binaryF.writer writer})]
+ ($_ binaryF@compose
+ ((get@ #binaryF.writer //encoding.u2-format)
+ (get@ #max-stack code))
+ ((get@ #binaryF.writer //encoding.u2-format)
+ (get@ #max-locals code))
+ ((get@ #binaryF.writer binaryF.binary/32)
+ (get@ #code code))
+ ((get@ #binaryF.writer (binaryF.row/16 exception-format))
+ (get@ #exception-table code))
+ ((get@ #binaryF.writer (binaryF.row/16 format))
+ (get@ #attributes code))
+ )))
+
+(def: #export (writer value)
+ (Writer Attribute)
+ (case value
+ (#Constant attribute)
+ ((info-writer constant-writer) attribute)
+
+ (#Code attribute)
+ ((info-writer (code-writer' writer)) attribute)))
diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux
index 15b2f5392..4677f33e4 100644
--- a/stdlib/source/lux/target/jvm/class.lux
+++ b/stdlib/source/lux/target/jvm/class.lux
@@ -1,17 +1,17 @@
(.module:
[lux #*
[abstract
- ["." equivalence (#+ Equivalence)]
[monoid (#+)]
+ ["." equivalence (#+ Equivalence)]
["." monad (#+ do)]]
[control
- [parser (#+)]
+ ["<>" parser]
["." state (#+ State)]]
[data
[number (#+)
[i64 (#+)]]
[format
- ["." binary (#+ Format)]]
+ [".F" binary (#+ Reader Writer Format) ("#@." monoid)]]
[collection
["." row (#+ Row)]]]
[type
@@ -112,17 +112,70 @@
#methods methods
#attributes attributes}))
+(def: #export reader
+ (Reader Class)
+ (do <>.monad
+ [magic (get@ #binaryF.reader //magic.format)
+ minor-version (get@ #binaryF.reader //version.format)
+ major-version (get@ #binaryF.reader //version.format)
+ constant-pool (get@ #binaryF.reader //constant/pool.format)
+ modifier (get@ #binaryF.reader ..modifier-format)
+ this (get@ #binaryF.reader //index.format)
+ super (get@ #binaryF.reader //index.format)
+ interfaces (get@ #binaryF.reader (binaryF.row/16 //index.format))
+ fields (get@ #binaryF.reader (binaryF.row/16 (: (Format Field)
+ {#binaryF.reader (//field.reader constant-pool)
+ ## TODO: Get rid of this dirty hack ASAP
+ #binaryF.writer (function (_ _) binaryF.no-op)})))
+ methods (get@ #binaryF.reader (binaryF.row/16 (: (Format Method)
+ {#binaryF.reader (//method.reader constant-pool)
+ ## TODO: Get rid of this dirty hack ASAP
+ #binaryF.writer (function (_ _) binaryF.no-op)})))
+ attributes (get@ #binaryF.reader (binaryF.row/16 (: (Format Attribute)
+ {#binaryF.reader (//attribute.reader constant-pool)
+ ## TODO: Get rid of this dirty hack ASAP
+ #binaryF.writer (function (_ _) binaryF.no-op)})))]
+ (wrap {#magic magic
+ #minor-version minor-version
+ #major-version major-version
+ #constant-pool constant-pool
+ #modifier modifier
+ #this this
+ #super super
+ #interfaces interfaces
+ #fields fields
+ #methods methods
+ #attributes attributes})))
+
+(def: #export (writer class)
+ (Writer Class)
+ (`` ($_ binaryF@compose
+ (~~ (template [<format> <slot>]
+ [((get@ #binaryF.writer <format>) (get@ <slot> class))]
+
+ [//magic.format #magic]
+ [//version.format #minor-version]
+ [//version.format #major-version]
+ [//constant/pool.format #constant-pool]
+ [..modifier-format #modifier]
+ [//index.format #this]
+ [//index.format #super]
+ [(binaryF.row/16 //index.format) #interfaces]))
+ (~~ (template [<type> <writer> <slot>]
+ [((get@ #binaryF.writer
+ (binaryF.row/16 (: (Format <type>)
+ {## TODO: Get rid of this dirty hack ASAP
+ #binaryF.reader (<>.fail "")
+ #binaryF.writer <writer>})))
+ (get@ <slot> class))]
+
+ [Field //field.writer #fields]
+ [Method //method.writer #methods]
+ [Attribute //attribute.writer #attributes]
+ ))
+ )))
+
(def: #export format
(Format Class)
- ($_ binary.and
- //magic.format
- //version.format
- //version.format
- //constant/pool.format
- ..modifier-format
- //index.format
- //index.format
- (binary.row/16 //index.format)
- (binary.row/16 //field.format)
- (binary.row/16 //method.format)
- (binary.row/16 //attribute.format)))
+ {#binaryF.reader ..reader
+ #binaryF.writer ..writer})
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)
diff --git a/stdlib/source/lux/target/jvm/field.lux b/stdlib/source/lux/target/jvm/field.lux
index 930ca97d8..2e0082fe2 100644
--- a/stdlib/source/lux/target/jvm/field.lux
+++ b/stdlib/source/lux/target/jvm/field.lux
@@ -1,17 +1,17 @@
(.module:
[lux (#- static)
[abstract
- ["." equivalence (#+ Equivalence)]
[monoid (#+)]
+ ["." equivalence (#+ Equivalence)]
["." monad (#+ do)]]
[control
- [parser (#+)]
- ["." state (#+ State)]]
+ ["." state (#+ State)]
+ ["<>" parser]]
[data
[number (#+)
[i64 (#+)]]
[format
- ["." binary (#+ Format)]]
+ [".F" binary (#+ Reader Writer Format) ("#@." monoid)]]
[collection
["." row (#+ Row)]]]
[type
@@ -51,13 +51,32 @@
//index.equivalence
(row.equivalence //attribute.equivalence)))
-(def: #export format
- (Format Field)
- ($_ binary.and
- ..modifier-format
- //index.format
- //index.format
- (binary.row/16 //attribute.format)))
+(def: #export (reader pool)
+ (-> Pool (Reader Field))
+ ($_ <>.and
+ (get@ #binaryF.reader ..modifier-format)
+ (get@ #binaryF.reader //index.format)
+ (get@ #binaryF.reader //index.format)
+ (get@ #binaryF.reader
+ (binaryF.row/16 {#binaryF.reader (//attribute.reader pool)
+ ## TODO: Get rid of this dirty hack ASAP
+ #binaryF.writer (function (_ _) binaryF.no-op)}))))
+
+(def: #export (writer field)
+ (Writer Field)
+ (let [attribute-format (: (Format Attribute)
+ {## TODO: Get rid of this dirty hack ASAP
+ #binaryF.reader (<>.fail "")
+ #binaryF.writer //attribute.writer})]
+ (`` ($_ binaryF@compose
+ (~~ (template [<format> <slot>]
+ [((get@ #binaryF.writer <format>) (get@ <slot> field))]
+
+ [..modifier-format #modifier]
+ [//index.format #name]
+ [//index.format #descriptor]
+ [(binaryF.row/16 attribute-format) #attributes]))
+ ))))
(def: #export (field modifier name descriptor attributes)
(-> Modifier UTF8 (Descriptor (Value Any)) (Row Attribute)
diff --git a/stdlib/source/lux/target/jvm/index.lux b/stdlib/source/lux/target/jvm/index.lux
index 3a425dd32..6e3d070ff 100644
--- a/stdlib/source/lux/target/jvm/index.lux
+++ b/stdlib/source/lux/target/jvm/index.lux
@@ -19,15 +19,19 @@
(All [kind] (-> U2 (Index kind)))
(|>> :abstraction))
+ (def: #export number
+ (-> (Index Any) U2)
+ (|>> :representation))
+
(def: #export equivalence
(All [kind] (Equivalence (Index kind)))
(:: equivalence.contravariant map-1
- (|>> :representation)
+ ..number
//encoding.u2-equivalence))
(def: #export format
(All [kind] (Format (Index kind)))
- (binary.adapt (|>> :abstraction)
- (|>> :representation)
+ (binary.adapt ..index
+ ..number
//encoding.u2-format))
)
diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux
index e4f3cdea2..0141e0a2b 100644
--- a/stdlib/source/lux/target/jvm/method.lux
+++ b/stdlib/source/lux/target/jvm/method.lux
@@ -5,13 +5,13 @@
[monoid (#+)]
["." monad (#+ do)]]
[control
- [parser (#+)]
+ ["<>" parser]
["." state (#+ State)]]
[data
[number (#+)
[i64 (#+)]]
[format
- ["." binary (#+ Format)]]
+ [".F" binary (#+ Reader Writer Format) ("#@." monoid)]]
[collection
["." row (#+ Row)]]]
[type
@@ -19,7 +19,8 @@
["." // #_
[encoding (#+)]
[modifier (#+ modifiers:)]
- ["#." constant (#+ UTF8)]
+ ["#." constant (#+ UTF8)
+ [pool (#+ Pool)]]
["#." index (#+ Index)]
["#." attribute (#+ Attribute)]
["#." descriptor (#+ Descriptor)]])
@@ -53,10 +54,29 @@
//index.equivalence
(row.equivalence //attribute.equivalence)))
-(def: #export format
- (Format Method)
- ($_ binary.and
- ..modifier-format
- //index.format
- //index.format
- (binary.row/16 //attribute.format)))
+(def: #export (reader pool)
+ (-> Pool (Reader Method))
+ ($_ <>.and
+ (get@ #binaryF.reader ..modifier-format)
+ (get@ #binaryF.reader //index.format)
+ (get@ #binaryF.reader //index.format)
+ (get@ #binaryF.reader
+ (binaryF.row/16 {#binaryF.reader (//attribute.reader pool)
+ ## TODO: Get rid of this dirty hack ASAP
+ #binaryF.writer (function (_ _) binaryF.no-op)}))))
+
+(def: #export (writer field)
+ (Writer Method)
+ (let [attribute-format (: (Format Attribute)
+ {## TODO: Get rid of this dirty hack ASAP
+ #binaryF.reader (<>.fail "")
+ #binaryF.writer //attribute.writer})]
+ (`` ($_ binaryF@compose
+ (~~ (template [<format> <slot>]
+ [((get@ #binaryF.writer <format>) (get@ <slot> field))]
+
+ [..modifier-format #modifier]
+ [//index.format #name]
+ [//index.format #descriptor]
+ [(binaryF.row/16 attribute-format) #attributes]))
+ ))))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 191af99a7..acef6060f 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -12,7 +12,7 @@
["." text
format]
[format
- ["." binary]]
+ [".F" binary]]
[collection
["." dictionary]
["." row]]]
@@ -94,11 +94,11 @@
(/field.field /field.public field1 descriptor1 (row.row)))
(row.row)
(row.row))
- bytecode (binary.write /class.format input)
+ bytecode (binaryF.write /class.format input)
loader (/loader.memory (/loader.new-library []))]]
($_ _.and
(_.test "Can read a generated class."
- (case (binary.read /class.format bytecode)
+ (case (binaryF.read /class.format bytecode)
(#error.Success output)
(:: /class.equivalence = input output)