aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/host/jvm.lux41
-rw-r--r--stdlib/source/lux/host/jvm/method.lux52
-rw-r--r--stdlib/source/lux/host/jvm/modifier/method.lux30
-rw-r--r--stdlib/test/test/lux/host/jvm.jvm.lux23
4 files changed, 87 insertions, 59 deletions
diff --git a/stdlib/source/lux/host/jvm.lux b/stdlib/source/lux/host/jvm.lux
index b0030c84f..379be7c9a 100644
--- a/stdlib/source/lux/host/jvm.lux
+++ b/stdlib/source/lux/host/jvm.lux
@@ -15,17 +15,12 @@
["/." index (#+ Index)]
["/." attribute (#+ Attribute)]
["/." field (#+ Field)]
+ ["/." method (#+ Method)]
[modifier
["/.M" class]]
["/." constant (#+ Constant)
["/." pool (#+ Pool)]]])
-(type: #export Interface
- (Index /constant.Class))
-
-(type: #export Method
- Any)
-
(type: #export Class
{#magic Magic
#minor-version Minor
@@ -34,7 +29,7 @@
#access-flags /classM.Modifier
#this (Index /constant.Class)
#super (Index /constant.Class)
- #interfaces (Row Interface)
+ #interfaces (Row (Index /constant.Class))
#fields (Row Field)
#methods (Row Method)
#attributes (Row Attribute)})
@@ -43,20 +38,26 @@
(def: (install-classes this super interfaces)
(-> Internal Internal (List Internal)
- (State Pool [(Index /constant.Class) (Index /constant.Class) (Row Interface)]))
+ (State Pool [(Index /constant.Class) (Index /constant.Class) (Row (Index /constant.Class))]))
(do state.Monad<State>
[@this (/pool.class (/name.read this))
@super (/pool.class (/name.read super))
- @interfaces (monad.fold @ (function (_ interface @interfaces)
- (do @
- [@interface (/pool.class (/name.read interface))]
- (wrap (row.add @interface @interfaces))))
- (: (Row Interface) row.empty)
- interfaces)]
+ @interfaces (: (State Pool (Row (Index /constant.Class)))
+ (monad.fold @ (function (_ interface @interfaces)
+ (do @
+ [@interface (/pool.class (/name.read interface))]
+ (wrap (row.add @interface @interfaces))))
+ row.empty
+ interfaces))]
(wrap [@this @super @interfaces])))
-(def: #export (class version access super this interfaces fields)
- (-> Major /classM.Modifier Internal Internal (List Internal) (Row Field) Class)
+(def: #export (class version access
+ super this interfaces
+ fields methods attributes)
+ (-> Major /classM.Modifier
+ Internal Internal (List Internal)
+ (Row Field) (Row Method) (Row Attribute)
+ Class)
(let [[pool [@this @super @interfaces]] (state.run (: Pool row.empty)
(install-classes this super interfaces))]
{#magic /magic.code
@@ -68,10 +69,10 @@
#super @super
#interfaces @interfaces
#fields fields
- #methods row.empty
- #attributes row.empty}))
+ #methods methods
+ #attributes attributes}))
-(def: #export classF
+(def: #export format
(Format Class)
($_ binary.and
/magic.format
@@ -83,5 +84,5 @@
/index.format
(binary.row/16 /index.format)
(binary.row/16 /field.format)
- (binary.row/16 (binary.ignore []))
+ (binary.row/16 /method.format)
(binary.row/16 /attribute.format)))
diff --git a/stdlib/source/lux/host/jvm/method.lux b/stdlib/source/lux/host/jvm/method.lux
new file mode 100644
index 000000000..d7e8354e8
--- /dev/null
+++ b/stdlib/source/lux/host/jvm/method.lux
@@ -0,0 +1,52 @@
+(.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)]])
+
+(modifiers:
+ ["0001" public]
+ ["0002" private]
+ ["0004" protected]
+ ["0008" static]
+ ["0010" final]
+ ["0020" synchronized]
+ ["0040" bridge]
+ ["0080" var-args]
+ ["0100" native]
+ ["0400" abstract]
+ ["0800" strict]
+ ["1000" synthetic]
+ )
+
+(type: #export Method
+ {#modifier Modifier
+ #name (Index UTF8)
+ #descriptor (Index (Descriptor //descriptor.Method))
+ #attributes (Row Attribute)})
+
+(def: #export format
+ (Format Method)
+ ($_ binary.and
+ ..modifier-format
+ //index.format
+ //index.format
+ (binary.row/16 //attribute.format)))
diff --git a/stdlib/source/lux/host/jvm/modifier/method.lux b/stdlib/source/lux/host/jvm/modifier/method.lux
deleted file mode 100644
index e15a971ae..000000000
--- a/stdlib/source/lux/host/jvm/modifier/method.lux
+++ /dev/null
@@ -1,30 +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]
- ["0020" synchronized]
- ["0040" bridge]
- ["0080" var-args]
- ["0100" native]
- ["0400" abstract]
- ["0800" strict]
- ["1000" synthetic]
- )
diff --git a/stdlib/test/test/lux/host/jvm.jvm.lux b/stdlib/test/test/lux/host/jvm.jvm.lux
index 692e5eeda..701286455 100644
--- a/stdlib/test/test/lux/host/jvm.jvm.lux
+++ b/stdlib/test/test/lux/host/jvm.jvm.lux
@@ -11,7 +11,8 @@
[format
["." binary]]
[collection
- ["." dictionary]]]
+ ["." dictionary]
+ ["." row]]]
["." io (#+ IO)]
[world
["." file (#+ File)]
@@ -21,10 +22,9 @@
["/." loader (#+ Library)]
["/." version]
["/." name]
+ ["/." field]
[modifier
["/.M" class]
- ["/.M" field]
- ["/.M" method]
["/.M" inner]]]]
[math
["r" random]]]
@@ -53,18 +53,23 @@
(/name.internal "java.lang.Object")
(/name.internal full-name)
(list (/name.internal "java.io.Serializable")
- (/name.internal "java.lang.Runnable")))
- bytecode (binary.write /.classF class)
+ (/name.internal "java.lang.Runnable"))
+ (row.row)
+ (row.row)
+ (row.row))
+ bytecode (binary.write /.format class)
loader (/loader.memory (/loader.new-library []))]
- (exec (io.run (..write-class name))
+ (exec
+ ## TODO: Remove 'write-class' call.
+ (io.run (..write-class name))
($_ seq
(test "Can read generated class."
- (case (binary.read /.classF bytecode)
+ (case (binary.read /.format bytecode)
(#error.Success class)
true
(#error.Failure error)
- ## TODO: Remove log!
+ ## TODO: Remove 'log!' call.
(exec (log! error)
false)))
(test "Can generate a class."
@@ -73,7 +78,7 @@
true
(#error.Failure error)
- ## TODO: Remove log!
+ ## TODO: Remove 'log!' call.
(exec (log! error)
false)))
))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 01:31:53 +0000