diff options
Diffstat (limited to 'stdlib')
19 files changed, 420 insertions, 414 deletions
diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux index 442bf68b2..89a9c709d 100644 --- a/stdlib/source/lux/control/parser/binary.lux +++ b/stdlib/source/lux/control/parser/binary.lux @@ -83,6 +83,10 @@ (let [parser (body (rec body))] (parser input)))) +(def: #export any + (Parser Any) + (//@wrap [])) + (def: #export bit (Parser Bit) (function (_ [offset binary]) @@ -172,13 +176,13 @@ (def: #export maybe (All [a] (-> (Parser a) (Parser (Maybe a)))) - (..or (//@wrap []))) + (..or ..any)) (def: #export (list value) (All [a] (-> (Parser a) (Parser (List a)))) (..rec (function (_ recur) - (..or (//@wrap []) + (..or ..any (//.and value recur))))) (def: #export name diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index 550d4a177..67f36609e 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -48,207 +48,175 @@ (type: #export (Writer a) (-> a Mutation)) -(type: #export (Format a) - {#reader (Parser a) - #writer (Writer a)}) - -(def: #export (adapt post-read pre-write format) - (All [a a'] - (-> (-> a a') - (-> a' a) - (Format a) - (Format a'))) - (let [(^open "_@.") format] - {#reader (|> _@reader (<>@map post-read)) - #writer (|>> pre-write _@writer)})) - -(def: #export (write format value) - (All [a] (-> (Format a) a Binary)) - (let [[valueS valueT] ((get@ #writer format) value)] +(def: #export (run writer value) + (All [a] (-> (Writer a) a Binary)) + (let [[valueS valueT] (writer value)] (|> valueS binary.create [0] valueT product.right))) -(template [<name> <size> <parser> <write>] +(template [<name> <size> <write>] [(def: #export <name> - (Format (I64 Any)) - {#reader <parser> - #writer (function (_ value) - [<size> - (function (_ [offset binary]) - [(n/+ <size> offset) - (|> binary - (<write> offset value) - error.assume)])])})] - - [bits/8 /.size/8 /.bits/8 binary.write/8] - [bits/16 /.size/16 /.bits/16 binary.write/16] - [bits/32 /.size/32 /.bits/32 binary.write/32] - [bits/64 /.size/64 /.bits/64 binary.write/64] + (Writer (I64 Any)) + (function (_ value) + [<size> + (function (_ [offset binary]) + [(n/+ <size> offset) + (|> binary + (<write> offset value) + error.assume)])]))] + + [bits/8 /.size/8 binary.write/8] + [bits/16 /.size/16 binary.write/16] + [bits/32 /.size/32 binary.write/32] + [bits/64 /.size/64 binary.write/64] ) -(def: #export (or leftB rightB) - (All [l r] (-> (Format l) (Format r) (Format (| l r)))) - {#reader (/.or (get@ #reader leftB) - (get@ #reader rightB)) - #writer (function (_ altV) - (case altV - (#.Left leftV) - (let [[leftS leftT] ((get@ #writer leftB) leftV)] - [(.inc leftS) - (function (_ [offset binary]) - (|> binary - (binary.write/8 offset 0) - error.assume - [(.inc offset)] - leftT))]) - - (#.Right rightV) - (let [[rightS rightT] ((get@ #writer rightB) rightV)] - [(.inc rightS) - (function (_ [offset binary]) - (|> binary - (binary.write/8 offset 1) - error.assume - [(.inc offset)] - rightT))]) - ))}) - -(def: #export (and preB postB) - (All [a b] (-> (Format a) (Format b) (Format [a b]))) - {#reader (<>.and (get@ #reader preB) (get@ #reader postB)) - #writer (function (_ [preV postV]) - (:: ..monoid compose - ((get@ #writer preB) preV) - ((get@ #writer postB) postV)))}) +(def: #export (or left right) + (All [l r] (-> (Writer l) (Writer r) (Writer (| l r)))) + (function (_ altV) + (case altV + (#.Left leftV) + (let [[leftS leftT] (left leftV)] + [(.inc leftS) + (function (_ [offset binary]) + (|> binary + (binary.write/8 offset 0) + error.assume + [(.inc offset)] + leftT))]) + + (#.Right rightV) + (let [[rightS rightT] (right rightV)] + [(.inc rightS) + (function (_ [offset binary]) + (|> binary + (binary.write/8 offset 1) + error.assume + [(.inc offset)] + rightT))]) + ))) + +(def: #export (and pre post) + (All [a b] (-> (Writer a) (Writer b) (Writer [a b]))) + (function (_ [preV postV]) + (:: ..monoid compose (pre preV) (post postV)))) (def: #export (rec body) - (All [a] (-> (-> (Format a) (Format a)) (Format a))) - {#reader (function (_ input) - (let [reader (get@ #reader (body (rec body)))] - (reader input))) - #writer (function (_ value) - (let [writer (get@ #writer (body (rec body)))] - (writer value)))}) - -(def: #export (ignore default) - (All [a] (-> a (Format a))) - {#reader (<>@wrap default) - #writer (function (_ value) - ..no-op)}) + (All [a] (-> (-> (Writer a) (Writer a)) (Writer a))) + (function (_ value) + (let [writer (body (rec body))] + (writer value)))) (def: #export any - (Format Any) - (ignore [])) + (Writer Any) + (function.constant ..no-op)) (def: #export bit - (Format Bit) - {#reader /.bit - #writer (function (_ value) - [1 - (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)) -(def: #export rev (Format Rev) (:assume ..bits/64)) + (Writer Bit) + (function (_ value) + [1 + (function (_ [offset binary]) + [(n/+ 1 offset) + (|> binary + (binary.write/8 offset (if value 1 0)) + error.assume)])])) + +(template [<name> <type>] + [(def: #export <name> (Writer <type>) (|>> .i64 ..bits/64))] + + [nat Nat] + [int Int] + [rev Rev] + ) (def: #export frac - (Format Frac) - (let [(^slots [#writer]) ..bits/64] - {#reader /.frac - #writer (|>> frac.frac-to-bits writer)})) + (Writer Frac) + (|>> frac.frac-to-bits ..bits/64)) -(template [<name> <bits> <size> <parser> <write>] +(template [<name> <bits> <size> <write>] [(def: #export <name> - (Format Binary) - {#reader <parser> - #writer (let [mask (..mask <size>)] - (function (_ value) - (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/8 binary.write/8] - [binary/16 ..bits/16 /.size/16 /.binary/16 binary.write/16] - [binary/32 ..bits/32 /.size/32 /.binary/32 binary.write/32] - [binary/64 ..bits/64 /.size/64 /.binary/64 binary.write/64] + (Writer Binary) + (let [mask (..mask <size>)] + (function (_ value) + (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] + [binary/32 ..bits/32 /.size/32 binary.write/32] + [binary/64 ..bits/64 /.size/64 binary.write/64] ) -(template [<name> <parser> <binary>] +(template [<name> <binary>] [(def: #export <name> - (Format Text) - {#reader <parser> - #writer (let [(^open "binary@.") <binary>] - (|>> encoding.to-utf8 binary@writer))})] + (Writer Text) + (|>> encoding.to-utf8 <binary>))] - [utf8/8 /.utf8/8 ..binary/8] - [utf8/16 /.utf8/16 ..binary/16] - [utf8/32 /.utf8/32 ..binary/32] - [utf8/64 /.utf8/64 ..binary/64] + [utf8/8 ..binary/8] + [utf8/16 ..binary/16] + [utf8/32 ..binary/32] + [utf8/64 ..binary/64] ) (def: #export text ..utf8/64) -(template [<name> <with-offset> <bits> <size> <parser> <write>] - [(def: #export (<with-offset> extra-count valueF) - (All [v] (-> Nat (Format v) (Format (Row v)))) - {#reader (<parser> extra-count (get@ #reader valueF)) - #writer (function (_ value) - (let [original-count (row.size value) - capped-count (i64.and (..mask <size>) - original-count) - value (if (n/= original-count capped-count) - value - (|> value row.to-list (list.take capped-count) row.from-list)) - (^open "mutation@.") ..monoid - [size mutation] (|> value - (row@map (get@ #writer valueF)) - (:: row.fold fold - (function (_ post pre) - (mutation@compose pre post)) - mutation@identity))] - [(n/+ <size> size) - (function (_ [offset binary]) - (error.assume - (do error.monad - [_ (<write> offset (n/+ extra-count capped-count) binary)] - (wrap (mutation [(n/+ <size> offset) binary])))))]))}) +(template [<name> <with-offset> <bits> <size> <write>] + [(def: #export (<with-offset> extra-count valueW) + (All [v] (-> Nat (Writer v) (Writer (Row v)))) + (function (_ value) + (let [original-count (row.size value) + capped-count (i64.and (..mask <size>) + original-count) + value (if (n/= original-count capped-count) + value + (|> value row.to-list (list.take capped-count) row.from-list)) + (^open "mutation@.") ..monoid + [size mutation] (|> value + (row@map valueW) + (:: row.fold fold + (function (_ post pre) + (mutation@compose pre post)) + mutation@identity))] + [(n/+ <size> size) + (function (_ [offset binary]) + (error.assume + (do error.monad + [_ (<write> offset (n/+ extra-count capped-count) binary)] + (wrap (mutation [(n/+ <size> offset) binary])))))]))) (def: #export <name> - (All [v] (-> (Format v) (Format (Row v)))) + (All [v] (-> (Writer v) (Writer (Row v)))) (<with-offset> 0))] - [row/8 row/8' ..bits/8 /.size/8 /.row/8' binary.write/8] - [row/16 row/16' ..bits/16 /.size/16 /.row/16' binary.write/16] - [row/32 row/32' ..bits/32 /.size/32 /.row/32' binary.write/32] - [row/64 row/64' ..bits/64 /.size/64 /.row/64' binary.write/64] + [row/8 row/8' ..bits/8 /.size/8 binary.write/8] + [row/16 row/16' ..bits/16 /.size/16 binary.write/16] + [row/32 row/32' ..bits/32 /.size/32 binary.write/32] + [row/64 row/64' ..bits/64 /.size/64 binary.write/64] ) (def: #export maybe - (All [a] (-> (Format a) (Format (Maybe a)))) + (All [a] (-> (Writer a) (Writer (Maybe a)))) (..or ..any)) (def: #export (list value) - (All [a] (-> (Format a) (Format (List a)))) + (All [a] (-> (Writer a) (Writer (List a)))) (..rec (function (_ recur) (..or ..any (..and value recur))))) (def: #export name - (Format Name) + (Writer Name) (..and ..text ..text)) (def: #export type - (Format Type) + (Writer Type) (..rec (function (_ type) (let [pair (..and type type) @@ -280,11 +248,11 @@ ))))) (def: #export cursor - (Format Cursor) + (Writer Cursor) ($_ ..and ..text ..nat ..nat)) (def: #export code - (Format Code) + (Writer Code) (..rec (function (_ code) (let [sequence (..list code) diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux index 06400ef93..662da93a9 100644 --- a/stdlib/source/lux/target/jvm/attribute.lux +++ b/stdlib/source/lux/target/jvm/attribute.lux @@ -12,7 +12,7 @@ ["." product] ["." error] [format - [".F" binary (#+ Writer Format) ("#@." monoid)]]]] + [".F" binary (#+ Writer) ("#@." monoid)]]]] ["." // #_ ["#." index (#+ Index)] [encoding @@ -42,8 +42,8 @@ (-> (Writer about) (Writer (Info about)))) (function (_ [name length info]) - (let [[nameS nameT] ((get@ #binaryF.writer //index.format) name) - [lengthS lengthT] ((get@ #binaryF.writer //unsigned.u4-format) length) + (let [[nameS nameT] (//index.writer name) + [lengthS lengthT] (//unsigned.u4-writer length) [infoS infoT] (writer info)] [($_ n/+ nameS lengthS infoS) (|>> nameT lengthT infoT)]))) @@ -113,7 +113,7 @@ (exception: #export invalid-attribute) -(def: #export (reader pool) +(def: #export (parser pool) (-> Pool (Parser Attribute)) (let [?@constant (|> ..constant-name //constant/pool.find-utf8 @@ -125,15 +125,15 @@ product.right) (^open "_@.") (error.equivalence //index.equivalence)] (<>.rec - (function (_ reader) + (function (_ parser) (do <>.monad - [@name (get@ #binaryF.reader //index.format) - length (get@ #binaryF.reader //unsigned.u4-format)] + [@name //index.parser + length //unsigned.u4-parser] (cond (_@= ?@constant (#error.Success @name)) - (:: @ map (..constant' @name) (get@ #binaryF.reader /constant.format)) + (:: @ map (..constant' @name) /constant.parser) (_@= ?@code (#error.Success @name)) - (:: @ map (..code' @name) (/code.reader reader)) + (:: @ map (..code' @name) (/code.parser parser)) ## else (<>.fail (exception.construct ..invalid-attribute [])))))))) @@ -142,9 +142,7 @@ (Writer Attribute) (case value (#Constant attribute) - ((info-writer (get@ #binaryF.writer /constant.format)) - attribute) + ((info-writer /constant.writer) attribute) (#Code attribute) - ((info-writer (/code.writer writer)) - attribute))) + ((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 index de7ce719a..88b4eb7c9 100644 --- a/stdlib/source/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/lux/target/jvm/attribute/code.lux @@ -63,52 +63,38 @@ )) ## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3 -(def: #export (reader reader) +(def: #export (parser parser) (All [Attribute] (-> (Parser Attribute) (Parser (Code Attribute)))) - (let [u2-reader (get@ #binaryF.reader - ///unsigned.u2-format)] - ($_ <>.and - ## u2 max_stack; - u2-reader - ## u2 max_locals; - u2-reader - ## u4 code_length; - ## u1 code[code_length]; - <2>.binary/32 - ## u2 exception_table_length; - ## exception_table[exception_table_length]; - (<2>.row/16 (get@ #binaryF.reader - /exception.format)) - ## u2 attributes_count; - ## attribute_info attributes[attributes_count]; - (<2>.row/16 reader) - ))) + ($_ <>.and + ## u2 max_stack; + ///unsigned.u2-parser + ## u2 max_locals; + ///unsigned.u2-parser + ## u4 code_length; + ## u1 code[code_length]; + <2>.binary/32 + ## u2 exception_table_length; + ## exception_table[exception_table_length]; + (<2>.row/16 /exception.parser) + ## u2 attributes_count; + ## attribute_info attributes[attributes_count]; + (<2>.row/16 parser) + )) (def: #export (writer writer code) (All [Attribute] (-> (Writer Attribute) (Writer (Code Attribute)))) ($_ binaryF@compose ## u2 max_stack; - ((get@ #binaryF.writer ///unsigned.u2-format) - (get@ #max-stack code)) + (///unsigned.u2-writer (get@ #max-stack code)) ## u2 max_locals; - ((get@ #binaryF.writer ///unsigned.u2-format) - (get@ #max-locals code)) + (///unsigned.u2-writer (get@ #max-locals code)) ## u4 code_length; ## u1 code[code_length]; - ((get@ #binaryF.writer binaryF.binary/32) - (get@ #code code)) + (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)) + ((binaryF.row/16 /exception.writer) (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} - {(Parser Attribute) - (<>.fail "")}) - #binaryF.writer writer})) - (get@ #attributes code)) + ((binaryF.row/16 writer) (get@ #attributes code)) )) diff --git a/stdlib/source/lux/target/jvm/attribute/code/exception.lux b/stdlib/source/lux/target/jvm/attribute/code/exception.lux index c1f4bf581..6f6b8a0be 100644 --- a/stdlib/source/lux/target/jvm/attribute/code/exception.lux +++ b/stdlib/source/lux/target/jvm/attribute/code/exception.lux @@ -2,9 +2,12 @@ [lux #* [abstract ["." equivalence (#+ Equivalence)]] + [control + ["<>" parser ("#@." functor) + ["<2>" binary (#+ Parser)]]] [data [format - [".F" binary (#+ Format)]]]] + [".F" binary (#+ Writer)]]]] ["." // #_ ["#." label (#+ Label)] ["//#" /// #_ @@ -42,11 +45,20 @@ ////unsigned.u2-bytes )) -(def: #export format - (Format Exception) +(def: #export parser + (Parser Exception) + ($_ <>.and + //label.parser + //label.parser + //label.parser + ////index.parser + )) + +(def: #export writer + (Writer Exception) ($_ binaryF.and - //label.format - //label.format - //label.format - ////index.format + //label.writer + //label.writer + //label.writer + ////index.writer )) diff --git a/stdlib/source/lux/target/jvm/attribute/code/label.lux b/stdlib/source/lux/target/jvm/attribute/code/label.lux index 98be2e8ba..69a8d55c3 100644 --- a/stdlib/source/lux/target/jvm/attribute/code/label.lux +++ b/stdlib/source/lux/target/jvm/attribute/code/label.lux @@ -1,10 +1,7 @@ (.module: [lux #* [abstract - [equivalence (#+ Equivalence)]] - [data - [format - [binary (#+ Format)]]]] + [equivalence (#+ Equivalence)]]] ["." //// #_ [encoding ["#." unsigned (#+ U2)]]]) @@ -12,9 +9,10 @@ (type: #export Label U2) (def: #export equivalence - (Equivalence Label) ////unsigned.equivalence) -(def: #export format - (Format Label) - ////unsigned.u2-format) +(def: #export parser + ////unsigned.u2-parser) + +(def: #export writer + ////unsigned.u2-writer) diff --git a/stdlib/source/lux/target/jvm/attribute/constant.lux b/stdlib/source/lux/target/jvm/attribute/constant.lux index 44e48acb1..ec3f534a3 100644 --- a/stdlib/source/lux/target/jvm/attribute/constant.lux +++ b/stdlib/source/lux/target/jvm/attribute/constant.lux @@ -2,9 +2,12 @@ [lux #* [abstract [equivalence (#+ Equivalence)]] + [control + ["<>" parser ("#@." functor) + ["<2>" binary (#+ Parser)]]] [data [format - [binary (#+ Format)]]]] + [binary (#+ Writer)]]]] ["." /// #_ [constant (#+ Value)] [encoding @@ -21,6 +24,10 @@ (def: #export length ///unsigned.u2-bytes) -(def: #export format - (Format Constant) - ///index.format) +(def: #export parser + (Parser Constant) + ///index.parser) + +(def: #export writer + (Writer Constant) + ///index.writer) diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux index 38315c3b4..516dec1fc 100644 --- a/stdlib/source/lux/target/jvm/class.lux +++ b/stdlib/source/lux/target/jvm/class.lux @@ -12,7 +12,7 @@ [number (#+) [i64 (#+)]] [format - [".F" binary (#+ Writer Format) ("#@." monoid)]] + [".F" binary (#+ Writer) ("#@." monoid)]] [collection ["." row (#+ Row)]]] [type @@ -70,8 +70,6 @@ (row.equivalence //method.equivalence) (row.equivalence //attribute.equivalence))) -(def: default-minor-version Minor (//version.version 0)) - (def: (install-classes this super interfaces) (-> Internal Internal (List Internal) (State Pool [(Index //constant.Class) (Index //constant.Class) (Row (Index //constant.Class))])) @@ -103,7 +101,7 @@ =fields (monad.seq state.monad fields)] (wrap [classes =fields])))] {#magic //magic.code - #minor-version ..default-minor-version + #minor-version //version.default-minor #major-version version #constant-pool pool #modifier modifier @@ -117,17 +115,17 @@ (def: #export parser (Parser 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 (<2>.row/16 (//field.reader constant-pool)) - methods (<2>.row/16 (//method.reader constant-pool)) - attributes (<2>.row/16 (//attribute.reader constant-pool))] + [magic //magic.parser + minor-version //version.parser + major-version //version.parser + constant-pool //constant/pool.parser + modifier //modifier.parser + this //index.parser + super //index.parser + interfaces (<2>.row/16 //index.parser) + fields (<2>.row/16 (//field.parser constant-pool)) + methods (<2>.row/16 (//method.parser constant-pool)) + attributes (<2>.row/16 (//attribute.parser constant-pool))] (wrap {#magic magic #minor-version minor-version #major-version major-version @@ -143,32 +141,22 @@ (def: #export (writer class) (Writer Class) (`` ($_ binaryF@compose - (~~ (template [<format> <slot>] - [((get@ #binaryF.writer <format>) (get@ <slot> class))] + (~~ (template [<writer> <slot>] + [(<writer> (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))] + [//magic.writer #magic] + [//version.writer #minor-version] + [//version.writer #major-version] + [//constant/pool.writer #constant-pool] + [//modifier.writer #modifier] + [//index.writer #this] + [//index.writer #super])) + (~~ (template [<writer> <slot>] + [((binaryF.row/16 <writer>) (get@ <slot> class))] - [Field //field.writer #fields] - [Method //method.writer #methods] - [Attribute //attribute.writer #attributes] + [//index.writer #interfaces] + [//field.writer #fields] + [//method.writer #methods] + [//attribute.writer #attributes] )) ))) - -(def: #export format - (Format Class) - {#binaryF.reader ..parser - #binaryF.writer ..writer}) diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux index af6b1b078..ee4dc5849 100644 --- a/stdlib/source/lux/target/jvm/constant.lux +++ b/stdlib/source/lux/target/jvm/constant.lux @@ -4,14 +4,15 @@ [monad (#+ do)] ["." equivalence (#+ Equivalence)]] [control - ["." parser]] + ["<>" parser ("#@." functor) + ["<2>" binary (#+ Parser)]]] [data [number ["." int] ["." frac]] ["." text] [format - ["." binary (#+ Format) ("#;." monoid)]] + [".F" binary (#+ Writer) ("#@." monoid)]] [collection ["." row (#+ Row)]]] [type @@ -26,9 +27,13 @@ (type: #export UTF8 Text) -(def: utf8-format - (Format UTF8) - binary.utf8/16) +(def: utf8-parser + (Parser UTF8) + <2>.utf8/16) + +(def: utf8-writer + (Writer UTF8) + binaryF.utf8/16) (abstract: #export Class {} @@ -45,11 +50,13 @@ (|>> :representation) //index.equivalence)) - (def: class-format - (Format Class) - (binary.adapt (|>> :abstraction) - (|>> :representation) - //index.format)) + (def: class-parser + (Parser Class) + (<>@map (|>> :abstraction) //index.parser)) + + (def: class-writer + (Writer Class) + (|>> :representation //index.writer)) ) (abstract: #export (Value kind) @@ -84,16 +91,17 @@ [string String (Index UTF8)] ) - (template [<name> <type> <read> <write> <base>] - [(def: <name> - (Format <type>) - (binary.adapt (|>> <read> :abstraction) - (|>> :representation <write>) - <base>))] - - [long-format Long .int (<|) binary.bits/64] - [double-format Double frac.bits-to-frac frac.frac-to-bits binary.bits/64] - [string-format String (<|) (<|) //index.format] + (template [<parser-name> <writer-name> <type> <read> <write> <parser> <writer>] + [(def: <parser-name> + (Parser <type>) + (<>@map (|>> <read> :abstraction) <parser>)) + (def: <writer-name> + (Writer <type>) + (|>> :representation <write> <writer>))] + + [long-parser long-writer Long .int (<|) <2>.bits/64 binaryF.bits/64] + [double-parser double-writer Double frac.bits-to-frac frac.frac-to-bits <2>.bits/64 binaryF.bits/64] + [string-parser string-writer String (<|) (<|) //index.parser //index.writer] ) ) @@ -105,21 +113,27 @@ {#class (Index Class) #name-and-type (Index Name-And-Type)}) -(template [<type> <equivalence> <format>] +(template [<type> <equivalence> <parser> <writer>] [(def: #export <equivalence> (Equivalence <type>) ($_ equivalence.product //index.equivalence //index.equivalence)) - (def: #export <format> - (Format <type>) - ($_ binary.and - //index.format - //index.format))] + (def: #export <parser> + (Parser <type>) + ($_ <>.and + //index.parser + //index.parser)) - [Name-And-Type name-and-type-equivalence name-and-type-format] - [Reference reference-equivalence reference-format] + (def: #export <writer> + (Writer <type>) + ($_ binaryF.and + //index.writer + //index.writer))] + + [Name-And-Type name-and-type-equivalence name-and-type-parser name-and-type-writer] + [Reference reference-equivalence reference-parser reference-writer] ) (type: #export Constant @@ -177,38 +191,56 @@ ## ) ) -(def: #export format - (Format Constant) - (with-expansions [<constants> (as-is [#UTF8 /tag.utf8 ..utf8-format] +(def: #export parser + (Parser Constant) + (with-expansions [<constants> (as-is [#UTF8 /tag.utf8 ..utf8-parser] + ## TODO: Integer + ## TODO: Float + [#Long /tag.long ..long-parser] + [#Double /tag.double ..double-parser] + [#Class /tag.class ..class-parser] + [#String /tag.string ..string-parser] + [#Field /tag.field ..reference-parser] + [#Method /tag.method ..reference-parser] + [#Interface-Method /tag.interface-method ..reference-parser] + [#Name-And-Type /tag.name-and-type ..name-and-type-parser] + ## TODO: Method-Handle + ## TODO: Method-Type + ## TODO: Invoke-Dynamic + )] + (do <>.monad + [tag /tag.parser] + (`` (cond (~~ (template [<case> <tag> <parser>] + [(/tag;= <tag> tag) + (:: @ map (|>> <case>) <parser>)] + + <constants>)) + + ## else + (<>.fail "Cannot parse constant.")))))) + +(def: #export writer + (Writer Constant) + (with-expansions [<constants> (as-is [#UTF8 /tag.utf8 ..utf8-writer] ## TODO: Integer ## TODO: Float - [#Long /tag.long ..long-format] - [#Double /tag.double ..double-format] - [#Class /tag.class ..class-format] - [#String /tag.string ..string-format] - [#Field /tag.field ..reference-format] - [#Method /tag.method ..reference-format] - [#Interface-Method /tag.interface-method ..reference-format] - [#Name-And-Type /tag.name-and-type ..name-and-type-format] + [#Long /tag.long ..long-writer] + [#Double /tag.double ..double-writer] + [#Class /tag.class ..class-writer] + [#String /tag.string ..string-writer] + [#Field /tag.field ..reference-writer] + [#Method /tag.method ..reference-writer] + [#Interface-Method /tag.interface-method ..reference-writer] + [#Name-And-Type /tag.name-and-type ..name-and-type-writer] ## TODO: Method-Handle ## TODO: Method-Type ## TODO: Invoke-Dynamic )] - {#binary.reader (do parser.monad - [tag (get@ #binary.reader /tag.format)] - (`` (cond (~~ (template [<case> <tag> <format>] - [(/tag;= <tag> tag) - (:: @ map (|>> <case>) (get@ #binary.reader <format>))] - - <constants>)) - - ## else - (parser.fail "Cannot parse constant.")))) - #binary.writer (function (_ value) - (case value - (^template [<case> <tag> <format>] - (<case> value) - (binary;compose ((get@ #binary.writer /tag.format) <tag>) - ((get@ #binary.writer <format>) value))) - (<constants>) - ))})) + (function (_ value) + (case value + (^template [<case> <tag> <writer>] + (<case> value) + (binaryF@compose (/tag.writer <tag>) + (<writer> value))) + (<constants>) + )))) diff --git a/stdlib/source/lux/target/jvm/constant/pool.lux b/stdlib/source/lux/target/jvm/constant/pool.lux index 5fd123319..149a893bb 100644 --- a/stdlib/source/lux/target/jvm/constant/pool.lux +++ b/stdlib/source/lux/target/jvm/constant/pool.lux @@ -5,13 +5,15 @@ [monad (#+ do)]] [control ["." state (#+ State)] - ["." exception (#+ exception:)]] + ["." exception (#+ exception:)] + ["<>" parser ("#@." functor) + ["<2>" binary (#+ Parser)]]] [data ["." error (#+ Error)] ["." text ("#;." equivalence) ["%" format]] [format - ["." binary (#+ Format)]] + [".F" binary (#+ Writer)]] [collection ["." list ("#;." fold)] ["." row (#+ Row)]]] @@ -147,9 +149,13 @@ (let [value (descriptor.descriptor value)] (!add #//.UTF8 text;= value))) -(def: #export format - (Format Pool) - (binary.row/16' ..offset //.format)) +(def: #export parser + (Parser Pool) + (<2>.row/16' ..offset //.parser)) + +(def: #export writer + (Writer Pool) + (binaryF.row/16' ..offset //.writer)) (def: #export empty Pool diff --git a/stdlib/source/lux/target/jvm/constant/tag.lux b/stdlib/source/lux/target/jvm/constant/tag.lux index b402037c4..ffbe59390 100644 --- a/stdlib/source/lux/target/jvm/constant/tag.lux +++ b/stdlib/source/lux/target/jvm/constant/tag.lux @@ -2,9 +2,12 @@ [lux #* [abstract [equivalence (#+ Equivalence)]] + [control + ["<>" parser ("#@." functor) + ["<2>" binary (#+ Parser)]]] [data [format - ["." binary (#+ Format)]]] + [binary (#+ Writer)]]] [type abstract]] [/// @@ -43,9 +46,11 @@ [18 invoke-dynamic] ) - (def: #export format - (Format Tag) - (binary.adapt (|>> :abstraction) - (|>> :representation) - unsigned.u1-format)) + (def: #export parser + (Parser Tag) + (<>@map (|>> :abstraction) unsigned.u1-parser)) + + (def: #export writer + (Writer Tag) + (|>> :representation unsigned.u1-writer)) ) diff --git a/stdlib/source/lux/target/jvm/encoding/unsigned.lux b/stdlib/source/lux/target/jvm/encoding/unsigned.lux index f5db7a81a..15dd7a07e 100644 --- a/stdlib/source/lux/target/jvm/encoding/unsigned.lux +++ b/stdlib/source/lux/target/jvm/encoding/unsigned.lux @@ -3,12 +3,13 @@ [abstract [equivalence (#+ Equivalence)]] [control - ["." parser ("#;." functor)]] + ["<>" parser ("#@." functor) + ["<2>" binary (#+ Parser)]]] [data [number ["." i64]] [format - ["." binary (#+ Format)]]] + [".F" binary (#+ Writer)]]] [macro ["." template]] [type @@ -48,12 +49,16 @@ ) ) -(template [<name> <type> <format> <post-read>] - [(def: #export <name> - (Format <type>) - (binary.adapt <post-read> ..nat <format>))] +(template [<parser-name> <writer-name> <type> <parser> <writer> <post-read>] + [(def: #export <parser-name> + (Parser <type>) + (<>@map <post-read> <parser>)) - [u1-format U1 binary.bits/8 ..u1] - [u2-format U2 binary.bits/16 ..u2] - [u4-format U4 binary.bits/32 ..u4] + (def: #export <writer-name> + (Writer <type>) + (|>> ..nat <writer>))] + + [u1-parser u1-writer U1 <2>.bits/8 binaryF.bits/8 ..u1] + [u2-parser u2-writer U2 <2>.bits/16 binaryF.bits/16 ..u2] + [u4-parser u4-writer U4 <2>.bits/32 binaryF.bits/32 ..u4] ) diff --git a/stdlib/source/lux/target/jvm/field.lux b/stdlib/source/lux/target/jvm/field.lux index 1535ff639..f050a13a5 100644 --- a/stdlib/source/lux/target/jvm/field.lux +++ b/stdlib/source/lux/target/jvm/field.lux @@ -12,7 +12,7 @@ [number (#+) [i64 (#+)]] [format - [".F" binary (#+ Writer Format) ("#@." monoid)]] + [".F" binary (#+ Writer) ("#@." monoid)]] [collection ["." row (#+ Row)]]] [type @@ -51,29 +51,25 @@ //index.equivalence (row.equivalence //attribute.equivalence))) -(def: #export (reader pool) +(def: #export (parser pool) (-> Pool (Parser Field)) ($_ <>.and - (get@ #binaryF.reader modifier.format) - (get@ #binaryF.reader //index.format) - (get@ #binaryF.reader //index.format) - (<2>.row/16 (//attribute.reader pool)))) + modifier.parser + //index.parser + //index.parser + (<2>.row/16 (//attribute.parser pool)))) (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))] + (`` ($_ binaryF@compose + (~~ (template [<writer> <slot>] + [(<writer> (get@ <slot> field))] - [modifier.format #modifier] - [//index.format #name] - [//index.format #descriptor] - [(binaryF.row/16 attribute-format) #attributes])) - )))) + [modifier.writer #modifier] + [//index.writer #name] + [//index.writer #descriptor] + [(binaryF.row/16 //attribute.writer) #attributes])) + ))) (def: #export (field modifier name descriptor attributes) (-> (Modifier Field) 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 6d7e280f6..32ad5d428 100644 --- a/stdlib/source/lux/target/jvm/index.lux +++ b/stdlib/source/lux/target/jvm/index.lux @@ -2,9 +2,12 @@ [lux #* [abstract ["." equivalence (#+ Equivalence)]] + [control + ["<>" parser ("#@." functor) + ["<2>" binary (#+ Parser)]]] [data [format - ["." binary (#+ Format)]]] + [binary (#+ Writer)]]] [type abstract]] ["." // #_ @@ -30,9 +33,11 @@ ..number //unsigned.equivalence)) - (def: #export format - (All [kind] (Format (Index kind))) - (binary.adapt ..index - ..number - //unsigned.u2-format)) + (def: #export parser + (All [kind] (Parser (Index kind))) + (<>@map ..index //unsigned.u2-parser)) + + (def: #export writer + (All [kind] (Writer (Index kind))) + (|>> ..number //unsigned.u2-writer)) ) diff --git a/stdlib/source/lux/target/jvm/magic.lux b/stdlib/source/lux/target/jvm/magic.lux index 73fea4698..0fc0bad14 100644 --- a/stdlib/source/lux/target/jvm/magic.lux +++ b/stdlib/source/lux/target/jvm/magic.lux @@ -1,9 +1,7 @@ (.module: [lux #* [data - [number (#+ hex)] - [format - [binary (#+ Format)]]]] + [number (#+ hex)]]] ["." // #_ [encoding ["#." unsigned (#+ U4)]]]) @@ -15,6 +13,8 @@ Magic (//unsigned.u4 (hex "CAFEBABE"))) -(def: #export format - (Format Magic) - //unsigned.u4-format) +(def: #export parser + //unsigned.u4-parser) + +(def: #export writer + //unsigned.u4-writer) diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux index aab21db0d..c59bf7d58 100644 --- a/stdlib/source/lux/target/jvm/method.lux +++ b/stdlib/source/lux/target/jvm/method.lux @@ -12,7 +12,7 @@ [number (#+) [i64 (#+)]] [format - [".F" binary (#+ Writer Format) ("#@." monoid)]] + [".F" binary (#+ Writer) ("#@." monoid)]] [collection ["." row (#+ Row)]]] [type @@ -54,26 +54,22 @@ //index.equivalence (row.equivalence //attribute.equivalence))) -(def: #export (reader pool) +(def: #export (parser pool) (-> Pool (Parser Method)) ($_ <>.and - (get@ #binaryF.reader modifier.format) - (get@ #binaryF.reader //index.format) - (get@ #binaryF.reader //index.format) - (<2>.row/16 (//attribute.reader pool)))) + modifier.parser + //index.parser + //index.parser + (<2>.row/16 (//attribute.parser pool)))) (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))] + (`` ($_ binaryF@compose + (~~ (template [<writer> <slot>] + [(<writer> (get@ <slot> field))] - [modifier.format #modifier] - [//index.format #name] - [//index.format #descriptor] - [(binaryF.row/16 attribute-format) #attributes])) - )))) + [modifier.writer #modifier] + [//index.writer #name] + [//index.writer #descriptor] + [(binaryF.row/16 //attribute.writer) #attributes])) + ))) diff --git a/stdlib/source/lux/target/jvm/modifier.lux b/stdlib/source/lux/target/jvm/modifier.lux index 0e354d730..a84ba38bc 100644 --- a/stdlib/source/lux/target/jvm/modifier.lux +++ b/stdlib/source/lux/target/jvm/modifier.lux @@ -5,12 +5,13 @@ ["." monoid (#+ Monoid)]] [control ["<>" parser - ["<c>" code (#+ Parser)]]] + ["<c>" code] + ["<2>" binary (#+ Parser)]]] [data ["." number (#+ hex) ["." i64]] [format - [".F" binary (#+ Format)]] + [".F" binary (#+ Writer)]] [collection ["." list ("#@." functor)]]] [type @@ -64,11 +65,13 @@ Modifier (:: ..monoid identity)) - (def: #export format - (All [of] (Format (Modifier of))) - (let [(^open "_@.") //unsigned.u2-format] - {#binaryF.reader (:: <>.functor map (|>> :abstraction) _@reader) - #binaryF.writer (|>> :representation _@writer)})) + (def: #export parser + (All [of] (Parser (Modifier of))) + (:: <>.functor map (|>> :abstraction) //unsigned.u2-parser)) + + (def: #export writer + (All [of] (Writer (Modifier of))) + (|>> :representation //unsigned.u2-writer)) ) (syntax: #export (modifiers: ofT {options (<>.many <c>.any)}) diff --git a/stdlib/source/lux/target/jvm/version.lux b/stdlib/source/lux/target/jvm/version.lux index f280743ba..7c80928a8 100644 --- a/stdlib/source/lux/target/jvm/version.lux +++ b/stdlib/source/lux/target/jvm/version.lux @@ -1,8 +1,5 @@ (.module: - [lux #* - [data - [format - ["." binary (#+ Format)]]]] + [lux #*] ["." // #_ [encoding ["#." unsigned (#+ U2)]]]) @@ -11,14 +8,12 @@ (type: #export Minor Version) (type: #export Major Version) -(def: #export version - (-> Nat Version) - //unsigned.u2) +(def: #export default-minor Minor (//unsigned.u2 0)) (template [<number> <name>] [(def: #export <name> Major - (..version <number>))] + (//unsigned.u2 <number>))] [45 v1_1] [46 v1_2] @@ -34,6 +29,8 @@ [56 v12] ) -(def: #export format - (Format Version) - //unsigned.u2-format) +(def: #export parser + //unsigned.u2-parser) + +(def: #export writer + //unsigned.u2-writer) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 2ef15809b..873d32e09 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -97,7 +97,7 @@ (/field.field /field.public field1 descriptor1 (row.row))) (row.row) (row.row)) - bytecode (binaryF.write /class.format input) + bytecode (binaryF.run /class.writer input) loader (/loader.memory (/loader.new-library []))]] ($_ _.and (_.test "Can read a generated class." |