diff options
author | Eduardo Julian | 2019-06-20 02:58:58 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-06-20 02:58:58 -0400 |
commit | 9232a46b040d42c9489b8b0ed5921c9f75ebaf68 (patch) | |
tree | 70b158c6eb774f7fbfd274ede88972a3cd03b380 | |
parent | 3553c81d0ac93cde12f6b8ceacf8af10ba5da2f1 (diff) |
Re-factored code attributes.
-rw-r--r-- | stdlib/source/lux/target/jvm/attribute.lux | 156 | ||||
-rw-r--r-- | stdlib/source/lux/target/jvm/attribute/code.lux | 165 |
2 files changed, 174 insertions, 147 deletions
diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux index 6c7f92812..946f58477 100644 --- a/stdlib/source/lux/target/jvm/attribute.lux +++ b/stdlib/source/lux/target/jvm/attribute.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Info Code' Code) + [lux (#- Info Code) [abstract [monad (#+ do)] ["." equivalence (#+ Equivalence)]] @@ -11,9 +11,7 @@ ["." product] ["." error] [format - [".F" binary (#+ Reader Writer Format) ("#@." monoid)]] - [collection - ["." row (#+ Row) ("#@." functor fold)]]] + [".F" binary (#+ Reader Writer Format) ("#@." monoid)]]] [world ["." binary (#+ Binary)]]] ["." // #_ @@ -22,7 +20,8 @@ ["#." constant (#+ UTF8 Class Value) ["#/." pool (#+ Pool)]]] ["." / #_ - ["#." constant (#+ Constant)]]) + ["#." constant (#+ Constant)] + ["#." code]]) (type: #export (Info about) {#name (Index UTF8) @@ -49,59 +48,7 @@ [($_ n/+ nameS lengthS infoS) (|>> nameT lengthT infoT)]))) -(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 - #code Binary - #exception-table (Row Exception) - #attributes (Row 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))] +(with-expansions [<Code> (as-is (/code.Code Attribute))] (type: #export #rec Attribute (#Constant (Info Constant)) (#Code (Info <Code>))) @@ -110,57 +57,13 @@ <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) (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 - )) + (info-equivalence (/code.equivalence equivalence)))))) (def: fixed-attribute-length ($_ n/+ @@ -199,29 +102,7 @@ (#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)))) + (/code.length ..length specification)) #info specification})) (def: #export (code specification) @@ -252,30 +133,11 @@ (:: @ map (..constant' @name) (get@ #binaryF.reader /constant.format)) (_@= ?@code (#error.Success @name)) - (:: @ map (..code' @name) (code-reader reader)) + (:: @ map (..code' @name) (/code.reader reader)) ## else (<>.fail (exception.construct ..invalid-attribute [])))))))) -(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 @@ -284,5 +146,5 @@ attribute) (#Code attribute) - ((info-writer (code-writer' writer)) + ((info-writer (/code.writer writer)) attribute))) diff --git a/stdlib/source/lux/target/jvm/attribute/code.lux b/stdlib/source/lux/target/jvm/attribute/code.lux new file mode 100644 index 000000000..9d65fe1d9 --- /dev/null +++ b/stdlib/source/lux/target/jvm/attribute/code.lux @@ -0,0 +1,165 @@ +(.module: + [lux (#- Code) + [type (#+ :share)] + [abstract + ["." equivalence (#+ Equivalence)]] + [control + ["<>" parser]] + [data + [format + [".F" binary (#+ Reader Writer Format) ("#@." monoid)]] + [collection + ["." row (#+ Row) ("#@." functor fold)]]] + [world + ["." binary (#+ Binary)]]] + ["." /// #_ + [constant (#+ Class)] + ["#." encoding (#+ U2)] + ["#." index (#+ Index)]]) + +(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 + )) + +## 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: exception-format + (Format Exception) + ($_ binaryF.and + ..label-format + ..label-format + ..label-format + ///index.format + )) + +(type: #export (Code Attribute) + {#max-stack U2 + #max-locals U2 + #code Binary + #exception-table (Row Exception) + #attributes (Row Attribute)}) + +(def: #export (length length code) + (All [Attribute] (-> (-> Attribute Nat) (Code Attribute) Nat)) + ($_ 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 code)) + ## u2 exception_table_length; + ///encoding.u2-bytes + ## exception_table[exception_table_length]; + (|> code + (get@ #exception-table) + row.size + (n/* ..exception-frame-length)) + ## u2 attributes_count; + ///encoding.u2-bytes + ## attribute_info attributes[attributes_count]; + (|> code + (get@ #attributes) + (row@map length) + (row@fold n/+ 0)))) + +(def: #export (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) + )) + +## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3 +(def: #export (reader reader) + (All [Attribute] (-> (Reader Attribute) (Reader (Code Attribute)))) + (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 (writer writer code) + (All [Attribute] (-> (Writer Attribute) (Writer (Code Attribute)))) + ($_ binaryF@compose + ## u2 max_stack; + ((get@ #binaryF.writer ///encoding.u2-format) + (get@ #max-stack code)) + ## u2 max_locals; + ((get@ #binaryF.writer ///encoding.u2-format) + (get@ #max-locals code)) + ## u4 code_length; + ## u1 code[code_length]; + ((get@ #binaryF.writer binaryF.binary/32) + (get@ #code code)) + ## u2 exception_table_length; + ## exception_table[exception_table_length]; + ((get@ #binaryF.writer (binaryF.row/16 exception-format)) + (get@ #exception-table code)) + ## u2 attributes_count; + ## attribute_info attributes[attributes_count]; + ((get@ #binaryF.writer (binaryF.row/16 {## TODO: Get rid of this dirty hack ASAP + #binaryF.reader (:share [Attribute] + {(Writer Attribute) + writer} + {(Reader Attribute) + (<>.fail "")}) + #binaryF.writer writer})) + (get@ #attributes code)) + )) |