aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/host/jvm/inst.lux4
-rw-r--r--new-luxc/source/luxc/lang/statement/jvm.lux12
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux43
3 files changed, 43 insertions, 16 deletions
diff --git a/new-luxc/source/luxc/lang/host/jvm/inst.lux b/new-luxc/source/luxc/lang/host/jvm/inst.lux
index aeb9621ef..35f779799 100644
--- a/new-luxc/source/luxc/lang/host/jvm/inst.lux
+++ b/new-luxc/source/luxc/lang/host/jvm/inst.lux
@@ -102,7 +102,7 @@
(~~ (declare MONITORENTER MONITOREXIT))
## Return
- (~~ (declare RETURN IRETURN LRETURN DRETURN ARETURN))
+ (~~ (declare RETURN IRETURN LRETURN FRETURN DRETURN ARETURN))
))
(import: #long org/objectweb/asm/Label
@@ -218,7 +218,7 @@
[MONITORENTER] [MONITOREXIT]
## Return
- [RETURN] [IRETURN] [LRETURN] [DRETURN] [ARETURN]
+ [RETURN] [IRETURN] [LRETURN] [FRETURN] [DRETURN] [ARETURN]
)
(template [<name>]
diff --git a/new-luxc/source/luxc/lang/statement/jvm.lux b/new-luxc/source/luxc/lang/statement/jvm.lux
index a21cc76c8..0de84d65b 100644
--- a/new-luxc/source/luxc/lang/statement/jvm.lux
+++ b/new-luxc/source/luxc/lang/statement/jvm.lux
@@ -136,14 +136,6 @@
(def: string-descriptor (type.descriptor (type.class "java.lang.String" (list))))
-(def: parameter-types
- (-> (List Var) (Check (List [Var Type])))
- (monad.map check.monad
- (function (_ parameterJ)
- (do check.monad
- [[_ parameterT] check.var]
- (wrap [parameterJ parameterT])))))
-
(def: jvm::class
(Handler Anchor Inst Definition)
(/.custom
@@ -167,7 +159,7 @@
(do phase.monad
[parameters (statement.lift-analysis
(typeA.with-env
- (parameter-types parameters)))
+ (jvm.parameter-types parameters)))
#let [mapping (list@fold (function (_ [parameterJ parameterT] mapping)
(dictionary.put parameterJ parameterT mapping))
luxT.fresh
@@ -180,7 +172,7 @@
(case [(type.descriptor type) value]
(^template [<descriptor> <tag> <field>]
(^ [(static <descriptor>) [_ (<tag> value)]])
- (<field> #$.Public $.finalF name value))
+ (<field> #$.Public ($.++F $.staticF $.finalF) name value))
([type.boolean-descriptor #.Bit _def.boolean-field]
[type.byte-descriptor #.Int _def.byte-field]
[type.short-descriptor #.Int _def.short-field]
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
index ce5d797b4..173bb9066 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
@@ -985,8 +985,8 @@
#.None
(list)))
-(def: (with-anonymous-init class env)
- (-> Text Environment Def)
+(def: (with-anonymous-init class env super-class constructor-argsI)
+ (-> Text Environment Class (List (Typed Inst)) Def)
(let [store-capturedI (|> env
list.size
list.indices
@@ -997,7 +997,11 @@
_.fuse)]
(_def.method #$.Public $.noneM "<init>" (anonymous-init-method env)
(|>> (_.ALOAD 0)
- (_.INVOKESPECIAL jvm.object-class "<init>" (jvm.method (list) #.None (list)) #0)
+ ((_.fuse (list@map product.right constructor-argsI)))
+ (_.INVOKESPECIAL (product.left super-class)
+ "<init>"
+ (jvm.method (list@map product.left constructor-argsI) #.None (list))
+ #0)
store-capturedI
_.RETURN))))
@@ -1056,6 +1060,12 @@
self-name arguments returnT exceptionsT
(normalize-method-body local-mapping body)]))
overriden-methods)]
+ constructor-argsI (monad.map @
+ (function (_ [argJT argS])
+ (do @
+ [argG (generate argS)]
+ (wrap [argJT argG])))
+ constructor-args)
method-definitions (|> normalized-methods
(monad.map @ (function (_ [ownerT name
strict-fp? annotations vars
@@ -1072,7 +1082,31 @@
returnT
(list@map (|>> #jvm.Class)
exceptionsT))
- bodyG)))))
+ (let [returnI (case returnT
+ (#.Some returnT)
+ (case returnT
+ (#jvm.Primitive returnT)
+ (case returnT
+ (^or #jvm.Boolean
+ #jvm.Byte #jvm.Short #jvm.Int
+ #jvm.Char)
+ _.IRETURN
+
+ #jvm.Long
+ _.LRETURN
+
+ #jvm.Float
+ _.FRETURN
+
+ #jvm.Double
+ _.DRETURN)
+
+ _
+ _.ARETURN)
+
+ #.None
+ _.RETURN)]
+ (|>> bodyG returnI)))))))
(:: @ map _def.fuse))
_ (generation.save! true ["" class-name]
[class-name
@@ -1080,6 +1114,7 @@
class-name (list)
super-class super-interfaces
(|>> (///function.with-environment total-environment)
+ (..with-anonymous-init class-name total-environment super-class constructor-argsI)
method-definitions))])]
(anonymous-instance class-name total-environment)))]))