aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux/host/jvm.lux88
-rw-r--r--stdlib/source/lux/host/jvm/class.lux105
-rw-r--r--stdlib/source/lux/host/jvm/modifier/class.lux26
-rw-r--r--stdlib/test/test/lux/host/jvm.jvm.lux26
4 files changed, 118 insertions, 127 deletions
diff --git a/stdlib/source/lux/host/jvm.lux b/stdlib/source/lux/host/jvm.lux
deleted file mode 100644
index 379be7c9a..000000000
--- a/stdlib/source/lux/host/jvm.lux
+++ /dev/null
@@ -1,88 +0,0 @@
-(.module:
- [lux #*
- [control
- ["." monad (#+ do)]
- ["." state (#+ State)]]
- [data
- [format
- ["." binary (#+ Format)]]
- [collection
- ["." row (#+ Row)]]]]
- [/
- ["/." version (#+ Version Minor Major)]
- ["/." name (#+ Internal)]
- ["/." magic (#+ Magic)]
- ["/." index (#+ Index)]
- ["/." attribute (#+ Attribute)]
- ["/." field (#+ Field)]
- ["/." method (#+ Method)]
- [modifier
- ["/.M" class]]
- ["/." constant (#+ Constant)
- ["/." pool (#+ Pool)]]])
-
-(type: #export Class
- {#magic Magic
- #minor-version Minor
- #major-version Major
- #constant-pool Pool
- #access-flags /classM.Modifier
- #this (Index /constant.Class)
- #super (Index /constant.Class)
- #interfaces (Row (Index /constant.Class))
- #fields (Row Field)
- #methods (Row Method)
- #attributes (Row Attribute)})
-
-(def: default-minor-version Minor (/version.version 0))
-
-(def: (install-classes this super interfaces)
- (-> Internal Internal (List Internal)
- (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 (: (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 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
- #minor-version ..default-minor-version
- #major-version version
- #constant-pool pool
- #access-flags access
- #this @this
- #super @super
- #interfaces @interfaces
- #fields fields
- #methods methods
- #attributes attributes}))
-
-(def: #export format
- (Format Class)
- ($_ binary.and
- /magic.format
- /version.format
- /version.format
- /pool.format
- /classM.modifier-format
- /index.format
- /index.format
- (binary.row/16 /index.format)
- (binary.row/16 /field.format)
- (binary.row/16 /method.format)
- (binary.row/16 /attribute.format)))
diff --git a/stdlib/source/lux/host/jvm/class.lux b/stdlib/source/lux/host/jvm/class.lux
new file mode 100644
index 000000000..ca5e8f61f
--- /dev/null
+++ b/stdlib/source/lux/host/jvm/class.lux
@@ -0,0 +1,105 @@
+(.module:
+ [lux #*
+ [control
+ [monoid (#+)]
+ [parser (#+)]
+ ["." monad (#+ do)]
+ ["." state (#+ State)]]
+ [data
+ [number (#+)
+ [i64 (#+)]]
+ [format
+ ["." binary (#+ Format)]]
+ [collection
+ ["." row (#+ Row)]]]
+ [type
+ [abstract (#+)]]]
+ [//
+ ["//." encoding (#+)]
+ ["//." modifier (#+ modifiers:)]
+ ["//." version (#+ Version Minor Major)]
+ ["//." name (#+ Internal)]
+ ["//." magic (#+ Magic)]
+ ["//." index (#+ Index)]
+ ["//." attribute (#+ Attribute)]
+ ["//." field (#+ Field)]
+ ["//." method (#+ Method)]
+ ["//." constant (#+ Constant)
+ ["//." pool (#+ Pool)]]])
+
+(modifiers:
+ ["0001" public]
+ ["0010" final]
+ ["0020" super]
+ ["0200" interface]
+ ["0400" abstract]
+ ["1000" synthetic]
+ ["2000" annotation]
+ ["4000" enum]
+ )
+
+(type: #export Class
+ {#magic Magic
+ #minor-version Minor
+ #major-version Major
+ #constant-pool Pool
+ #access-flags Modifier
+ #this (Index //constant.Class)
+ #super (Index //constant.Class)
+ #interfaces (Row (Index //constant.Class))
+ #fields (Row Field)
+ #methods (Row Method)
+ #attributes (Row Attribute)})
+
+(def: default-minor-version Minor (//version.version 0))
+
+(def: (install-classes this super interfaces)
+ (-> Internal Internal (List Internal)
+ (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 (: (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 methods attributes)
+ (-> Major 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
+ #minor-version ..default-minor-version
+ #major-version version
+ #constant-pool pool
+ #access-flags access
+ #this @this
+ #super @super
+ #interfaces @interfaces
+ #fields fields
+ #methods methods
+ #attributes attributes}))
+
+(def: #export format
+ (Format Class)
+ ($_ binary.and
+ //magic.format
+ //version.format
+ //version.format
+ //pool.format
+ ..modifier-format
+ //index.format
+ //index.format
+ (binary.row/16 //index.format)
+ (binary.row/16 //field.format)
+ (binary.row/16 //method.format)
+ (binary.row/16 //attribute.format)))
diff --git a/stdlib/source/lux/host/jvm/modifier/class.lux b/stdlib/source/lux/host/jvm/modifier/class.lux
deleted file mode 100644
index e9da25b4a..000000000
--- a/stdlib/source/lux/host/jvm/modifier/class.lux
+++ /dev/null
@@ -1,26 +0,0 @@
-(.module:
- [lux #*
- [control
- [monoid (#+)]
- [parser (#+)]]
- [data
- [number (#+)
- [i64 (#+)]]
- [format
- [binary (#+)]]]
- [type
- [abstract (#+)]]]
- [// (#+ modifiers:)
- [//
- [encoding (#+)]]])
-
-(modifiers:
- ["0001" public]
- ["0010" final]
- ["0020" super]
- ["0200" interface]
- ["0400" abstract]
- ["1000" synthetic]
- ["2000" annotation]
- ["4000" enum]
- )
diff --git a/stdlib/test/test/lux/host/jvm.jvm.lux b/stdlib/test/test/lux/host/jvm.jvm.lux
index 701286455..309deb800 100644
--- a/stdlib/test/test/lux/host/jvm.jvm.lux
+++ b/stdlib/test/test/lux/host/jvm.jvm.lux
@@ -18,13 +18,13 @@
["." file (#+ File)]
[binary (#+ Binary)]]
[host
- ["/" jvm
+ [jvm
["/." loader (#+ Library)]
["/." version]
["/." name]
["/." field]
+ ["/." class]
[modifier
- ["/.M" class]
["/.M" inner]]]]
[math
["r" random]]]
@@ -49,22 +49,22 @@
(let [package "my.package"
name "MyClass"
full-name (format package "." name)
- class (/.class /version.v6_0 /classM.public
- (/name.internal "java.lang.Object")
- (/name.internal full-name)
- (list (/name.internal "java.io.Serializable")
- (/name.internal "java.lang.Runnable"))
- (row.row)
- (row.row)
- (row.row))
- bytecode (binary.write /.format class)
+ class (/class.class /version.v6_0 /class.public
+ (/name.internal "java.lang.Object")
+ (/name.internal full-name)
+ (list (/name.internal "java.io.Serializable")
+ (/name.internal "java.lang.Runnable"))
+ (row.row)
+ (row.row)
+ (row.row))
+ bytecode (binary.write /class.format class)
loader (/loader.memory (/loader.new-library []))]
(exec
## TODO: Remove 'write-class' call.
(io.run (..write-class name))
($_ seq
- (test "Can read generated class."
- (case (binary.read /.format bytecode)
+ (test "Can read a generated class."
+ (case (binary.read /class.format bytecode)
(#error.Success class)
true
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 08:56:14 +0000