From fcb8ce8340f4226a38d08f9e2f108e5ec0a95018 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 13 Jun 2019 23:32:50 -0400 Subject: Some fixes. --- new-luxc/source/luxc/lang/host/jvm/inst.lux | 4 +- new-luxc/source/luxc/lang/statement/jvm.lux | 12 +----- .../luxc/lang/translation/jvm/procedure/host.lux | 43 ++++++++++++++++++++-- 3 files changed, 43 insertions(+), 16 deletions(-) (limited to 'new-luxc/source') 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 [] 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 [ ] (^ [(static ) [_ ( value)]]) - ( #$.Public $.finalF name value)) + ( #$.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 "" (anonymous-init-method env) (|>> (_.ALOAD 0) - (_.INVOKESPECIAL jvm.object-class "" (jvm.method (list) #.None (list)) #0) + ((_.fuse (list@map product.right constructor-argsI))) + (_.INVOKESPECIAL (product.left super-class) + "" + (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)))])) -- cgit v1.2.3