diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/source/luxc/lang/host/jvm/inst.lux | 4 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/statement/jvm.lux | 12 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux | 43 |
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)))])) |