aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2018-12-26 19:02:48 -0400
committerEduardo Julian2018-12-26 19:02:48 -0400
commit93758baa5f3f981112d607f2eb78cf6e849aaa56 (patch)
treea6f2153179ddcd07165239d13c0f363babe98b1b /stdlib
parent7a69373e2dc7343145f815c8dc1081a1bfc233bb (diff)
Added support for interfaces in classes.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/host/jvm.lux66
-rw-r--r--stdlib/source/lux/host/jvm/constant/tag.lux2
2 files changed, 47 insertions, 21 deletions
diff --git a/stdlib/source/lux/host/jvm.lux b/stdlib/source/lux/host/jvm.lux
index bf9688d66..7e63fd027 100644
--- a/stdlib/source/lux/host/jvm.lux
+++ b/stdlib/source/lux/host/jvm.lux
@@ -4,6 +4,7 @@
[format
["." binary (#+ Format)]]
[collection
+ [list ("list/." Fold<List>)]
["." row (#+ Row)]]]]
[/
["/." version (#+ Version Minor Major)]
@@ -13,6 +14,9 @@
["/." constant (#+ Constant)]
["/." index (#+ Index)]])
+(type: #export Interface
+ Index)
+
(type: #export Field
Any)
@@ -22,36 +26,58 @@
(type: #export Attribute
Any)
+(type: #export Pool (Row Constant))
+
(type: #export Class
{#magic Magic
#minor-version Minor
#major-version Major
- #constant-pool (Row Constant)
+ #constant-pool Pool
#access-flags Access
#this Index
#super Index
- #interfaces (Row Index)
+ #interfaces (Row Interface)
#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: default-minor-version Minor (/version.version 0))
+
+(def: #export (class version access super this interfaces)
+ (-> Major Access Name Name (List Name) Class)
+ (let [with-classes (: (-> Pool Pool)
+ (|>> (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)))))
+ with-interfaces (: (-> Nat Pool [(Row Index) Pool])
+ (function (_ offset pool)
+ (let [[_last-index indices pool']
+ (list/fold (function (_ interface [index interface-indices' pool'])
+ [(n/+ 2 index)
+ (row.add (/index.index (n/+ 1 index))
+ interface-indices')
+ (|> pool'
+ (row.add (#/constant.UTF8 (/name.read interface)))
+ (row.add (#/constant.Class (/index.index index))))])
+ [offset (: (Row Index) row.empty) pool]
+ interfaces)]
+ [indices pool'])))
+ interfaces-offset 5
+ [interface-indices pool] (|> row.empty
+ with-classes
+ (with-interfaces interfaces-offset))]
+ {#magic /magic.code
+ #minor-version ..default-minor-version
+ #major-version version
+ #constant-pool pool
+ #access-flags access
+ #this (/index.index 2)
+ #super (/index.index 4)
+ #interfaces interface-indices
+ #fields row.empty
+ #methods row.empty
+ #attributes row.empty}))
(def: #export classF
(Format Class)
@@ -63,7 +89,7 @@
/access.format
/index.format
/index.format
- (binary.row/16 (binary.ignore (/index.index 0)))
+ (binary.row/16 /index.format)
(binary.row/16 (binary.ignore []))
(binary.row/16 (binary.ignore []))
(binary.row/16 (binary.ignore []))))
diff --git a/stdlib/source/lux/host/jvm/constant/tag.lux b/stdlib/source/lux/host/jvm/constant/tag.lux
index 57fd6d92e..8e34d975d 100644
--- a/stdlib/source/lux/host/jvm/constant/tag.lux
+++ b/stdlib/source/lux/host/jvm/constant/tag.lux
@@ -34,7 +34,7 @@
[08 string]
[09 field]
[10 method]
- [11 interface]
+ [11 interface-method]
[12 name-and-type]
[15 method-handle]
[16 method-type]