diff options
Diffstat (limited to 'new-luxc/source/luxc')
| -rw-r--r-- | new-luxc/source/luxc/analyser/procedure/host.jvm.lux | 2 | ||||
| -rw-r--r-- | new-luxc/source/luxc/generator/procedure/host.jvm.lux | 12 | ||||
| -rw-r--r-- | new-luxc/source/luxc/generator/runtime.jvm.lux | 60 |
3 files changed, 53 insertions, 21 deletions
diff --git a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux index e45e7d807..84592d4ee 100644 --- a/new-luxc/source/luxc/analyser/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/analyser/procedure/host.jvm.lux @@ -866,7 +866,7 @@ [valueT unboxed valueA] (analyse-input analyse fieldT valueC) _ (&;with-type-env (tc;check fieldT valueT)) - _ (&;infer Unit)] + _ (&;infer objectT)] (wrap (#la;Procedure proc (list (#la;Text class) (#la;Text field) (#la;Text unboxed) valueA objectA)))) _ diff --git a/new-luxc/source/luxc/generator/procedure/host.jvm.lux b/new-luxc/source/luxc/generator/procedure/host.jvm.lux index a25c67feb..f908c6c6e 100644 --- a/new-luxc/source/luxc/generator/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/generator/procedure/host.jvm.lux @@ -531,7 +531,7 @@ #;None (wrap (|>. objectI ($i;CHECKCAST class) - ($i;GETFIELD class field ($t;class class (list))))))) + ($i;GETFIELD class field ($t;class unboxed (list))))))) _ (&;fail (format "Wrong syntax for '" proc "'.")))) @@ -557,18 +557,18 @@ _ (undefined))] (wrap (|>. objectI ($i;CHECKCAST class) + $i;DUP valueI ($i;unwrap primitive) - ($i;PUTFIELD class field (#$;Primitive primitive)) - ($i;string &runtime;unit)))) + ($i;PUTFIELD class field (#$;Primitive primitive))))) #;None (wrap (|>. objectI ($i;CHECKCAST class) + $i;DUP valueI - ($i;CHECKCAST class) - ($i;PUTFIELD class field ($t;class class (list))) - ($i;string &runtime;unit))))) + ($i;CHECKCAST unboxed) + ($i;PUTFIELD class field ($t;class unboxed (list))))))) _ (&;fail (format "Wrong syntax for '" proc "'.")))) diff --git a/new-luxc/source/luxc/generator/runtime.jvm.lux b/new-luxc/source/luxc/generator/runtime.jvm.lux index 66dd43019..ce138ca48 100644 --- a/new-luxc/source/luxc/generator/runtime.jvm.lux +++ b/new-luxc/source/luxc/generator/runtime.jvm.lux @@ -54,6 +54,7 @@ (def: #export $Tag $;Type $t;int) (def: #export $Flag $;Type $Object) (def: #export $Datum $;Type $Object) +(def: #export $Function $;Type ($t;class function-class (list))) (def: #export logI $;Inst @@ -66,24 +67,42 @@ $;Method ($t;method (list $t;int $Object $Object) (#;Some $Object-Array) (list))) -(def: variant-makeI +(def: variantI $;Inst ($i;INVOKESTATIC runtime-class "variant_make" variant-method false)) -(def: #export someI +(def: #export leftI + $;Inst + (|>. ($i;int 0) + $i;NULL + $i;DUP2_X1 + $i;POP2 + variantI)) + +(def: #export rightI $;Inst (|>. ($i;int 1) ($i;string "") $i;DUP2_X1 $i;POP2 - variant-makeI)) + variantI)) + +(def: #export someI $;Inst rightI) (def: #export noneI $;Inst (|>. ($i;int 0) $i;NULL ($i;string unit) - variant-makeI)) + variantI)) + +(def: #export partials-field Text "partials") +(def: #export apply-method Text "apply") +(def: #export num-apply-variants Nat +8) + +(def: #export (apply-signature arity) + (-> ls;Arity $;Method) + ($t;method (list;repeat arity $Object) (#;Some $Object) (list))) (def: adt-methods $;Def @@ -372,7 +391,7 @@ ($i;ILOAD +1) $i;ISUB ## Shorten tag ($i;ALOAD +0) flagI ## Get flag ($i;ALOAD +0) datumI ## Get value - variant-makeI ## Build sum + variantI ## Build sum $i;ARETURN) update-tagI (|>. $i;ISUB ($i;ISTORE +1)) update-variantI (|>. ($i;ALOAD +0) datumI ($i;CHECKCAST ($t;descriptor $Variant)) ($i;ASTORE +0)) @@ -447,6 +466,26 @@ $i;ARETURN))) ))) +(def: io-methods + $;Def + (|>. ($d;method #$;Public $;staticM "try" ($t;method (list $Function) (#;Some $Variant) (list)) + (<| $i;with-label (function [@from]) + $i;with-label (function [@to]) + $i;with-label (function [@handler]) + (|>. ($i;try @from @to @handler "java.lang.Throwable") + ($i;label @from) + ($i;ALOAD +0) + $i;NULL + ($i;INVOKEVIRTUAL function-class apply-method (apply-signature +1) false) + rightI + $i;ARETURN + ($i;label @to) + ($i;label @handler) + ($i;INVOKEVIRTUAL "java.lang.Throwable" "getMessage" ($t;method (list) (#;Some $String) (list)) false) + leftI + $i;ARETURN))) + )) + (def: generate-runtime (Meta &common;Bytecode) (do Monad<Meta> @@ -456,18 +495,11 @@ nat-methods frac-methods deg-methods - pm-methods))] + pm-methods + io-methods))] _ (&common;store-class runtime-class bytecode)] (wrap bytecode))) -(def: #export partials-field Text "partials") -(def: #export apply-method Text "apply") -(def: #export num-apply-variants Nat +8) - -(def: #export (apply-signature arity) - (-> ls;Arity $;Method) - ($t;method (list;repeat arity $Object) (#;Some $Object) (list))) - (def: generate-function (Meta &common;Bytecode) (do Monad<Meta> |