aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/host/jvm.lux16
-rw-r--r--stdlib/source/lux/host/jvm/attribute.lux82
-rw-r--r--stdlib/source/lux/host/jvm/constant.lux30
-rw-r--r--stdlib/source/lux/host/jvm/encoding.lux10
-rw-r--r--stdlib/source/lux/host/jvm/field.lux49
-rw-r--r--stdlib/source/lux/host/jvm/modifier.lux29
-rw-r--r--stdlib/source/lux/host/jvm/modifier/field.lux27
7 files changed, 178 insertions, 65 deletions
diff --git a/stdlib/source/lux/host/jvm.lux b/stdlib/source/lux/host/jvm.lux
index b8139760c..b0030c84f 100644
--- a/stdlib/source/lux/host/jvm.lux
+++ b/stdlib/source/lux/host/jvm.lux
@@ -14,6 +14,7 @@
["/." magic (#+ Magic)]
["/." index (#+ Index)]
["/." attribute (#+ Attribute)]
+ ["/." field (#+ Field)]
[modifier
["/.M" class]]
["/." constant (#+ Constant)
@@ -22,9 +23,6 @@
(type: #export Interface
(Index /constant.Class))
-(type: #export Field
- Any)
-
(type: #export Method
Any)
@@ -57,8 +55,8 @@
interfaces)]
(wrap [@this @super @interfaces])))
-(def: #export (class version access super this interfaces)
- (-> Major /classM.Modifier Internal Internal (List Internal) Class)
+(def: #export (class version access super this interfaces fields)
+ (-> Major /classM.Modifier Internal Internal (List Internal) (Row Field) Class)
(let [[pool [@this @super @interfaces]] (state.run (: Pool row.empty)
(install-classes this super interfaces))]
{#magic /magic.code
@@ -69,7 +67,7 @@
#this @this
#super @super
#interfaces @interfaces
- #fields row.empty
+ #fields fields
#methods row.empty
#attributes row.empty}))
@@ -80,10 +78,10 @@
/version.format
/version.format
/pool.format
- /classM.format
+ /classM.modifier-format
/index.format
/index.format
(binary.row/16 /index.format)
+ (binary.row/16 /field.format)
(binary.row/16 (binary.ignore []))
- (binary.row/16 (binary.ignore []))
- (binary.row/16 (binary.ignore []))))
+ (binary.row/16 /attribute.format)))
diff --git a/stdlib/source/lux/host/jvm/attribute.lux b/stdlib/source/lux/host/jvm/attribute.lux
index 3f0dd9b61..87891f35c 100644
--- a/stdlib/source/lux/host/jvm/attribute.lux
+++ b/stdlib/source/lux/host/jvm/attribute.lux
@@ -1,22 +1,84 @@
(.module:
- [lux #*
+ [lux (#- Info Code' Code)
+ [control
+ [monad (#+ do)]
+ ["." state (#+ State)]]
[data
[format
- ["." binary (#+ Format)]]]]
+ ["." binary (#+ Format)]]
+ [collection
+ ["." row (#+ Row)]]]
+ [world
+ [binary (#+ Binary)]]]
[//
["//." encoding (#+ U2 U4)]
- ["//." index (#+ Index)]])
+ ["//." index (#+ Index)]
+ ["//." constant (#+ UTF8 Class Value)
+ ["//." pool (#+ Pool)]]])
-(type: #export Constant-Value
- {#name Index
+(type: #export (Info about)
+ {#name (Index UTF8)
#length U4
- #index Index})
+ #info about})
-(def: #export constant-value
+(def: (info-format about)
+ (All [about]
+ (-> (Format about)
+ (Format (Info about))))
($_ binary.and
//index.format
//encoding.u4-format
- //index.format))
+ about))
-(type: #export Attribute
- Any)
+(type: #export Constant
+ (Info (Index (Value Any))))
+
+(def: constant-format
+ (Format Constant)
+ (..info-format //index.format))
+
+(type: #export Label U2)
+
+(type: #export Exception
+ {#start-pc Label
+ #end-pc Label
+ #handler-pc Label
+ #catch-type (Index Class)})
+
+(type: #export (Code' Attribute)
+ {#max-stack U2
+ #max-locals U2
+ #code Binary
+ #exception-table (Row Exception)
+ #attributes (Row Attribute)})
+
+(with-expansions [<Code> (as-is (Info (Code' Attribute)))]
+ (type: #export #rec Attribute
+ (#Constant Constant)
+ ## (#Code <Code>)
+ )
+
+ ## (type: #export Code
+ ## <Code>)
+ )
+
+(def: #export (constant index)
+ (-> (Index (Value Any))
+ (State Pool Attribute))
+ (do state.Monad<State>
+ [@name (//pool.utf8 "ConstantValue")]
+ (wrap (#Constant {#name @name
+ #length (//encoding.to-u4 //encoding.u2-bytes)
+ #info index}))))
+
+## (def: #export (code specification)
+## (-> Code' (State Pool Attribute))
+## (do state.Monad<State>
+## [@name (//pool.utf8 "Code")]
+## (wrap (#Code {#name @name
+## #length (undefined)
+## #info specification}))))
+
+(def: #export format
+ (Format Attribute)
+ ..constant-format)
diff --git a/stdlib/source/lux/host/jvm/constant.lux b/stdlib/source/lux/host/jvm/constant.lux
index d2c9018ae..913c9043b 100644
--- a/stdlib/source/lux/host/jvm/constant.lux
+++ b/stdlib/source/lux/host/jvm/constant.lux
@@ -10,7 +10,8 @@
[collection
["." row (#+ Row)]]]
[type
- abstract]]
+ abstract]
+ ["." host (#+ import:)]]
[//
["//." index (#+ Index)]]
[/
@@ -44,6 +45,33 @@
//index.format))
)
+(abstract: #export (Value kind)
+
+ {}
+
+ kind
+
+ (def: #export value
+ (All [kind] (-> (Value kind) kind))
+ (|>> :representation))
+
+ (do-template [<type> <class> <constructor>]
+ [(import: #long <class>)
+
+ (type: #export <type> (Value <class>))
+
+ (def: #export <constructor>
+ (-> <class> <type>)
+ (|>> :abstraction))]
+
+ [Integer java/lang/Integer integer]
+ [Long java/lang/Long long]
+ [Float java/lang/Float float]
+ [Double java/lang/Double double]
+ [String java/lang/String string]
+ )
+ )
+
(type: #export Constant
(#UTF8 UTF8)
(#Class Class))
diff --git a/stdlib/source/lux/host/jvm/encoding.lux b/stdlib/source/lux/host/jvm/encoding.lux
index 6d8afe348..2b2c487ec 100644
--- a/stdlib/source/lux/host/jvm/encoding.lux
+++ b/stdlib/source/lux/host/jvm/encoding.lux
@@ -11,12 +11,14 @@
[type
abstract]])
-(do-template [<name> <bytes> <to> <from>]
+(do-template [<bytes> <name> <size> <to> <from>]
[(abstract: #export <name>
{}
(I64 Any)
+ (def: #export <size> Nat <bytes>)
+
(def: #export <to>
(-> (I64 Any) <name>)
(let [mask (|> <bytes>
@@ -33,9 +35,9 @@
("lux i64 =" (:representation reference) (:representation sample))))
)]
- [U1 1 to-u1 from-u1]
- [U2 2 to-u2 from-u2]
- [U4 4 to-u4 from-u4]
+ [1 U1 u1-bytes to-u1 from-u1]
+ [2 U2 u2-bytes to-u2 from-u2]
+ [4 U4 u4-bytes to-u4 from-u4]
)
(do-template [<name> <type> <format> <pre-write> <post-read>]
diff --git a/stdlib/source/lux/host/jvm/field.lux b/stdlib/source/lux/host/jvm/field.lux
new file mode 100644
index 000000000..802670780
--- /dev/null
+++ b/stdlib/source/lux/host/jvm/field.lux
@@ -0,0 +1,49 @@
+(.module:
+ [lux (#- static)
+ [control
+ [monoid (#+)]
+ [parser (#+)]
+ ["." monad (#+ do)]
+ ["." state (#+ State)]]
+ [data
+ [number (#+)
+ [i64 (#+)]]
+ [format
+ ["." binary (#+ Format)]]
+ [collection
+ ["." row (#+ Row)]]]
+ [type
+ [abstract (#+)]]]
+ [//
+ [encoding (#+)]
+ [modifier (#+ modifiers:)]
+ ["//." constant (#+ UTF8)]
+ ["//." index (#+ Index)]
+ ["//." attribute (#+ Attribute)]
+ ["//." descriptor (#+ Descriptor Value)]])
+
+(modifiers:
+ ["0001" public]
+ ["0002" private]
+ ["0004" protected]
+ ["0008" static]
+ ["0010" final]
+ ["0040" volatile]
+ ["0080" transient]
+ ["1000" synthetic]
+ ["4000" enum]
+ )
+
+(type: #export Field
+ {#modifier Modifier
+ #name (Index UTF8)
+ #descriptor (Index (Descriptor (Value Any)))
+ #attributes (Row Attribute)})
+
+(def: #export format
+ (Format Field)
+ ($_ binary.and
+ ..modifier-format
+ //index.format
+ //index.format
+ (binary.row/16 //attribute.format)))
diff --git a/stdlib/source/lux/host/jvm/modifier.lux b/stdlib/source/lux/host/jvm/modifier.lux
index 5c9280164..0263fc1ec 100644
--- a/stdlib/source/lux/host/jvm/modifier.lux
+++ b/stdlib/source/lux/host/jvm/modifier.lux
@@ -34,41 +34,42 @@
(syntax: #export (modifiers: {options (parser.many ..modifier)})
(with-gensyms [g!parameter g!subject g!<name> g!<code>]
- (let [nameC (' Modifier)
- combineC (' combine)
- emptyC (' empty)
- typeC (` (abstract.abstract: (~' #export) (~ nameC)
+ (let [g!name (' Modifier)
+ g!combine (' combine)
+ g!empty (' empty)
+ g!format (' modifier-format)
+ typeC (` (abstract.abstract: (~' #export) (~ g!name)
{}
//encoding.U2
(.def: (~' #export) (~' code)
- (.-> (~ nameC) //encoding.U2)
+ (.-> (~ g!name) //encoding.U2)
(.|>> (~' :representation)))
- (.def: (~' #export) ((~ combineC) (~ g!parameter) (~ g!subject))
- (.-> (~ nameC) (~ nameC) (~ nameC))
+ (.def: (~' #export) ((~ g!combine) (~ g!parameter) (~ g!subject))
+ (.-> (~ g!name) (~ g!name) (~ g!name))
((~' :abstraction) (//encoding.to-u2 (i64.and (//encoding.from-u2 ((~' :representation) (~ g!parameter)))
(//encoding.from-u2 ((~' :representation) (~ g!subject)))))))
(.do-template [(~ g!<code>) (~ g!<name>)]
[(.def: (~' #export) (~ g!<name>)
- (~ nameC)
+ (~ g!name)
(.|> (number.hex (~ g!<code>)) //encoding.to-u2 (~' :abstraction)))]
- ["0000" (~ emptyC)]
+ ["0000" (~ g!empty)]
(~+ (list/map ..code options))
)
- (.def: (~' #export) (~' format)
- (binary.Format (~ nameC))
+ (.def: (~' #export) (~ g!format)
+ (binary.Format (~ g!name))
(.let [(.^open "_/.") //encoding.u2-format]
{#binary.reader (|> (~' _/reader)
(:: parser.Functor<Parser> (~' map)
(|>> (~' :abstraction))))
#binary.writer (|>> (~' :representation)
(~' _/writer))}))))
- monoidC (` (.structure: (~' #export) (~' _) (monoid.Monoid (~ nameC))
- (.def: (~' identity) (~ emptyC))
- (.def: (~' compose) (~ combineC))))]
+ monoidC (` (.structure: (~' #export) (~' _) (monoid.Monoid (~ g!name))
+ (.def: (~' identity) (~ g!empty))
+ (.def: (~' compose) (~ g!combine))))]
(wrap (list typeC monoidC)))))
diff --git a/stdlib/source/lux/host/jvm/modifier/field.lux b/stdlib/source/lux/host/jvm/modifier/field.lux
deleted file mode 100644
index 6099bc62e..000000000
--- a/stdlib/source/lux/host/jvm/modifier/field.lux
+++ /dev/null
@@ -1,27 +0,0 @@
-(.module:
- [lux (#- static)
- [control
- [monoid (#+)]
- [parser (#+)]]
- [data
- [number (#+)
- [i64 (#+)]]
- [format
- [binary (#+)]]]
- [type
- [abstract (#+)]]]
- [// (#+ modifiers:)
- [//
- [encoding (#+)]]])
-
-(modifiers:
- ["0001" public]
- ["0002" private]
- ["0004" protected]
- ["0008" static]
- ["0010" final]
- ["0040" volatile]
- ["0080" transient]
- ["1000" synthetic]
- ["4000" enum]
- )
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 06:18:46 +0000