diff options
-rw-r--r-- | stdlib/source/lux/data/format/binary.lux | 62 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm.lux | 69 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/access.lux | 57 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/constant.lux | 43 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/constant/tag.lux | 49 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/encoding.lux | 49 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/index.lux | 17 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/magic.lux | 19 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/name.lux | 30 | ||||
-rw-r--r-- | stdlib/source/lux/host/jvm/version.lux | 38 |
10 files changed, 406 insertions, 27 deletions
diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux index f6145f59f..1be3e7a52 100644 --- a/stdlib/source/lux/data/format/binary.lux +++ b/stdlib/source/lux/data/format/binary.lux @@ -219,25 +219,24 @@ (do-template [<name> <bits> <size> <write>] [(def: #export <name> (Format Binary) - {#reader (do parser.Monad<Parser> - [size (:coerce (Reader Nat) - ## TODO: Remove coercion. - (get@ #reader <bits>))] - (function (_ [offset binary]) - (do error.Monad<Error> - [#let [end (n/+ size offset)] - output (binary.slice offset end binary)] - (wrap [[end binary] output])))) - #writer (function (_ value) - (let [size (|> value - binary.size - (i64.and (..mask <size>)))] - [(n/+ <size> size) - (function (_ offset binary) - (error.assume - (do error.Monad<Error> - [_ (<write> offset size binary)] - (binary.copy size 0 value (n/+ <size> offset) binary))))]))})] + (let [mask (..mask <size>)] + {#reader (do parser.Monad<Parser> + [size (:coerce (Reader Nat) + ## TODO: Remove coercion. + (get@ #reader <bits>))] + (function (_ [offset binary]) + (do error.Monad<Error> + [#let [end (n/+ size offset)] + output (binary.slice offset 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<Error> + [_ (<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] @@ -245,6 +244,23 @@ [binary/64 ..bits/64 ..size/64 binary.write/64] ) +(do-template [<name> <binary>] + [(def: #export <name> + (Format Text) + (let [(^open "binary/.") <binary>] + {#reader (do parser.Monad<Parser> + [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] + ) + +(def: #export text ..utf8/64) + (do-template [<name> <with-offset> <bits> <size> <write>] [(def: #export (<with-offset> extra-count valueF) (All [v] (-> Nat (Format v) (Format (Row v)))) @@ -296,14 +312,6 @@ [row/64 row/64' ..bits/64 ..size/64 binary.write/64] ) -(def: #export text - (Format Text) - (let [(^slots [#reader #writer]) ..binary/64] - {#reader (do parser.Monad<Parser> - [utf8 reader] - (parser.lift (encoding.from-utf8 utf8))) - #writer (|>> encoding.to-utf8 writer)})) - (def: #export maybe (All [a] (-> (Format a) (Format (Maybe a)))) (..or ..any)) diff --git a/stdlib/source/lux/host/jvm.lux b/stdlib/source/lux/host/jvm.lux new file mode 100644 index 000000000..bf9688d66 --- /dev/null +++ b/stdlib/source/lux/host/jvm.lux @@ -0,0 +1,69 @@ +(.module: + [lux (#- Name) + [data + [format + ["." binary (#+ Format)]] + [collection + ["." row (#+ Row)]]]] + [/ + ["/." version (#+ Version Minor Major)] + ["/." name (#+ Name)] + ["/." access (#+ Access)] + ["/." magic (#+ Magic)] + ["/." constant (#+ Constant)] + ["/." index (#+ Index)]]) + +(type: #export Field + Any) + +(type: #export Method + Any) + +(type: #export Attribute + Any) + +(type: #export Class + {#magic Magic + #minor-version Minor + #major-version Major + #constant-pool (Row Constant) + #access-flags Access + #this Index + #super Index + #interfaces (Row Index) + #fields (Row Field) + #methods (Row Method) + #attributes (Row Attribute)}) + +(def: #export (class version access super this) + (-> Major Access Name Name Class) + {#magic /magic.code + #minor-version (/version.version 0) + #major-version version + #constant-pool (|> row.empty + (row.add (#/constant.UTF8 (/name.read this))) + (row.add (#/constant.Class (/index.index 1))) + (row.add (#/constant.UTF8 (/name.read super))) + (row.add (#/constant.Class (/index.index 3)))) + #access-flags access + #this (/index.index 2) + #super (/index.index 4) + #interfaces row.empty + #fields row.empty + #methods row.empty + #attributes row.empty}) + +(def: #export classF + (Format Class) + ($_ binary.and + /magic.format + /version.format + /version.format + (binary.row/16' 1 /constant.format) + /access.format + /index.format + /index.format + (binary.row/16 (binary.ignore (/index.index 0))) + (binary.row/16 (binary.ignore [])) + (binary.row/16 (binary.ignore [])) + (binary.row/16 (binary.ignore [])))) diff --git a/stdlib/source/lux/host/jvm/access.lux b/stdlib/source/lux/host/jvm/access.lux new file mode 100644 index 000000000..f0d088a97 --- /dev/null +++ b/stdlib/source/lux/host/jvm/access.lux @@ -0,0 +1,57 @@ +(.module: + [lux #* + [control + [monoid (#+ Monoid)] + [parser ("parser/." Functor<Parser>)]] + [data + [number (#+ hex) + ["." i64]] + [format + ["." binary (#+ Format)]]] + [type + abstract]] + [// + ["//." encoding (#+ U2)]]) + +(abstract: #export Access + {} + + U2 + + (def: #export code + (-> Access U2) + (|>> :representation)) + + (def: #export (combine parameter subject) + (-> Access Access Access) + (let [parameter' (//encoding.from-u2 (:representation parameter)) + subject' (//encoding.from-u2 (:representation subject))] + (:abstraction (//encoding.to-u2 (i64.and parameter' + subject'))))) + + (do-template [<name> <code>] + [(def: #export <name> + Access + (|> (hex <code>) //encoding.to-u2 :abstraction))] + + [empty "0000"] + [public "0001"] + [final "0010"] + [super "0020"] + [interface "0200"] + [abstract "0400"] + [synthetic "1000"] + [annotation "2000"] + [enum "4000"] + ) + + (def: #export format + (Format Access) + (let [(^open "_/.") //encoding.u2-format] + {#binary.reader (|> _/reader (parser/map (|>> :abstraction))) + #binary.writer (|>> :representation _/writer)})) + ) + +(structure: #export _ (Monoid Access) + (def: identity ..empty) + (def: compose ..combine)) diff --git a/stdlib/source/lux/host/jvm/constant.lux b/stdlib/source/lux/host/jvm/constant.lux new file mode 100644 index 000000000..d20e34d31 --- /dev/null +++ b/stdlib/source/lux/host/jvm/constant.lux @@ -0,0 +1,43 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + ["." parser]] + [data + [format + ["." binary (#+ Format) ("mutation/." Monoid<Mutation>)]] + [collection + ["." row (#+ Row)]]] + [type + abstract]] + [// + ["//." index (#+ Index)]] + [/ + ["/." tag ("tag/." Equivalence<Tag>)]]) + +(type: #export Constant + (#UTF8 Text) + (#Class Index)) + +(def: #export format + (Format Constant) + (with-expansions [<constants> (as-is [#UTF8 /tag.utf8 binary.utf8/16] + [#Class /tag.class //index.format])] + {#binary.reader (do parser.Monad<Parser> + [tag (get@ #binary.reader /tag.format)] + (`` (cond (~~ (do-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) + (mutation/compose ((get@ #binary.writer /tag.format) <tag>) + ((get@ #binary.writer <format>) value))) + (<constants>) + ))})) diff --git a/stdlib/source/lux/host/jvm/constant/tag.lux b/stdlib/source/lux/host/jvm/constant/tag.lux new file mode 100644 index 000000000..57fd6d92e --- /dev/null +++ b/stdlib/source/lux/host/jvm/constant/tag.lux @@ -0,0 +1,49 @@ +(.module: + [lux #* + [control + [equivalence (#+ Equivalence)]] + [data + [format + ["." binary (#+ Format)]]] + [type + abstract]] + [/// + ["." encoding (#+ U1) ("u1/." Equivalence<U1>)]]) + +(abstract: #export Tag + {} + + U1 + + (structure: #export _ (Equivalence Tag) + (def: (= reference sample) + (u1/= (:representation reference) + (:representation sample)))) + + (do-template [<code> <name>] + [(def: #export <name> + Tag + (:abstraction (encoding.to-u1 <code>)))] + + [01 utf8] + [03 integer] + [04 float] + [05 long] + [06 double] + [07 class] + [08 string] + [09 field] + [10 method] + [11 interface] + [12 name-and-type] + [15 method-handle] + [16 method-type] + [18 invoke-dynamic] + ) + + (def: #export format + (Format Tag) + (binary.adapt (|>> :abstraction) + (|>> :representation) + encoding.u1-format)) + ) diff --git a/stdlib/source/lux/host/jvm/encoding.lux b/stdlib/source/lux/host/jvm/encoding.lux new file mode 100644 index 000000000..6d8afe348 --- /dev/null +++ b/stdlib/source/lux/host/jvm/encoding.lux @@ -0,0 +1,49 @@ +(.module: + [lux #* + [control + [equivalence (#+ Equivalence)] + [parser ("parser/." Functor<Parser>)]] + [data + [number + ["." i64]] + [format + ["." binary (#+ Format)]]] + [type + abstract]]) + +(do-template [<name> <bytes> <to> <from>] + [(abstract: #export <name> + {} + + (I64 Any) + + (def: #export <to> + (-> (I64 Any) <name>) + (let [mask (|> <bytes> + (n/* i64.bits-per-byte) + i64.mask)] + (|>> (i64.and mask) :abstraction))) + + (def: #export <from> + (-> <name> (I64 Any)) + (|>> :representation)) + + (structure: #export _ (Equivalence <name>) + (def: (= reference sample) + ("lux i64 =" (:representation reference) (:representation sample)))) + )] + + [U1 1 to-u1 from-u1] + [U2 2 to-u2 from-u2] + [U4 4 to-u4 from-u4] + ) + +(do-template [<name> <type> <format> <pre-write> <post-read>] + [(def: #export <name> + (Format <type>) + (binary.adapt <post-read> <pre-write> <format>))] + + [u1-format U1 binary.bits/8 ..from-u1 ..to-u1] + [u2-format U2 binary.bits/16 ..from-u2 ..to-u2] + [u4-format U4 binary.bits/32 ..from-u4 ..to-u4] + ) diff --git a/stdlib/source/lux/host/jvm/index.lux b/stdlib/source/lux/host/jvm/index.lux new file mode 100644 index 000000000..60d6211c6 --- /dev/null +++ b/stdlib/source/lux/host/jvm/index.lux @@ -0,0 +1,17 @@ +(.module: + [lux #* + [data + [format + [binary (#+ Format)]]]] + [// + ["//." encoding (#+ U2)]]) + +(type: #export Index U2) + +(def: #export index + (-> Nat Index) + //encoding.to-u2) + +(def: #export format + (Format Index) + //encoding.u2-format) diff --git a/stdlib/source/lux/host/jvm/magic.lux b/stdlib/source/lux/host/jvm/magic.lux new file mode 100644 index 000000000..e32259529 --- /dev/null +++ b/stdlib/source/lux/host/jvm/magic.lux @@ -0,0 +1,19 @@ +(.module: + [lux #* + [data + [number (#+ hex)] + [format + [binary (#+ Format)]]]] + [// + ["//." encoding (#+ U4)]]) + +(type: #export Magic + U4) + +(def: #export code + Magic + (//encoding.to-u4 (hex "CAFEBABE"))) + +(def: #export format + (Format Magic) + //encoding.u4-format) diff --git a/stdlib/source/lux/host/jvm/name.lux b/stdlib/source/lux/host/jvm/name.lux new file mode 100644 index 000000000..d609b627d --- /dev/null +++ b/stdlib/source/lux/host/jvm/name.lux @@ -0,0 +1,30 @@ +(.module: + [lux (#- Name) + [data + ["." text]] + [type + abstract]]) + +(def: #export internal-separator "/") +(def: #export external-separator ".") + +(abstract: #export Name + {} + + Text + + (def: #export internal + (-> Text Name) + (|>> (text.replace-all ..external-separator + ..internal-separator) + :abstraction)) + + (def: #export read + (-> Name Text) + (|>> :representation)) + + (def: #export external + (-> Name Text) + (|>> :representation + (text.replace-all ..internal-separator + ..external-separator)))) diff --git a/stdlib/source/lux/host/jvm/version.lux b/stdlib/source/lux/host/jvm/version.lux new file mode 100644 index 000000000..aca98e990 --- /dev/null +++ b/stdlib/source/lux/host/jvm/version.lux @@ -0,0 +1,38 @@ +(.module: + [lux #* + [data + [format + ["." binary (#+ Format)]]]] + [// + ["//." encoding (#+ U2)]]) + +(type: #export Version U2) +(type: #export Minor Version) +(type: #export Major Version) + +(def: #export version + (-> Nat Version) + //encoding.to-u2) + +(do-template [<name> <number>] + [(def: #export <name> + Major + (..version <number>))] + + [v1_1 45] + [v1_2 46] + [v1_3 47] + [v1_4 48] + [v5_0 49] + [v6_0 50] + [v7 51] + [v8 52] + [v9 53] + [v10 54] + [v11 55] + [v12 56] + ) + +(def: #export format + (Format Version) + //encoding.u2-format) |