diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/control/parser/binary.lux | 252 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/binary.lux | 177 | ||||
| -rw-r--r-- | stdlib/source/lux/target/jvm/attribute.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/lux/target/jvm/attribute/code.lux | 22 | ||||
| -rw-r--r-- | stdlib/source/lux/target/jvm/class.lux | 26 | ||||
| -rw-r--r-- | stdlib/source/lux/target/jvm/field.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/lux/target/jvm/method.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/test/lux/target/jvm.lux | 4 |
8 files changed, 335 insertions, 177 deletions
diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux new file mode 100644 index 000000000..442bf68b2 --- /dev/null +++ b/stdlib/source/lux/control/parser/binary.lux @@ -0,0 +1,252 @@ +(.module: + [lux (#- and or nat int rev list type) + [type (#+ :share)] + [abstract + [monad (#+ do)]] + [control + ["." exception (#+ exception:)]] + [data + ["." error (#+ Error)] + ["." binary (#+ Binary)] + [number + ["." frac]] + [text + ["." encoding] + ["%" format]] + [collection + ["." row (#+ Row)]]]] + ["." // ("#@." monad)]) + +(type: #export Offset Nat) + +(type: #export Parser + (//.Parser [Offset Binary])) + +(exception: #export (binary-was-not-fully-read {length Nat} {read Nat}) + (exception.report + ["Binary length" (%.nat length)] + ["Read bytes" (%.nat read)])) + +(def: #export (run parser input) + (All [a] (-> (Parser a) Binary (Error a))) + (case (parser [0 input]) + (#error.Failure msg) + (#error.Failure msg) + + (#error.Success [[end _] output]) + (let [length (binary.size input)] + (if (n/= end length) + (#error.Success output) + (exception.throw ..binary-was-not-fully-read [length end]))))) + +(type: #export Size Nat) + +(def: #export size/8 Size 1) +(def: #export size/16 Size 2) +(def: #export size/32 Size 4) +(def: #export size/64 Size 8) + +(template [<name> <size> <read>] + [(def: #export <name> + (Parser (I64 Any)) + (function (_ [offset binary]) + (case (<read> offset binary) + (#error.Success data) + (#error.Success [(n/+ <size> offset) binary] data) + + (#error.Failure error) + (#error.Failure error))))] + + [bits/8 ..size/8 binary.read/8] + [bits/16 ..size/16 binary.read/16] + [bits/32 ..size/32 binary.read/32] + [bits/64 ..size/64 binary.read/64] + ) + +(exception: #export (invalid-tag {range Nat} {byte Nat}) + (exception.report + ["Range" (%.nat range)] + ["Byte" (%.nat byte)])) + +(def: #export (or left right) + (All [l r] (-> (Parser l) (Parser r) (Parser (| l r)))) + (do //.monad + [flag bits/8] + (case flag + 0 (:: @ map (|>> #.Left) left) + 1 (:: @ map (|>> #.Right) right) + _ (//.lift (exception.throw ..invalid-tag [2 (.nat flag)]))))) + +(def: #export (rec body) + (All [a] (-> (-> (Parser a) (Parser a)) (Parser a))) + (function (_ input) + (let [parser (body (rec body))] + (parser input)))) + +(def: #export bit + (Parser Bit) + (function (_ [offset binary]) + (case (binary.read/8 offset binary) + (#error.Success data) + (case (: Nat data) + (^template [<nat> <bit>] + <nat> (#error.Success [(inc offset) binary] <bit>)) + ([0 #0] + [1 #1]) + + _ + (exception.throw ..invalid-tag [2 data])) + + (#error.Failure error) + (#error.Failure error)))) + +(def: #export nat (Parser Nat) (//@map .nat ..bits/64)) +(def: #export int (Parser Int) (//@map .int ..bits/64)) +(def: #export rev (Parser Rev) (//@map .rev ..bits/64)) + +(def: #export frac + (Parser Frac) + (//@map frac.bits-to-frac ..bits/64)) + +(template [<name> <bits> <size>] + [(def: #export <name> + (Parser Binary) + (do //.monad + [size (//@map .nat <bits>)] + (function (_ [offset binary]) + (do error.monad + [#let [end (n/+ size offset)] + output (binary.slice offset (.dec end) binary)] + (wrap [[end binary] output])))))] + + [binary/8 ..bits/8 ..size/8] + [binary/16 ..bits/16 ..size/16] + [binary/32 ..bits/32 ..size/32] + [binary/64 ..bits/64 ..size/64] + ) + +(template [<name> <binary>] + [(def: #export <name> + (Parser Text) + (do //.monad + [utf8 <binary>] + (//.lift (encoding.from-utf8 utf8))))] + + [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>] + [(def: #export (<with-offset> extra-count valueP) + (All [v] (-> Nat (Parser v) (Parser (Row v)))) + (do //.monad + [count (|> <bits> + (//@map .nat) + (:: @ map (n/- extra-count)))] + (loop [index 0 + output (:share [v] + {(Parser v) + valueP} + {(Row v) + row.empty})] + (if (n/< count index) + (do //.monad + [value valueP] + (recur (.inc index) + (row.add value output))) + (//@wrap output))))) + + (def: #export <name> + (All [v] (-> (Parser v) (Parser (Row v)))) + (<with-offset> 0))] + + [row/8 row/8' ..bits/8 ..size/8] + [row/16 row/16' ..bits/16 ..size/16] + [row/32 row/32' ..bits/32 ..size/32] + [row/64 row/64' ..bits/64 ..size/64] + ) + +(def: #export maybe + (All [a] (-> (Parser a) (Parser (Maybe a)))) + (..or (//@wrap []))) + +(def: #export (list value) + (All [a] (-> (Parser a) (Parser (List a)))) + (..rec + (function (_ recur) + (..or (//@wrap []) + (//.and value recur))))) + +(def: #export name + (Parser Name) + (//.and ..text ..text)) + +(def: #export type + (Parser Type) + (..rec + (function (_ type) + (let [pair (//.and type type) + indexed ..nat + quantified (//.and (..list type) type)] + ($_ ..or + ## #Primitive + (//.and ..text (..list type)) + ## #Sum + pair + ## #Product + pair + ## #Function + pair + ## #Parameter + indexed + ## #Var + indexed + ## #Ex + indexed + ## #UnivQ + quantified + ## #ExQ + quantified + ## #Apply + pair + ## #Named + (//.and ..name type) + ))))) + +(def: #export cursor + (Parser Cursor) + ($_ //.and ..text ..nat ..nat)) + +(def: #export code + (Parser Code) + (..rec + (function (_ code) + (let [sequence (..list code) + code' ($_ ..or + ## #Bit + ..bit + ## #Nat + ..nat + ## #Int + ..int + ## #Rev + ..rev + ## #Frac + ..frac + ## #Text + ..text + ## #Identifier + ..name + ## #Tag + ..name + ## #Form + sequence + ## #Tuple + sequence + ## #Record + (..list (//.and code code)))] + (//.and ..cursor code'))))) diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index f7aaff36b..550d4a177 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -7,7 +7,8 @@ [monad (#+ Monad do)] [equivalence (#+ Equivalence)]] [control - ["." parser (#+ Parser) ("#;." functor)] + ["<>" parser ("#@." monad) + ["/" binary (#+ Offset Size Parser)]] ["." function] ["ex" exception (#+ exception:)]] [data @@ -22,32 +23,12 @@ ["%" format]] [collection ["." list] - ["." row (#+ Row) ("#;." functor)]]]]) - -(exception: #export (binary-was-not-fully-read {length Nat} {read Nat}) - (ex.report ["Binary length" (%.nat length)] - ["Read bytes" (%.nat read)])) - -(exception: #export (invalid-tag {range Nat} {byte Nat}) - (ex.report ["Range" (%.nat range)] - ["Byte" (%.nat byte)])) - -(type: #export Offset Nat) - -(type: #export Size Nat) - -(def: #export size/8 Size 1) -(def: #export size/16 Size 2) -(def: #export size/32 Size 4) -(def: #export size/64 Size 8) + ["." row (#+ Row) ("#@." functor)]]]]) (def: mask (-> Size (I64 Any)) (|>> (n/* i64.bits-per-byte) i64.mask)) -(type: #export Reader - (Parser [Offset Binary])) - (type: #export Mutation [Size (-> [Offset Binary] [Offset Binary])]) @@ -68,7 +49,7 @@ (-> a Mutation)) (type: #export (Format a) - {#reader (Reader a) + {#reader (Parser a) #writer (Writer a)}) (def: #export (adapt post-read pre-write format) @@ -77,37 +58,19 @@ (-> a' a) (Format a) (Format a'))) - (let [(^open "_;.") format] - {#reader (|> _;reader (parser;map post-read)) - #writer (|>> pre-write _;writer)})) - -(def: #export (read format input) - (All [a] (-> (Format a) Binary (Error a))) - (case ((get@ #reader format) [0 input]) - (#error.Failure msg) - (#error.Failure msg) - - (#error.Success [[end _] output]) - (let [length (binary.size input)] - (if (n/= end length) - (#error.Success output) - (ex.throw binary-was-not-fully-read [length end]))))) + (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)] (|> valueS binary.create [0] valueT product.right))) -(template [<name> <size> <read> <write>] +(template [<name> <size> <parser> <write>] [(def: #export <name> (Format (I64 Any)) - {#reader (function (_ [offset binary]) - (case (<read> offset binary) - (#error.Success data) - (#error.Success [(n/+ <size> offset) binary] data) - - (#error.Failure error) - (#error.Failure error))) + {#reader <parser> #writer (function (_ value) [<size> (function (_ [offset binary]) @@ -116,20 +79,16 @@ (<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] - [bits/32 size/32 binary.read/32 binary.write/32] - [bits/64 size/64 binary.read/64 binary.write/64] + [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] ) (def: #export (or leftB rightB) (All [l r] (-> (Format l) (Format r) (Format (| l r)))) - {#reader (do parser.monad - [flag (get@ #reader bits/8)] - (case flag - 0 (:: @ map (|>> #.Left) (get@ #reader leftB)) - 1 (:: @ map (|>> #.Right) (get@ #reader rightB)) - _ (parser.lift (ex.throw invalid-tag [2 (.nat flag)])))) + {#reader (/.or (get@ #reader leftB) + (get@ #reader rightB)) #writer (function (_ altV) (case altV (#.Left leftV) @@ -155,7 +114,7 @@ (def: #export (and preB postB) (All [a b] (-> (Format a) (Format b) (Format [a b]))) - {#reader (parser.and (get@ #reader preB) (get@ #reader postB)) + {#reader (<>.and (get@ #reader preB) (get@ #reader postB)) #writer (function (_ [preV postV]) (:: ..monoid compose ((get@ #writer preB) preV) @@ -172,8 +131,7 @@ (def: #export (ignore default) (All [a] (-> a (Format a))) - {#reader (function (_ input) - (#error.Success [input default])) + {#reader (<>@wrap default) #writer (function (_ value) ..no-op)}) @@ -183,20 +141,7 @@ (def: #export bit (Format Bit) - {#reader (function (_ [offset binary]) - (case (binary.read/8 offset binary) - (#error.Success data) - (case (: Nat data) - (^template [<nat> <bit>] - <nat> (#error.Success [(inc offset) binary] <bit>)) - ([0 #0] - [1 #1]) - - _ - (ex.throw invalid-tag [2 data])) - - (#error.Failure error) - (#error.Failure error))) + {#reader /.bit #writer (function (_ value) [1 (function (_ [offset binary]) @@ -211,24 +156,16 @@ (def: #export frac (Format Frac) - (let [(^slots [#reader #writer]) ..bits/64] - {#reader (:: parser.monad map frac.bits-to-frac reader) + (let [(^slots [#writer]) ..bits/64] + {#reader /.frac #writer (|>> frac.frac-to-bits writer)})) -(template [<name> <bits> <size> <write>] +(template [<name> <bits> <size> <parser> <write>] [(def: #export <name> (Format Binary) - (let [mask (..mask <size>)] - {#reader (do parser.monad - [size (:coerce (Reader Nat) - ## TODO: Remove coercion. - (get@ #reader <bits>))] - (function (_ [offset binary]) - (do error.monad - [#let [end (n/+ size offset)] - output (binary.slice offset (.dec end) binary)] - (wrap [[end binary] output])))) - #writer (function (_ value) + {#reader <parser> + #writer (let [mask (..mask <size>)] + (function (_ value) (let [size (|> value binary.size (i64.and mask)) size' (n/+ <size> size)] [size' @@ -237,51 +174,33 @@ (error.assume (do error.monad [_ (<write> offset size binary)] - (binary.copy size 0 value (n/+ <size> offset) 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] + [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] ) -(template [<name> <binary>] +(template [<name> <parser> <binary>] [(def: #export <name> (Format Text) - (let [(^open "binary/.") <binary>] - {#reader (do parser.monad - [utf8 binary/reader] - (parser.lift (encoding.from-utf8 utf8))) - #writer (|>> encoding.to-utf8 binary/writer)}))] - - [utf8/8 ..binary/8] - [utf8/16 ..binary/16] - [utf8/32 ..binary/32] - [utf8/64 ..binary/64] + {#reader <parser> + #writer (let [(^open "binary@.") <binary>] + (|>> encoding.to-utf8 binary@writer))})] + + [utf8/8 /.utf8/8 ..binary/8] + [utf8/16 /.utf8/16 ..binary/16] + [utf8/32 /.utf8/32 ..binary/32] + [utf8/64 /.utf8/64 ..binary/64] ) (def: #export text ..utf8/64) -(template [<name> <with-offset> <bits> <size> <write>] +(template [<name> <with-offset> <bits> <size> <parser> <write>] [(def: #export (<with-offset> extra-count valueF) (All [v] (-> Nat (Format v) (Format (Row v)))) - {#reader (do parser.monad - [count (|> (get@ #reader <bits>) - ## TODO: Remove coercion. - (:coerce (Reader Nat)) - (:: @ map (n/- extra-count)))] - (loop [index 0 - output (:share [v] - {(Format v) - valueF} - {(Row v) - row.empty})] - (if (n/< count index) - (do parser.monad - [value (get@ #reader valueF)] - (recur (.inc index) - (row.add value output))) - (:: parser.monad wrap output)))) + {#reader (<parser> extra-count (get@ #reader valueF)) #writer (function (_ value) (let [original-count (row.size value) capped-count (i64.and (..mask <size>) @@ -289,13 +208,13 @@ value (if (n/= original-count capped-count) value (|> value row.to-list (list.take capped-count) row.from-list)) - (^open "mutation;.") ..monoid + (^open "mutation@.") ..monoid [size mutation] (|> value - (row;map (get@ #writer valueF)) + (row@map (get@ #writer valueF)) (:: row.fold fold (function (_ post pre) - (mutation;compose pre post)) - mutation;identity))] + (mutation@compose pre post)) + mutation@identity))] [(n/+ <size> size) (function (_ [offset binary]) (error.assume @@ -307,10 +226,10 @@ (All [v] (-> (Format v) (Format (Row v)))) (<with-offset> 0))] - [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] + [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] ) (def: #export maybe diff --git a/stdlib/source/lux/target/jvm/attribute.lux b/stdlib/source/lux/target/jvm/attribute.lux index 421dbab17..06400ef93 100644 --- a/stdlib/source/lux/target/jvm/attribute.lux +++ b/stdlib/source/lux/target/jvm/attribute.lux @@ -6,12 +6,13 @@ [control ["." state (#+ State)] ["." exception (#+ exception:)] - ["<>" parser]] + ["<>" parser + ["<2>" binary (#+ Parser)]]] [data ["." product] ["." error] [format - [".F" binary (#+ Reader Writer Format) ("#@." monoid)]]]] + [".F" binary (#+ Writer Format) ("#@." monoid)]]]] ["." // #_ ["#." index (#+ Index)] [encoding @@ -113,7 +114,7 @@ (exception: #export invalid-attribute) (def: #export (reader pool) - (-> Pool (Reader Attribute)) + (-> Pool (Parser Attribute)) (let [?@constant (|> ..constant-name //constant/pool.find-utf8 (state.run pool) diff --git a/stdlib/source/lux/target/jvm/attribute/code.lux b/stdlib/source/lux/target/jvm/attribute/code.lux index a52d32538..de7ce719a 100644 --- a/stdlib/source/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/lux/target/jvm/attribute/code.lux @@ -4,11 +4,12 @@ [abstract ["." equivalence (#+ Equivalence)]] [control - ["<>" parser]] + ["<>" parser + ["<2>" binary (#+ Parser)]]] [data ["." binary (#+ Binary)] [format - [".F" binary (#+ Reader Writer) ("#@." monoid)]] + [".F" binary (#+ Writer) ("#@." monoid)]] [collection ["." row (#+ Row) ("#@." functor fold)]]]] ["." /// #_ @@ -63,7 +64,7 @@ ## 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)))) + (All [Attribute] (-> (Parser Attribute) (Parser (Code Attribute)))) (let [u2-reader (get@ #binaryF.reader ///unsigned.u2-format)] ($_ <>.and @@ -73,19 +74,14 @@ u2-reader ## u4 code_length; ## u1 code[code_length]; - (get@ #binaryF.reader - binaryF.binary/32) + <2>.binary/32 ## u2 exception_table_length; ## exception_table[exception_table_length]; - (get@ #binaryF.reader - (binaryF.row/16 /exception.format)) + (<2>.row/16 (get@ #binaryF.reader + /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)})) + (<2>.row/16 reader) ))) (def: #export (writer writer code) @@ -111,7 +107,7 @@ #binaryF.reader (:share [Attribute] {(Writer Attribute) writer} - {(Reader Attribute) + {(Parser Attribute) (<>.fail "")}) #binaryF.writer writer})) (get@ #attributes code)) diff --git a/stdlib/source/lux/target/jvm/class.lux b/stdlib/source/lux/target/jvm/class.lux index cd269f038..38315c3b4 100644 --- a/stdlib/source/lux/target/jvm/class.lux +++ b/stdlib/source/lux/target/jvm/class.lux @@ -5,13 +5,14 @@ ["." equivalence (#+ Equivalence)] ["." monad (#+ do)]] [control - ["<>" parser] + ["<>" parser + ["<2>" binary (#+ Parser)]] ["." state (#+ State)]] [data [number (#+) [i64 (#+)]] [format - [".F" binary (#+ Reader Writer Format) ("#@." monoid)]] + [".F" binary (#+ Writer Format) ("#@." monoid)]] [collection ["." row (#+ Row)]]] [type @@ -113,8 +114,8 @@ #methods methods #attributes attributes})) -(def: #export reader - (Reader Class) +(def: #export parser + (Parser Class) (do <>.monad [magic (get@ #binaryF.reader //magic.format) minor-version (get@ #binaryF.reader //version.format) @@ -124,18 +125,9 @@ 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)})))] + fields (<2>.row/16 (//field.reader constant-pool)) + methods (<2>.row/16 (//method.reader constant-pool)) + attributes (<2>.row/16 (//attribute.reader constant-pool))] (wrap {#magic magic #minor-version minor-version #major-version major-version @@ -178,5 +170,5 @@ (def: #export format (Format Class) - {#binaryF.reader ..reader + {#binaryF.reader ..parser #binaryF.writer ..writer}) diff --git a/stdlib/source/lux/target/jvm/field.lux b/stdlib/source/lux/target/jvm/field.lux index 5cdc1b6b9..1535ff639 100644 --- a/stdlib/source/lux/target/jvm/field.lux +++ b/stdlib/source/lux/target/jvm/field.lux @@ -6,12 +6,13 @@ ["." monad (#+ do)]] [control ["." state (#+ State)] - ["<>" parser]] + ["<>" parser + ["<2>" binary (#+ Parser)]]] [data [number (#+) [i64 (#+)]] [format - [".F" binary (#+ Reader Writer Format) ("#@." monoid)]] + [".F" binary (#+ Writer Format) ("#@." monoid)]] [collection ["." row (#+ Row)]]] [type @@ -51,15 +52,12 @@ (row.equivalence //attribute.equivalence))) (def: #export (reader pool) - (-> Pool (Reader Field)) + (-> Pool (Parser 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)})))) + (<2>.row/16 (//attribute.reader pool)))) (def: #export (writer field) (Writer Field) diff --git a/stdlib/source/lux/target/jvm/method.lux b/stdlib/source/lux/target/jvm/method.lux index e4f0c1f32..aab21db0d 100644 --- a/stdlib/source/lux/target/jvm/method.lux +++ b/stdlib/source/lux/target/jvm/method.lux @@ -5,13 +5,14 @@ [monoid (#+)] ["." monad (#+ do)]] [control - ["<>" parser] + ["<>" parser + ["<2>" binary (#+ Parser)]] ["." state (#+ State)]] [data [number (#+) [i64 (#+)]] [format - [".F" binary (#+ Reader Writer Format) ("#@." monoid)]] + [".F" binary (#+ Writer Format) ("#@." monoid)]] [collection ["." row (#+ Row)]]] [type @@ -54,15 +55,12 @@ (row.equivalence //attribute.equivalence))) (def: #export (reader pool) - (-> Pool (Reader Method)) + (-> Pool (Parser 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)})))) + (<2>.row/16 (//attribute.reader pool)))) (def: #export (writer field) (Writer Method) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 8176756cc..2ef15809b 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -3,6 +3,8 @@ [abstract/monad (#+ do)] [control ["." io (#+ IO)] + [parser + ["<2>" binary]] [concurrency ["." atom]] [security @@ -99,7 +101,7 @@ loader (/loader.memory (/loader.new-library []))]] ($_ _.and (_.test "Can read a generated class." - (case (binaryF.read /class.format bytecode) + (case (<2>.run /class.parser bytecode) (#error.Success output) (:: /class.equivalence = input output) |