From 4433c9bcd6c6cac44c018aad2e21a5b4d7cc4896 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 29 Nov 2017 22:49:56 -0400 Subject: - Adapted main codebase to the latest syntatic changes. --- .../source/luxc/lang/translation/runtime.jvm.lux | 884 ++++++++++----------- 1 file changed, 430 insertions(+), 454 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation/runtime.jvm.lux') diff --git a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux index d2bb1645b..aa210718b 100644 --- a/new-luxc/source/luxc/lang/translation/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/runtime.jvm.lux @@ -1,371 +1,347 @@ -(;module: +(.module: lux (lux (control monad) (data text/format (coll [list "list/" Functor])) [math] - [macro] - [host]) + [macro]) (luxc ["&" lang] - (lang [";L" host] + (lang [".L" host] (host ["$" jvm] (jvm ["$t" type] ["$d" def] ["$i" inst])) ["la" analysis] ["ls" synthesis] - (translation [";T" common])))) + (translation [".T" common])))) -(host;import java.lang.Object) -(host;import java.lang.String) - -(host;import java.lang.reflect.Field - (get [Object] #try Object)) - -(host;import (java.lang.Class a) - (getField [String] Field)) - -(host;import org.objectweb.asm.Opcodes - (#static ACC_PUBLIC int) - (#static ACC_SUPER int) - (#static ACC_FINAL int) - (#static ACC_STATIC int) - (#static V1_6 int)) - -(host;import org.objectweb.asm.ClassWriter - (#static COMPUTE_MAXS int) - (new [int]) - (visit [int int String String String (Array String)] void) - (visitEnd [] void) - (toByteArray [] (Array byte))) - -(def: $Object $;Type ($t;class "java.lang.Object" (list))) -(def: $Object-Array $;Type ($t;array +1 $Object)) -(def: $String $;Type ($t;class "java.lang.String" (list))) -(def: #export $Stack $;Type ($t;array +1 $Object)) -(def: #export $Tuple $;Type $Object-Array) -(def: #export $Variant $;Type $Object-Array) -(def: #export $Tag $;Type $t;int) -(def: #export $Flag $;Type $Object) -(def: #export $Datum $;Type $Object) -(def: #export $Function $;Type ($t;class hostL;function-class (list))) -(def: $Throwable $;Type ($t;class "java.lang.Throwable" (list))) +(def: $Object $.Type ($t.class "java.lang.Object" (list))) +(def: $Object-Array $.Type ($t.array +1 $Object)) +(def: $String $.Type ($t.class "java.lang.String" (list))) +(def: #export $Stack $.Type ($t.array +1 $Object)) +(def: #export $Tuple $.Type $Object-Array) +(def: #export $Variant $.Type $Object-Array) +(def: #export $Tag $.Type $t.int) +(def: #export $Flag $.Type $Object) +(def: #export $Datum $.Type $Object) +(def: #export $Function $.Type ($t.class hostL.function-class (list))) +(def: $Throwable $.Type ($t.class "java.lang.Throwable" (list))) (def: #export logI - $;Inst - (let [outI ($i;GETSTATIC "java.lang.System" "out" ($t;class "java.io.PrintStream" (list))) - printI (function [method] ($i;INVOKEVIRTUAL "java.io.PrintStream" method ($t;method (list $Object) #;None (list)) false))] - (|>. outI ($i;string "LOG: ") (printI "print") - outI $i;SWAP (printI "println")))) + $.Inst + (let [outI ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) + printI (function [method] ($i.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) false))] + (|>> outI ($i.string "LOG: ") (printI "print") + outI $i.SWAP (printI "println")))) (def: variant-method - $;Method - ($t;method (list $t;int $Object $Object) (#;Some $Object-Array) (list))) + $.Method + ($t.method (list $t.int $Object $Object) (#.Some $Object-Array) (list))) (def: variantI - $;Inst - ($i;INVOKESTATIC hostL;runtime-class "variant_make" variant-method false)) + $.Inst + ($i.INVOKESTATIC hostL.runtime-class "variant_make" variant-method false)) (def: #export leftI - $;Inst - (|>. ($i;int 0) - $i;NULL - $i;DUP2_X1 - $i;POP2 + $.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 + $.Inst + (|>> ($i.int 1) + ($i.string "") + $i.DUP2_X1 + $i.POP2 variantI)) -(def: #export someI $;Inst rightI) +(def: #export someI $.Inst rightI) (def: #export noneI - $;Inst - (|>. ($i;int 0) - $i;NULL - ($i;string hostL;unit) + $.Inst + (|>> ($i.int 0) + $i.NULL + ($i.string hostL.unit) variantI)) (def: (try-methodI unsafeI) - (-> $;Inst $;Inst) - (<| $i;with-label (function [@from]) - $i;with-label (function [@to]) - $i;with-label (function [@handler]) - (|>. ($i;try @from @to @handler "java.lang.Exception") - ($i;label @from) + (-> $.Inst $.Inst) + (<| $i.with-label (function [@from]) + $i.with-label (function [@to]) + $i.with-label (function [@handler]) + (|>> ($i.try @from @to @handler "java.lang.Exception") + ($i.label @from) unsafeI someI - $i;ARETURN - ($i;label @to) - ($i;label @handler) + $i.ARETURN + ($i.label @to) + ($i.label @handler) noneI - $i;ARETURN))) + $i.ARETURN))) (def: #export string-concatI - $;Inst - ($i;INVOKEVIRTUAL "java.lang.String" "concat" ($t;method (list $String) (#;Some $String) (list)) false)) + $.Inst + ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) false)) (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))) + (-> ls.Arity $.Method) + ($t.method (list.repeat arity $Object) (#.Some $Object) (list))) (def: adt-methods - $;Def - (let [store-tagI (|>. $i;DUP ($i;int 0) ($i;ILOAD +0) ($i;wrap #$;Int) $i;AASTORE) - store-flagI (|>. $i;DUP ($i;int 1) ($i;ALOAD +1) $i;AASTORE) - store-valueI (|>. $i;DUP ($i;int 2) ($i;ALOAD +2) $i;AASTORE) - force-textMT ($t;method (list $Object) (#;Some $String) (list))] - (|>. ($d;method #$;Public $;staticM "force_text" force-textMT - (<| $i;with-label (function [@is-null]) - $i;with-label (function [@normal-object]) - $i;with-label (function [@array-loop]) - $i;with-label (function [@within-bounds]) - $i;with-label (function [@is-first]) - $i;with-label (function [@elem-end]) - $i;with-label (function [@fold-end]) - (let [on-normal-objectI (|>. ($i;ALOAD +0) - ($i;INVOKEVIRTUAL "java.lang.Object" "toString" ($t;method (list) (#;Some $String) (list)) false)) - on-null-objectI ($i;string "NULL") - arrayI (|>. ($i;ALOAD +0) - ($i;CHECKCAST ($t;descriptor $Object-Array))) - recurseI ($i;INVOKESTATIC hostL;runtime-class "force_text" force-textMT false) - force-elemI (|>. $i;DUP arrayI $i;SWAP $i;AALOAD recurseI) - swap2 (|>. $i;DUP2_X2 ## X,Y => Y,X,Y - $i;POP2 ## Y,X,Y => Y,X + $.Def + (let [store-tagI (|>> $i.DUP ($i.int 0) ($i.ILOAD +0) ($i.wrap #$.Int) $i.AASTORE) + store-flagI (|>> $i.DUP ($i.int 1) ($i.ALOAD +1) $i.AASTORE) + store-valueI (|>> $i.DUP ($i.int 2) ($i.ALOAD +2) $i.AASTORE) + force-textMT ($t.method (list $Object) (#.Some $String) (list))] + (|>> ($d.method #$.Public $.staticM "force_text" force-textMT + (<| $i.with-label (function [@is-null]) + $i.with-label (function [@normal-object]) + $i.with-label (function [@array-loop]) + $i.with-label (function [@within-bounds]) + $i.with-label (function [@is-first]) + $i.with-label (function [@elem-end]) + $i.with-label (function [@fold-end]) + (let [on-normal-objectI (|>> ($i.ALOAD +0) + ($i.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) false)) + on-null-objectI ($i.string "NULL") + arrayI (|>> ($i.ALOAD +0) + ($i.CHECKCAST ($t.descriptor $Object-Array))) + recurseI ($i.INVOKESTATIC hostL.runtime-class "force_text" force-textMT false) + force-elemI (|>> $i.DUP arrayI $i.SWAP $i.AALOAD recurseI) + swap2 (|>> $i.DUP2_X2 ## X,Y => Y,X,Y + $i.POP2 ## Y,X,Y => Y,X ) - add-spacingI (|>. ($i;string ", ") $i;SWAP string-concatI) - merge-with-totalI (|>. $i;DUP_X2 $i;POP ## TSIP => TPSI + add-spacingI (|>> ($i.string ", ") $i.SWAP string-concatI) + merge-with-totalI (|>> $i.DUP_X2 $i.POP ## TSIP => TPSI swap2 ## TPSI => SITP string-concatI ## SITP => SIT - $i;DUP_X2 $i;POP ## SIT => TSI + $i.DUP_X2 $i.POP ## SIT => TSI ) - foldI (|>. $i;DUP ## TSI => TSII - ($i;IFEQ @is-first) ## TSI - force-elemI add-spacingI merge-with-totalI ($i;GOTO @elem-end) - ($i;label @is-first) ## TSI + foldI (|>> $i.DUP ## TSI => TSII + ($i.IFEQ @is-first) ## TSI + force-elemI add-spacingI merge-with-totalI ($i.GOTO @elem-end) + ($i.label @is-first) ## TSI force-elemI merge-with-totalI - ($i;label @elem-end) ## TSI + ($i.label @elem-end) ## TSI ) - inc-idxI (|>. ($i;int 1) $i;IADD) - on-array-objectI (|>. ($i;string "[") ## T - arrayI $i;ARRAYLENGTH ## TS - ($i;int 0) ## TSI - ($i;label @array-loop) ## TSI - $i;DUP2 - ($i;IF_ICMPGT @within-bounds) ## TSI - $i;POP2 ($i;string "]") string-concatI ($i;GOTO @fold-end) - ($i;label @within-bounds) - foldI inc-idxI ($i;GOTO @array-loop) - ($i;label @fold-end))]) - (|>. ($i;ALOAD +0) - ($i;IFNULL @is-null) - ($i;ALOAD +0) - ($i;INSTANCEOF ($t;descriptor $Object-Array)) - ($i;IFEQ @normal-object) - on-array-objectI $i;ARETURN - ($i;label @normal-object) on-normal-objectI $i;ARETURN - ($i;label @is-null) on-null-objectI $i;ARETURN))) - ($d;method #$;Public $;staticM "variant_make" - ($t;method (list $t;int $Object $Object) - (#;Some $Variant) + inc-idxI (|>> ($i.int 1) $i.IADD) + on-array-objectI (|>> ($i.string "[") ## T + arrayI $i.ARRAYLENGTH ## TS + ($i.int 0) ## TSI + ($i.label @array-loop) ## TSI + $i.DUP2 + ($i.IF_ICMPGT @within-bounds) ## TSI + $i.POP2 ($i.string "]") string-concatI ($i.GOTO @fold-end) + ($i.label @within-bounds) + foldI inc-idxI ($i.GOTO @array-loop) + ($i.label @fold-end))]) + (|>> ($i.ALOAD +0) + ($i.IFNULL @is-null) + ($i.ALOAD +0) + ($i.INSTANCEOF ($t.descriptor $Object-Array)) + ($i.IFEQ @normal-object) + on-array-objectI $i.ARETURN + ($i.label @normal-object) on-normal-objectI $i.ARETURN + ($i.label @is-null) on-null-objectI $i.ARETURN))) + ($d.method #$.Public $.staticM "variant_make" + ($t.method (list $t.int $Object $Object) + (#.Some $Variant) (list)) - (|>. ($i;int 3) - ($i;array $Object) + (|>> ($i.int 3) + ($i.array $Object) store-tagI store-flagI store-valueI - $i;ARETURN))))) + $i.ARETURN))))) (def: #export force-textI - $;Inst - ($i;INVOKESTATIC hostL;runtime-class "force_text" ($t;method (list $Object) (#;Some $String) (list)) false)) + $.Inst + ($i.INVOKESTATIC hostL.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) false)) (def: nat-methods - $;Def - (let [compare-nat-method ($t;method (list $t;long $t;long) (#;Some $t;int) (list)) - less-thanI (function [@where] (|>. ($i;INVOKESTATIC hostL;runtime-class "compare_nat" compare-nat-method false) ($i;IFLT @where))) - $BigInteger ($t;class "java.math.BigInteger" (list)) - upcast-method ($t;method (list $t;long) (#;Some $BigInteger) (list)) - div-method ($t;method (list $t;long $t;long) (#;Some $t;long) (list)) - upcastI ($i;INVOKESTATIC hostL;runtime-class "_toUnsignedBigInteger" upcast-method false) - downcastI ($i;INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t;method (list) (#;Some $t;long) (list)) false)] - (|>. ($d;method #$;Public $;staticM "_toUnsignedBigInteger" upcast-method - (let [upcastI ($i;INVOKESTATIC "java.math.BigInteger" "valueOf" upcast-method false) - discernI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFGE @where))) - prepare-upperI (|>. ($i;LLOAD +0) ($i;int 32) $i;LUSHR + $.Def + (let [compare-nat-method ($t.method (list $t.long $t.long) (#.Some $t.int) (list)) + less-thanI (function [@where] (|>> ($i.INVOKESTATIC hostL.runtime-class "compare_nat" compare-nat-method false) ($i.IFLT @where))) + $BigInteger ($t.class "java.math.BigInteger" (list)) + upcast-method ($t.method (list $t.long) (#.Some $BigInteger) (list)) + div-method ($t.method (list $t.long $t.long) (#.Some $t.long) (list)) + upcastI ($i.INVOKESTATIC hostL.runtime-class "_toUnsignedBigInteger" upcast-method false) + downcastI ($i.INVOKEVIRTUAL "java.math.BigInteger" "longValue" ($t.method (list) (#.Some $t.long) (list)) false)] + (|>> ($d.method #$.Public $.staticM "_toUnsignedBigInteger" upcast-method + (let [upcastI ($i.INVOKESTATIC "java.math.BigInteger" "valueOf" upcast-method false) + discernI (function [@where] (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGE @where))) + prepare-upperI (|>> ($i.LLOAD +0) ($i.int 32) $i.LUSHR upcastI - ($i;int 32) ($i;INVOKEVIRTUAL "java.math.BigInteger" "shiftLeft" ($t;method (list $t;int) (#;Some $BigInteger) (list)) false)) - prepare-lowerI (|>. ($i;LLOAD +0) ($i;int 32) $i;LSHL - ($i;int 32) $i;LUSHR + ($i.int 32) ($i.INVOKEVIRTUAL "java.math.BigInteger" "shiftLeft" ($t.method (list $t.int) (#.Some $BigInteger) (list)) false)) + prepare-lowerI (|>> ($i.LLOAD +0) ($i.int 32) $i.LSHL + ($i.int 32) $i.LUSHR upcastI)] - (<| $i;with-label (function [@simple]) - (|>. (discernI @simple) + (<| $i.with-label (function [@simple]) + (|>> (discernI @simple) ## else prepare-upperI prepare-lowerI - ($i;INVOKEVIRTUAL "java.math.BigInteger" "add" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false) - $i;ARETURN + ($i.INVOKEVIRTUAL "java.math.BigInteger" "add" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false) + $i.ARETURN ## then - ($i;label @simple) - ($i;LLOAD +0) + ($i.label @simple) + ($i.LLOAD +0) upcastI - $i;ARETURN)))) - ($d;method #$;Public $;staticM "compare_nat" compare-nat-method - (let [shiftI (|>. ($i;GETSTATIC "java.lang.Long" "MIN_VALUE" $t;long) $i;LADD)] - (|>. ($i;LLOAD +0) shiftI - ($i;LLOAD +2) shiftI - $i;LCMP - $i;IRETURN))) - ($d;method #$;Public $;staticM "div_nat" div-method - (let [is-param-largeI (function [@where] (|>. ($i;LLOAD +2) ($i;long 0) $i;LCMP ($i;IFLT @where))) - is-subject-smallI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFGT @where))) - small-division (|>. ($i;LLOAD +0) ($i;LLOAD +2) $i;LDIV $i;LRETURN) - big-divisionI ($i;INVOKEVIRTUAL "java.math.BigInteger" "divide" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)] - (<| $i;with-label (function [@is-zero]) - $i;with-label (function [@param-is-large]) - $i;with-label (function [@subject-is-small]) - (|>. (is-param-largeI @param-is-large) + $i.ARETURN)))) + ($d.method #$.Public $.staticM "compare_nat" compare-nat-method + (let [shiftI (|>> ($i.GETSTATIC "java.lang.Long" "MIN_VALUE" $t.long) $i.LADD)] + (|>> ($i.LLOAD +0) shiftI + ($i.LLOAD +2) shiftI + $i.LCMP + $i.IRETURN))) + ($d.method #$.Public $.staticM "div_nat" div-method + (let [is-param-largeI (function [@where] (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLT @where))) + is-subject-smallI (function [@where] (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFGT @where))) + small-division (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LDIV $i.LRETURN) + big-divisionI ($i.INVOKEVIRTUAL "java.math.BigInteger" "divide" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)] + (<| $i.with-label (function [@is-zero]) + $i.with-label (function [@param-is-large]) + $i.with-label (function [@subject-is-small]) + (|>> (is-param-largeI @param-is-large) ## Param is not too large (is-subject-smallI @subject-is-small) ## Param is small, but subject is large - ($i;LLOAD +0) upcastI - ($i;LLOAD +2) upcastI - big-divisionI downcastI $i;LRETURN + ($i.LLOAD +0) upcastI + ($i.LLOAD +2) upcastI + big-divisionI downcastI $i.LRETURN ## Both param and subject are small, ## and can thus be divided normally. - ($i;label @subject-is-small) + ($i.label @subject-is-small) small-division ## Param is too large. Cannot simply divide. ## Depending on the result of the ## comparison, a result will be determined. - ($i;label @param-is-large) - ($i;LLOAD +0) ($i;LLOAD +2) (less-thanI @is-zero) + ($i.label @param-is-large) + ($i.LLOAD +0) ($i.LLOAD +2) (less-thanI @is-zero) ## Greater-than or equals - ($i;long 1) $i;LRETURN + ($i.long 1) $i.LRETURN ## Less than - ($i;label @is-zero) - ($i;long 0) $i;LRETURN)))) - ($d;method #$;Public $;staticM "rem_nat" div-method - (let [is-subject-largeI (function [@where] (|>. ($i;LLOAD +0) ($i;long 0) $i;LCMP ($i;IFLE @where))) - is-param-largeI (function [@where] (|>. ($i;LLOAD +2) ($i;long 0) $i;LCMP ($i;IFLE @where))) - small-remainderI (|>. ($i;LLOAD +0) ($i;LLOAD +2) $i;LREM $i;LRETURN) - big-remainderI ($i;INVOKEVIRTUAL "java.math.BigInteger" "remainder" ($t;method (list $BigInteger) (#;Some $BigInteger) (list)) false)] - (<| $i;with-label (function [@large-number]) - $i;with-label (function [@subject-is-smaller-than-param]) - (|>. (is-subject-largeI @large-number) + ($i.label @is-zero) + ($i.long 0) $i.LRETURN)))) + ($d.method #$.Public $.staticM "rem_nat" div-method + (let [is-subject-largeI (function [@where] (|>> ($i.LLOAD +0) ($i.long 0) $i.LCMP ($i.IFLE @where))) + is-param-largeI (function [@where] (|>> ($i.LLOAD +2) ($i.long 0) $i.LCMP ($i.IFLE @where))) + small-remainderI (|>> ($i.LLOAD +0) ($i.LLOAD +2) $i.LREM $i.LRETURN) + big-remainderI ($i.INVOKEVIRTUAL "java.math.BigInteger" "remainder" ($t.method (list $BigInteger) (#.Some $BigInteger) (list)) false)] + (<| $i.with-label (function [@large-number]) + $i.with-label (function [@subject-is-smaller-than-param]) + (|>> (is-subject-largeI @large-number) (is-param-largeI @large-number) small-remainderI - ($i;label @large-number) - ($i;LLOAD +0) ($i;LLOAD +2) (less-thanI @subject-is-smaller-than-param) + ($i.label @large-number) + ($i.LLOAD +0) ($i.LLOAD +2) (less-thanI @subject-is-smaller-than-param) - ($i;LLOAD +0) upcastI - ($i;LLOAD +2) upcastI - big-remainderI downcastI $i;LRETURN + ($i.LLOAD +0) upcastI + ($i.LLOAD +2) upcastI + big-remainderI downcastI $i.LRETURN - ($i;label @subject-is-smaller-than-param) - ($i;LLOAD +0) - $i;LRETURN)))) + ($i.label @subject-is-smaller-than-param) + ($i.LLOAD +0) + $i.LRETURN)))) ))) -(def: frac-shiftI $;Inst ($i;double (math;pow 32.0 2.0))) +(def: frac-shiftI $.Inst ($i.double (math.pow 32.0 2.0))) (def: frac-methods - $;Def - (|>. ($d;method #$;Public $;staticM "decode_frac" ($t;method (list $String) (#;Some $Object-Array) (list)) + $.Def + (|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) (try-methodI - (|>. ($i;ALOAD +0) - ($i;INVOKESTATIC "java.lang.Double" "parseDouble" ($t;method (list $String) (#;Some $t;double) (list)) false) - ($i;wrap #$;Double)))) - ($d;method #$;Public $;staticM "frac_to_deg" ($t;method (list $t;double) (#;Some $t;long) (list)) - (let [swap2 (|>. $i;DUP2_X2 $i;POP2) - drop-excessI (|>. ($i;double 1.0) $i;DREM) - shiftI (|>. frac-shiftI $i;DMUL)] - (|>. ($i;DLOAD +0) + (|>> ($i.ALOAD +0) + ($i.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) false) + ($i.wrap #$.Double)))) + ($d.method #$.Public $.staticM "frac_to_deg" ($t.method (list $t.double) (#.Some $t.long) (list)) + (let [swap2 (|>> $i.DUP2_X2 $i.POP2) + drop-excessI (|>> ($i.double 1.0) $i.DREM) + shiftI (|>> frac-shiftI $i.DMUL)] + (|>> ($i.DLOAD +0) ## Get upper half drop-excessI shiftI ## Make a copy, so the lower half can be extracted - $i;DUP2 + $i.DUP2 ## Get lower half drop-excessI shiftI ## Turn it into a deg - $i;D2L + $i.D2L ## Turn the upper half into deg too swap2 - $i;D2L + $i.D2L ## Combine both pieces - $i;LADD + $i.LADD ## FINISH - $i;LRETURN + $i.LRETURN ))) )) (def: deg-bits Nat +64) -(def: deg-method $;Method ($t;method (list $t;long $t;long) (#;Some $t;long) (list))) -(def: clz-method $;Method ($t;method (list $t;long) (#;Some $t;int) (list))) +(def: deg-method $.Method ($t.method (list $t.long $t.long) (#.Some $t.long) (list))) +(def: clz-method $.Method ($t.method (list $t.long) (#.Some $t.int) (list))) (def: deg-methods - $;Def + $.Def (let [## "And" mask corresponding to -1 (FFFF...), on the low 32 bits. - low-half (|>. ($i;int -1) $i;I2L $i;LAND) - high-half (|>. ($i;int 32) $i;LUSHR)] - (|>. ($d;method #$;Public $;staticM "mul_deg" deg-method + low-half (|>> ($i.int -1) $i.I2L $i.LAND) + high-half (|>> ($i.int 32) $i.LUSHR)] + (|>> ($d.method #$.Public $.staticM "mul_deg" deg-method ## Based on: http://stackoverflow.com/a/31629280/6823464 - (let [shift-downI (|>. ($i;int 32) $i;LUSHR) - low-leftI (|>. ($i;LLOAD +0) low-half) - high-leftI (|>. ($i;LLOAD +0) high-half) - low-rightI (|>. ($i;LLOAD +2) low-half) - high-rightI (|>. ($i;LLOAD +2) high-half) - bottomI (|>. low-leftI low-rightI $i;LMUL) - middleLI (|>. high-leftI low-rightI $i;LMUL) - middleRI (|>. low-leftI high-rightI $i;LMUL) - middleI (|>. middleLI middleRI $i;LADD) - topI (|>. high-leftI high-rightI $i;LMUL)] - (|>. bottomI shift-downI - middleI $i;LADD shift-downI - topI $i;LADD - $i;LRETURN))) - ($d;method #$;Public $;staticM "count_leading_zeros" clz-method - (let [when-zeroI (function [@where] (|>. ($i;long 0) $i;LCMP ($i;IFEQ @where))) - shift-rightI (function [amount] (|>. ($i;int amount) $i;LUSHR)) - decI (|>. ($i;int 1) $i;ISUB)] - (<| $i;with-label (function [@start]) - $i;with-label (function [@done]) - (|>. ($i;int 64) - ($i;label @start) - ($i;LLOAD +0) (when-zeroI @done) - ($i;LLOAD +0) (shift-rightI 1) ($i;LSTORE +0) + (let [shift-downI (|>> ($i.int 32) $i.LUSHR) + low-leftI (|>> ($i.LLOAD +0) low-half) + high-leftI (|>> ($i.LLOAD +0) high-half) + low-rightI (|>> ($i.LLOAD +2) low-half) + high-rightI (|>> ($i.LLOAD +2) high-half) + bottomI (|>> low-leftI low-rightI $i.LMUL) + middleLI (|>> high-leftI low-rightI $i.LMUL) + middleRI (|>> low-leftI high-rightI $i.LMUL) + middleI (|>> middleLI middleRI $i.LADD) + topI (|>> high-leftI high-rightI $i.LMUL)] + (|>> bottomI shift-downI + middleI $i.LADD shift-downI + topI $i.LADD + $i.LRETURN))) + ($d.method #$.Public $.staticM "count_leading_zeros" clz-method + (let [when-zeroI (function [@where] (|>> ($i.long 0) $i.LCMP ($i.IFEQ @where))) + shift-rightI (function [amount] (|>> ($i.int amount) $i.LUSHR)) + decI (|>> ($i.int 1) $i.ISUB)] + (<| $i.with-label (function [@start]) + $i.with-label (function [@done]) + (|>> ($i.int 64) + ($i.label @start) + ($i.LLOAD +0) (when-zeroI @done) + ($i.LLOAD +0) (shift-rightI 1) ($i.LSTORE +0) decI - ($i;GOTO @start) - ($i;label @done) - $i;IRETURN)))) - ($d;method #$;Public $;staticM "div_deg" deg-method - (<| $i;with-label (function [@same]) - (let [subjectI ($i;LLOAD +0) - paramI ($i;LLOAD +2) - equal?I (function [@where] (|>. $i;LCMP ($i;IFEQ @where))) - count-leading-zerosI ($i;INVOKESTATIC hostL;runtime-class "count_leading_zeros" clz-method false) - calc-max-shiftI (|>. subjectI count-leading-zerosI + ($i.GOTO @start) + ($i.label @done) + $i.IRETURN)))) + ($d.method #$.Public $.staticM "div_deg" deg-method + (<| $i.with-label (function [@same]) + (let [subjectI ($i.LLOAD +0) + paramI ($i.LLOAD +2) + equal?I (function [@where] (|>> $i.LCMP ($i.IFEQ @where))) + count-leading-zerosI ($i.INVOKESTATIC hostL.runtime-class "count_leading_zeros" clz-method false) + calc-max-shiftI (|>> subjectI count-leading-zerosI paramI count-leading-zerosI - ($i;INVOKESTATIC "java.lang.Math" "min" ($t;method (list $t;int $t;int) (#;Some $t;int) (list)) false) - ($i;ISTORE +4)) - shiftI (|>. ($i;ILOAD +4) $i;LSHL) - imprecise-divisionI (|>. subjectI shiftI + ($i.INVOKESTATIC "java.lang.Math" "min" ($t.method (list $t.int $t.int) (#.Some $t.int) (list)) false) + ($i.ISTORE +4)) + shiftI (|>> ($i.ILOAD +4) $i.LSHL) + imprecise-divisionI (|>> subjectI shiftI paramI shiftI high-half - $i;LDIV) - scale-downI (|>. ($i;int 32) $i;LSHL)] - (|>. subjectI paramI + $i.LDIV) + scale-downI (|>> ($i.int 32) $i.LSHL)] + (|>> subjectI paramI (equal?I @same) ## Based on: http://stackoverflow.com/a/8510587/6823464 ## Shifting the operands as much as possible can help @@ -373,255 +349,255 @@ calc-max-shiftI imprecise-divisionI scale-downI - $i;LRETURN - ($i;label @same) - ($i;long -1) ## ~= 1.0 Degrees - $i;LRETURN)))) - ($d;method #$;Public $;staticM "deg_to_frac" ($t;method (list $t;long) (#;Some $t;double) (list)) - (let [highI (|>. ($i;LLOAD +0) high-half $i;L2D) - lowI (|>. ($i;LLOAD +0) low-half $i;L2D) - scaleI (|>. frac-shiftI $i;DDIV)] - (|>. highI scaleI + $i.LRETURN + ($i.label @same) + ($i.long -1) ## ~= 1.0 Degrees + $i.LRETURN)))) + ($d.method #$.Public $.staticM "deg_to_frac" ($t.method (list $t.long) (#.Some $t.double) (list)) + (let [highI (|>> ($i.LLOAD +0) high-half $i.L2D) + lowI (|>> ($i.LLOAD +0) low-half $i.L2D) + scaleI (|>> frac-shiftI $i.DDIV)] + (|>> highI scaleI lowI scaleI scaleI - $i;DADD - $i;DRETURN))) + $i.DADD + $i.DRETURN))) ))) (def: text-methods - $;Def - (|>. ($d;method #$;Public $;staticM "text_clip" ($t;method (list $String $t;int $t;int) (#;Some $Variant) (list)) + $.Def + (|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) (try-methodI - (|>. ($i;ALOAD +0) - ($i;ILOAD +1) - ($i;ILOAD +2) - ($i;INVOKEVIRTUAL "java.lang.String" "substring" ($t;method (list $t;int $t;int) (#;Some $String) (list)) false)))) - ($d;method #$;Public $;staticM "text_char" ($t;method (list $String $t;int) (#;Some $Variant) (list)) + (|>> ($i.ALOAD +0) + ($i.ILOAD +1) + ($i.ILOAD +2) + ($i.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) false)))) + ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) (try-methodI - (|>. ($i;ALOAD +0) - ($i;ILOAD +1) - ($i;INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t;method (list $t;int) (#;Some $t;int) (list)) false) - $i;I2L - ($i;wrap #$;Long)))) + (|>> ($i.ALOAD +0) + ($i.ILOAD +1) + ($i.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) false) + $i.I2L + ($i.wrap #$.Long)))) )) (def: pm-methods - $;Def - (let [tuple-sizeI (|>. ($i;ALOAD +0) $i;ARRAYLENGTH) - tuple-elemI (|>. ($i;ALOAD +0) ($i;ILOAD +1) $i;AALOAD) - expected-last-sizeI (|>. ($i;ILOAD +1) ($i;int 1) $i;IADD) - tuple-tailI (|>. ($i;ALOAD +0) tuple-sizeI ($i;int 1) $i;ISUB $i;AALOAD ($i;CHECKCAST ($t;descriptor $Tuple)))] - (|>. ($d;method #$;Public $;staticM "pm_fail" ($t;method (list) #;None (list)) - (|>. ($i;NEW "java.lang.IllegalStateException") - $i;DUP - ($i;string "Invalid expression for pattern-matching.") - ($i;INVOKESPECIAL "java.lang.IllegalStateException" "" ($t;method (list $String) #;None (list)) false) - $i;ATHROW)) - ($d;method #$;Public $;staticM "apply_fail" ($t;method (list) #;None (list)) - (|>. ($i;NEW "java.lang.IllegalStateException") - $i;DUP - ($i;string "Error while applying function.") - ($i;INVOKESPECIAL "java.lang.IllegalStateException" "" ($t;method (list $String) #;None (list)) false) - $i;ATHROW)) - ($d;method #$;Public $;staticM "pm_push" ($t;method (list $Stack $Object) (#;Some $Stack) (list)) - (|>. ($i;int 2) - ($i;ANEWARRAY "java.lang.Object") - $i;DUP - ($i;int 0) - ($i;ALOAD +0) - $i;AASTORE - $i;DUP - ($i;int 1) - ($i;ALOAD +1) - $i;AASTORE - $i;ARETURN)) - ($d;method #$;Public $;staticM "pm_pop" ($t;method (list $Stack) (#;Some $Stack) (list)) - (|>. ($i;ALOAD +0) - ($i;int 0) - $i;AALOAD - ($i;CHECKCAST ($t;descriptor $Stack)) - $i;ARETURN)) - ($d;method #$;Public $;staticM "pm_peek" ($t;method (list $Stack) (#;Some $Object) (list)) - (|>. ($i;ALOAD +0) - ($i;int 1) - $i;AALOAD - $i;ARETURN)) - ($d;method #$;Public $;staticM "pm_variant" ($t;method (list $Variant $Tag $Flag) (#;Some $Object) (list)) - (<| $i;with-label (function [@begin]) - $i;with-label (function [@just-return]) - $i;with-label (function [@then]) - $i;with-label (function [@further]) - $i;with-label (function [@shorten]) - $i;with-label (function [@wrong]) - (let [variant-partI (: (-> Nat $;Inst) + $.Def + (let [tuple-sizeI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH) + tuple-elemI (|>> ($i.ALOAD +0) ($i.ILOAD +1) $i.AALOAD) + expected-last-sizeI (|>> ($i.ILOAD +1) ($i.int 1) $i.IADD) + tuple-tailI (|>> ($i.ALOAD +0) tuple-sizeI ($i.int 1) $i.ISUB $i.AALOAD ($i.CHECKCAST ($t.descriptor $Tuple)))] + (|>> ($d.method #$.Public $.staticM "pm_fail" ($t.method (list) #.None (list)) + (|>> ($i.NEW "java.lang.IllegalStateException") + $i.DUP + ($i.string "Invalid expression for pattern-matching.") + ($i.INVOKESPECIAL "java.lang.IllegalStateException" "" ($t.method (list $String) #.None (list)) false) + $i.ATHROW)) + ($d.method #$.Public $.staticM "apply_fail" ($t.method (list) #.None (list)) + (|>> ($i.NEW "java.lang.IllegalStateException") + $i.DUP + ($i.string "Error while applying function.") + ($i.INVOKESPECIAL "java.lang.IllegalStateException" "" ($t.method (list $String) #.None (list)) false) + $i.ATHROW)) + ($d.method #$.Public $.staticM "pm_push" ($t.method (list $Stack $Object) (#.Some $Stack) (list)) + (|>> ($i.int 2) + ($i.ANEWARRAY "java.lang.Object") + $i.DUP + ($i.int 0) + ($i.ALOAD +0) + $i.AASTORE + $i.DUP + ($i.int 1) + ($i.ALOAD +1) + $i.AASTORE + $i.ARETURN)) + ($d.method #$.Public $.staticM "pm_pop" ($t.method (list $Stack) (#.Some $Stack) (list)) + (|>> ($i.ALOAD +0) + ($i.int 0) + $i.AALOAD + ($i.CHECKCAST ($t.descriptor $Stack)) + $i.ARETURN)) + ($d.method #$.Public $.staticM "pm_peek" ($t.method (list $Stack) (#.Some $Object) (list)) + (|>> ($i.ALOAD +0) + ($i.int 1) + $i.AALOAD + $i.ARETURN)) + ($d.method #$.Public $.staticM "pm_variant" ($t.method (list $Variant $Tag $Flag) (#.Some $Object) (list)) + (<| $i.with-label (function [@begin]) + $i.with-label (function [@just-return]) + $i.with-label (function [@then]) + $i.with-label (function [@further]) + $i.with-label (function [@shorten]) + $i.with-label (function [@wrong]) + (let [variant-partI (: (-> Nat $.Inst) (function [idx] - (|>. ($i;int (nat-to-int idx)) $i;AALOAD))) - tagI (: $;Inst - (|>. (variant-partI +0) ($i;unwrap #$;Int))) + (|>> ($i.int (nat-to-int idx)) $i.AALOAD))) + tagI (: $.Inst + (|>> (variant-partI +0) ($i.unwrap #$.Int))) flagI (variant-partI +1) datumI (variant-partI +2) - shortenI (|>. ($i;ALOAD +0) tagI ## Get tag - ($i;ILOAD +1) $i;ISUB ## Shorten tag - ($i;ALOAD +0) flagI ## Get flag - ($i;ALOAD +0) datumI ## Get value + shortenI (|>> ($i.ALOAD +0) tagI ## Get tag + ($i.ILOAD +1) $i.ISUB ## Shorten tag + ($i.ALOAD +0) flagI ## Get flag + ($i.ALOAD +0) datumI ## Get value 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)) - failureI (|>. $i;NULL $i;ARETURN) - return-datumI (|>. ($i;ALOAD +0) datumI $i;ARETURN)]) - (|>. ($i;label @begin) - ($i;ILOAD +1) ## tag - ($i;ALOAD +0) tagI ## tag, sumT - $i;DUP2 ($i;IF_ICMPEQ @then) - $i;DUP2 ($i;IF_ICMPGT @further) - $i;DUP2 ($i;IF_ICMPLT @shorten) - ## $i;POP2 + $i.ARETURN) + update-tagI (|>> $i.ISUB ($i.ISTORE +1)) + update-variantI (|>> ($i.ALOAD +0) datumI ($i.CHECKCAST ($t.descriptor $Variant)) ($i.ASTORE +0)) + failureI (|>> $i.NULL $i.ARETURN) + return-datumI (|>> ($i.ALOAD +0) datumI $i.ARETURN)]) + (|>> ($i.label @begin) + ($i.ILOAD +1) ## tag + ($i.ALOAD +0) tagI ## tag, sumT + $i.DUP2 ($i.IF_ICMPEQ @then) + $i.DUP2 ($i.IF_ICMPGT @further) + $i.DUP2 ($i.IF_ICMPLT @shorten) + ## $i.POP2 failureI - ($i;label @then) ## tag, sumT - ($i;ALOAD +2) ## tag, sumT, wants-last? - ($i;ALOAD +0) flagI ## tag, sumT, wants-last?, is-last? - ($i;IF_ACMPEQ @just-return) ## tag, sumT - ($i;label @further) ## tag, sumT - ($i;ALOAD +0) flagI ## tag, sumT, last? - ($i;IFNULL @wrong) ## tag, sumT + ($i.label @then) ## tag, sumT + ($i.ALOAD +2) ## tag, sumT, wants-last? + ($i.ALOAD +0) flagI ## tag, sumT, wants-last?, is-last? + ($i.IF_ACMPEQ @just-return) ## tag, sumT + ($i.label @further) ## tag, sumT + ($i.ALOAD +0) flagI ## tag, sumT, last? + ($i.IFNULL @wrong) ## tag, sumT update-tagI update-variantI - ($i;GOTO @begin) - ($i;label @just-return) ## tag, sumT - ## $i;POP2 + ($i.GOTO @begin) + ($i.label @just-return) ## tag, sumT + ## $i.POP2 return-datumI - ($i;label @shorten) ## tag, sumT - ($i;ALOAD +2) ($i;IFNULL @wrong) - ## $i;POP2 + ($i.label @shorten) ## tag, sumT + ($i.ALOAD +2) ($i.IFNULL @wrong) + ## $i.POP2 shortenI - ($i;label @wrong) ## tag, sumT - ## $i;POP2 + ($i.label @wrong) ## tag, sumT + ## $i.POP2 failureI))) - ($d;method #$;Public $;staticM "pm_left" ($t;method (list $Tuple $t;int) (#;Some $Object) (list)) - (<| $i;with-label (function [@begin]) - $i;with-label (function [@not-recursive]) - (let [updated-idxI (|>. $i;SWAP $i;ISUB)]) - (|>. ($i;label @begin) + ($d.method #$.Public $.staticM "pm_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) + (<| $i.with-label (function [@begin]) + $i.with-label (function [@not-recursive]) + (let [updated-idxI (|>> $i.SWAP $i.ISUB)]) + (|>> ($i.label @begin) tuple-sizeI expected-last-sizeI - $i;DUP2 ($i;IF_ICMPGT @not-recursive) + $i.DUP2 ($i.IF_ICMPGT @not-recursive) ## Recursive - updated-idxI ($i;ISTORE +1) - tuple-tailI ($i;ASTORE +0) - ($i;GOTO @begin) - ($i;label @not-recursive) - ## $i;POP2 + updated-idxI ($i.ISTORE +1) + tuple-tailI ($i.ASTORE +0) + ($i.GOTO @begin) + ($i.label @not-recursive) + ## $i.POP2 tuple-elemI - $i;ARETURN))) - ($d;method #$;Public $;staticM "pm_right" ($t;method (list $Tuple $t;int) (#;Some $Object) (list)) - (<| $i;with-label (function [@begin]) - $i;with-label (function [@tail]) - $i;with-label (function [@slice]) - (let [updated-idxI (|>. ($i;ILOAD +1) ($i;int 1) $i;IADD tuple-sizeI $i;ISUB) - sliceI (|>. ($i;ALOAD +0) ($i;ILOAD +1) tuple-sizeI - ($i;INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t;method (list $Object-Array $t;int $t;int) (#;Some $Object-Array) (list)) false))]) - (|>. ($i;label @begin) + $i.ARETURN))) + ($d.method #$.Public $.staticM "pm_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) + (<| $i.with-label (function [@begin]) + $i.with-label (function [@tail]) + $i.with-label (function [@slice]) + (let [updated-idxI (|>> ($i.ILOAD +1) ($i.int 1) $i.IADD tuple-sizeI $i.ISUB) + sliceI (|>> ($i.ALOAD +0) ($i.ILOAD +1) tuple-sizeI + ($i.INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t.method (list $Object-Array $t.int $t.int) (#.Some $Object-Array) (list)) false))]) + (|>> ($i.label @begin) tuple-sizeI expected-last-sizeI - $i;DUP2 ($i;IF_ICMPEQ @tail) - ($i;IF_ICMPGT @slice) + $i.DUP2 ($i.IF_ICMPEQ @tail) + ($i.IF_ICMPGT @slice) ## Must recurse - tuple-tailI ($i;ASTORE +0) - updated-idxI ($i;ISTORE +1) - ($i;GOTO @begin) - ($i;label @slice) + tuple-tailI ($i.ASTORE +0) + updated-idxI ($i.ISTORE +1) + ($i.GOTO @begin) + ($i.label @slice) sliceI - $i;ARETURN - ($i;label @tail) - ## $i;POP2 + $i.ARETURN + ($i.label @tail) + ## $i.POP2 tuple-elemI - $i;ARETURN))) + $i.ARETURN))) ))) (def: io-methods - $;Def - (let [string-writerI (|>. ($i;NEW "java.io.StringWriter") - $i;DUP - ($i;INVOKESPECIAL "java.io.StringWriter" "" ($t;method (list) #;None (list)) false)) - print-writerI (|>. ($i;NEW "java.io.PrintWriter") - $i;SWAP - $i;DUP2 - $i;POP - $i;SWAP - ($i;boolean true) - ($i;INVOKESPECIAL "java.io.PrintWriter" "" ($t;method (list ($t;class "java.io.Writer" (list)) $t;boolean) #;None (list)) false) + $.Def + (let [string-writerI (|>> ($i.NEW "java.io.StringWriter") + $i.DUP + ($i.INVOKESPECIAL "java.io.StringWriter" "" ($t.method (list) #.None (list)) false)) + print-writerI (|>> ($i.NEW "java.io.PrintWriter") + $i.SWAP + $i.DUP2 + $i.POP + $i.SWAP + ($i.boolean true) + ($i.INVOKESPECIAL "java.io.PrintWriter" "" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) false) )] - (|>. ($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 hostL;function-class apply-method (apply-signature +1) false) + (|>> ($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 hostL.function-class apply-method (apply-signature +1) false) rightI - $i;ARETURN - ($i;label @to) - ($i;label @handler) + $i.ARETURN + ($i.label @to) + ($i.label @handler) string-writerI ## TW - $i;DUP2 ## TWTW + $i.DUP2 ## TWTW print-writerI ## TWTP - ($i;INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t;method (list ($t;class "java.io.PrintWriter" (list))) #;None (list)) false) ## TW - ($i;INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t;method (list) (#;Some $String) (list)) false) ## TS - $i;SWAP $i;POP leftI - $i;ARETURN))) + ($i.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) false) ## TW + ($i.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) false) ## TS + $i.SWAP $i.POP leftI + $i.ARETURN))) ))) (def: translate-runtime - (Meta commonT;Bytecode) - (do macro;Monad + (Meta commonT.Bytecode) + (do macro.Monad [_ (wrap []) - #let [bytecode ($d;class #$;V1.6 #$;Public $;finalC hostL;runtime-class (list) ["java.lang.Object" (list)] (list) - (|>. adt-methods + #let [bytecode ($d.class #$.V1_6 #$.Public $.finalC hostL.runtime-class (list) ["java.lang.Object" (list)] (list) + (|>> adt-methods nat-methods frac-methods deg-methods text-methods pm-methods io-methods))] - _ (commonT;store-class hostL;runtime-class bytecode)] + _ (commonT.store-class hostL.runtime-class bytecode)] (wrap bytecode))) (def: translate-function - (Meta commonT;Bytecode) - (do macro;Monad + (Meta commonT.Bytecode) + (do macro.Monad [_ (wrap []) - #let [applyI (|> (list;n.range +2 num-apply-variants) + #let [applyI (|> (list.n/range +2 num-apply-variants) (list/map (function [arity] - ($d;method #$;Public $;noneM apply-method (apply-signature arity) - (let [preI (|> (list;n.range +0 (n.dec arity)) - (list/map $i;ALOAD) - $i;fuse)] - (|>. preI - ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature (n.dec arity)) false) - ($i;CHECKCAST hostL;function-class) - ($i;ALOAD arity) - ($i;INVOKEVIRTUAL hostL;function-class apply-method (apply-signature +1) false) - $i;ARETURN))))) - (list& ($d;abstract-method #$;Public $;noneM apply-method (apply-signature +1))) - $d;fuse) - bytecode ($d;abstract #$;V1.6 #$;Public $;noneC hostL;function-class (list) ["java.lang.Object" (list)] (list) - (|>. ($d;field #$;Public $;finalF partials-field $t;int) - ($d;method #$;Public $;noneM "" ($t;method (list $t;int) #;None (list)) - (|>. ($i;ALOAD +0) - ($i;INVOKESPECIAL "java.lang.Object" "" ($t;method (list) #;None (list)) false) - ($i;ALOAD +0) - ($i;ILOAD +1) - ($i;PUTFIELD hostL;function-class partials-field $t;int) - $i;RETURN)) + ($d.method #$.Public $.noneM apply-method (apply-signature arity) + (let [preI (|> (list.n/range +0 (n/dec arity)) + (list/map $i.ALOAD) + $i.fuse)] + (|>> preI + ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature (n/dec arity)) false) + ($i.CHECKCAST hostL.function-class) + ($i.ALOAD arity) + ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) false) + $i.ARETURN))))) + (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature +1))) + $d.fuse) + bytecode ($d.abstract #$.V1_6 #$.Public $.noneC hostL.function-class (list) ["java.lang.Object" (list)] (list) + (|>> ($d.field #$.Public $.finalF partials-field $t.int) + ($d.method #$.Public $.noneM "" ($t.method (list $t.int) #.None (list)) + (|>> ($i.ALOAD +0) + ($i.INVOKESPECIAL "java.lang.Object" "" ($t.method (list) #.None (list)) false) + ($i.ALOAD +0) + ($i.ILOAD +1) + ($i.PUTFIELD hostL.function-class partials-field $t.int) + $i.RETURN)) applyI))] - _ (commonT;store-class hostL;function-class bytecode)] + _ (commonT.store-class hostL.function-class bytecode)] (wrap bytecode))) (def: #export translate - (Meta [commonT;Bytecode commonT;Bytecode]) - (do macro;Monad + (Meta [commonT.Bytecode commonT.Bytecode]) + (do macro.Monad [runtime-bc translate-runtime function-bc translate-function] (wrap [runtime-bc function-bc]))) -- cgit v1.2.3