aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/format/binary.lux62
-rw-r--r--stdlib/source/lux/host/jvm.lux69
-rw-r--r--stdlib/source/lux/host/jvm/access.lux57
-rw-r--r--stdlib/source/lux/host/jvm/constant.lux43
-rw-r--r--stdlib/source/lux/host/jvm/constant/tag.lux49
-rw-r--r--stdlib/source/lux/host/jvm/encoding.lux49
-rw-r--r--stdlib/source/lux/host/jvm/index.lux17
-rw-r--r--stdlib/source/lux/host/jvm/magic.lux19
-rw-r--r--stdlib/source/lux/host/jvm/name.lux30
-rw-r--r--stdlib/source/lux/host/jvm/version.lux38
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)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 19:38:23 +0000