diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux | 555 |
1 files changed, 278 insertions, 277 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index 86fe53d1e..86efad1ab 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -6,19 +6,20 @@ [text format] [collection - [list ("list/" Functor<List>)]]] + ["." list ("list/." Functor<List>)]]] ["." math] - [language - ["." compiler - [analysis (#+ Arity)] - ["." translation]]]] + [compiler + [default + ["." phase + [analysis (#+ Arity)] + ["." translation]]]]] [luxc [lang [host ["$" jvm (#+ Inst Method Def Operation) ["$t" type] ["$d" def] - ["$i" inst]]]]] + ["_" inst]]]]] ["." // (#+ ByteCode)]) (def: $Object $.Type ($t.class "java.lang.Object" (list))) @@ -37,10 +38,10 @@ (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)) #0))] - (|>> outI ($i.string "LOG: ") (printI "print") - outI $i.SWAP (printI "println")))) + (let [outI (_.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) + printI (function (_ method) (_.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) #0))] + (|>> outI (_.string "LOG: ") (printI "print") + outI _.SWAP (printI "println")))) (def: variant-method Method @@ -48,51 +49,51 @@ (def: #export variantI Inst - ($i.INVOKESTATIC //.runtime-class "variant_make" variant-method #0)) + (_.INVOKESTATIC //.runtime-class "variant_make" variant-method #0)) (def: #export leftI Inst - (|>> ($i.int 0) - $i.NULL - $i.DUP2_X1 - $i.POP2 + (|>> (_.int 0) + _.NULL + _.DUP2_X1 + _.POP2 variantI)) (def: #export rightI Inst - (|>> ($i.int 1) - ($i.string "") - $i.DUP2_X1 - $i.POP2 + (|>> (_.int 1) + (_.string "") + _.DUP2_X1 + _.POP2 variantI)) (def: #export someI Inst rightI) (def: #export noneI Inst - (|>> ($i.int 0) - $i.NULL - ($i.string //.unit) + (|>> (_.int 0) + _.NULL + (_.string //.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) + (<| _.with-label (function (_ @from)) + _.with-label (function (_ @to)) + _.with-label (function (_ @handler)) + (|>> (_.try @from @to @handler "java.lang.Exception") + (_.label @from) unsafeI someI - $i.ARETURN - ($i.label @to) - ($i.label @handler) + _.ARETURN + (_.label @to) + (_.label @handler) noneI - $i.ARETURN))) + _.ARETURN))) (def: #export string-concatI Inst - ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0)) + (_.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0)) (def: #export partials-field Text "partials") (def: #export apply-method Text "apply") @@ -104,84 +105,84 @@ (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) + (let [store-tagI (|>> _.DUP (_.int 0) (_.ILOAD +0) (_.wrap #$.Int) _.AASTORE) + store-flagI (|>> _.DUP (_.int 1) (_.ALOAD +1) _.AASTORE) + store-valueI (|>> _.DUP (_.int 2) (_.ALOAD +2) _.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)) #0)) - on-null-objectI ($i.string "NULL") - arrayI (|>> ($i.ALOAD +0) - ($i.CHECKCAST ($t.descriptor $Object-Array))) - recurseI ($i.INVOKESTATIC //.runtime-class "force_text" force-textMT #0) - 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 + (<| _.with-label (function (_ @is-null)) + _.with-label (function (_ @normal-object)) + _.with-label (function (_ @array-loop)) + _.with-label (function (_ @within-bounds)) + _.with-label (function (_ @is-first)) + _.with-label (function (_ @elem-end)) + _.with-label (function (_ @fold-end)) + (let [on-normal-objectI (|>> (_.ALOAD +0) + (_.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) #0)) + on-null-objectI (_.string "NULL") + arrayI (|>> (_.ALOAD +0) + (_.CHECKCAST ($t.descriptor $Object-Array))) + recurseI (_.INVOKESTATIC //.runtime-class "force_text" force-textMT #0) + force-elemI (|>> _.DUP arrayI _.SWAP _.AALOAD recurseI) + swap2 (|>> _.DUP2_X2 ## X,Y => Y,X,Y + _.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 (|>> (_.string ", ") _.SWAP string-concatI) + merge-with-totalI (|>> _.DUP_X2 _.POP ## TSIP => TPSI swap2 ## TPSI => SITP string-concatI ## SITP => SIT - $i.DUP_X2 $i.POP ## SIT => TSI + _.DUP_X2 _.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 (|>> _.DUP ## TSI => TSII + (_.IFEQ @is-first) ## TSI + force-elemI add-spacingI merge-with-totalI (_.GOTO @elem-end) + (_.label @is-first) ## TSI force-elemI merge-with-totalI - ($i.label @elem-end) ## TSI + (_.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))) + inc-idxI (|>> (_.int 1) _.IADD) + on-array-objectI (|>> (_.string "[") ## T + arrayI _.ARRAYLENGTH ## TS + (_.int 0) ## TSI + (_.label @array-loop) ## TSI + _.DUP2 + (_.IF_ICMPGT @within-bounds) ## TSI + _.POP2 (_.string "]") string-concatI (_.GOTO @fold-end) + (_.label @within-bounds) + foldI inc-idxI (_.GOTO @array-loop) + (_.label @fold-end))]) + (|>> (_.ALOAD +0) + (_.IFNULL @is-null) + (_.ALOAD +0) + (_.INSTANCEOF ($t.descriptor $Object-Array)) + (_.IFEQ @normal-object) + on-array-objectI _.ARETURN + (_.label @normal-object) on-normal-objectI _.ARETURN + (_.label @is-null) on-null-objectI _.ARETURN))) ($d.method #$.Public $.staticM "variant_make" ($t.method (list $t.int $Object $Object) (#.Some $Variant) (list)) - (|>> ($i.int 3) - ($i.array $Object) + (|>> (_.int 3) + (_.array $Object) store-tagI store-flagI store-valueI - $i.ARETURN))))) + _.ARETURN))))) (def: #export force-textI Inst - ($i.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0)) + (_.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0)) -(def: frac-shiftI Inst ($i.double (math.pow 32.0 2.0))) +(def: frac-shiftI Inst (_.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)) (try-methodI - (|>> ($i.ALOAD +0) - ($i.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0) - ($i.wrap #$.Double)))) + (|>> (_.ALOAD +0) + (_.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0) + (_.wrap #$.Double)))) )) (def: clz-method Method ($t.method (list $t.long) (#.Some $t.int) (list))) @@ -190,186 +191,186 @@ 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)) #0)))) + (|>> (_.ALOAD +0) + (_.ILOAD +1) + (_.ILOAD +2) + (_.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) #0)))) ($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)) #0) - $i.I2L - ($i.wrap #$.Long)))) + (|>> (_.ALOAD +0) + (_.ILOAD +1) + (_.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) #0) + _.I2L + (_.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)))] + (let [tuple-sizeI (|>> (_.ALOAD +0) _.ARRAYLENGTH) + tuple-elemI (|>> (_.ALOAD +0) (_.ILOAD +1) _.AALOAD) + expected-last-sizeI (|>> (_.ILOAD +1) (_.int 1) _.IADD) + tuple-tailI (|>> (_.ALOAD +0) tuple-sizeI (_.int 1) _.ISUB _.AALOAD (_.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" "<init>" ($t.method (list $String) #.None (list)) #0) - $i.ATHROW)) + (|>> (_.NEW "java.lang.IllegalStateException") + _.DUP + (_.string "Invalid expression for pattern-matching.") + (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) + _.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" "<init>" ($t.method (list $String) #.None (list)) #0) - $i.ATHROW)) + (|>> (_.NEW "java.lang.IllegalStateException") + _.DUP + (_.string "Error while applying function.") + (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) + _.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)) + (|>> (_.int 2) + (_.ANEWARRAY "java.lang.Object") + _.DUP + (_.int 0) + (_.ALOAD +0) + _.AASTORE + _.DUP + (_.int 1) + (_.ALOAD +1) + _.AASTORE + _.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)) + (|>> (_.ALOAD +0) + (_.int 0) + _.AALOAD + (_.CHECKCAST ($t.descriptor $Stack)) + _.ARETURN)) ($d.method #$.Public $.staticM "pm_peek" ($t.method (list $Stack) (#.Some $Object) (list)) - (|>> ($i.ALOAD +0) - ($i.int 1) - $i.AALOAD - $i.ARETURN)) + (|>> (_.ALOAD +0) + (_.int 1) + _.AALOAD + _.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)) + (<| _.with-label (function (_ @begin)) + _.with-label (function (_ @just-return)) + _.with-label (function (_ @then)) + _.with-label (function (_ @further)) + _.with-label (function (_ @shorten)) + _.with-label (function (_ @wrong)) (let [variant-partI (: (-> Nat Inst) (function (_ idx) - (|>> ($i.int (.int idx)) $i.AALOAD))) + (|>> (_.int (.int idx)) _.AALOAD))) tagI (: Inst - (|>> (variant-partI +0) ($i.unwrap #$.Int))) + (|>> (variant-partI +0) (_.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 (|>> (_.ALOAD +0) tagI ## Get tag + (_.ILOAD +1) _.ISUB ## Shorten tag + (_.ALOAD +0) flagI ## Get flag + (_.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 + _.ARETURN) + update-tagI (|>> _.ISUB (_.ISTORE +1)) + update-variantI (|>> (_.ALOAD +0) datumI (_.CHECKCAST ($t.descriptor $Variant)) (_.ASTORE +0)) + failureI (|>> _.NULL _.ARETURN) + return-datumI (|>> (_.ALOAD +0) datumI _.ARETURN)]) + (|>> (_.label @begin) + (_.ILOAD +1) ## tag + (_.ALOAD +0) tagI ## tag, sumT + _.DUP2 (_.IF_ICMPEQ @then) + _.DUP2 (_.IF_ICMPGT @further) + _.DUP2 (_.IF_ICMPLT @shorten) + ## _.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 + (_.label @then) ## tag, sumT + (_.ALOAD +2) ## tag, sumT, wants-last? + (_.ALOAD +0) flagI ## tag, sumT, wants-last?, is-last? + (_.IF_ACMPEQ @just-return) ## tag, sumT + (_.label @further) ## tag, sumT + (_.ALOAD +0) flagI ## tag, sumT, last? + (_.IFNULL @wrong) ## tag, sumT update-tagI update-variantI - ($i.GOTO @begin) - ($i.label @just-return) ## tag, sumT - ## $i.POP2 + (_.GOTO @begin) + (_.label @just-return) ## tag, sumT + ## _.POP2 return-datumI - ($i.label @shorten) ## tag, sumT - ($i.ALOAD +2) ($i.IFNULL @wrong) - ## $i.POP2 + (_.label @shorten) ## tag, sumT + (_.ALOAD +2) (_.IFNULL @wrong) + ## _.POP2 shortenI - ($i.label @wrong) ## tag, sumT - ## $i.POP2 + (_.label @wrong) ## tag, sumT + ## _.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) + (<| _.with-label (function (_ @begin)) + _.with-label (function (_ @not-recursive)) + (let [updated-idxI (|>> _.SWAP _.ISUB)]) + (|>> (_.label @begin) tuple-sizeI expected-last-sizeI - $i.DUP2 ($i.IF_ICMPGT @not-recursive) + _.DUP2 (_.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 (_.ISTORE +1) + tuple-tailI (_.ASTORE +0) + (_.GOTO @begin) + (_.label @not-recursive) + ## _.POP2 tuple-elemI - $i.ARETURN))) + _.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)) #0))]) - (|>> ($i.label @begin) + (<| _.with-label (function (_ @begin)) + _.with-label (function (_ @tail)) + _.with-label (function (_ @slice)) + (let [updated-idxI (|>> (_.ILOAD +1) (_.int 1) _.IADD tuple-sizeI _.ISUB) + sliceI (|>> (_.ALOAD +0) (_.ILOAD +1) tuple-sizeI + (_.INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t.method (list $Object-Array $t.int $t.int) (#.Some $Object-Array) (list)) #0))]) + (|>> (_.label @begin) tuple-sizeI expected-last-sizeI - $i.DUP2 ($i.IF_ICMPEQ @tail) - ($i.IF_ICMPGT @slice) + _.DUP2 (_.IF_ICMPEQ @tail) + (_.IF_ICMPGT @slice) ## Must recurse - tuple-tailI ($i.ASTORE +0) - updated-idxI ($i.ISTORE +1) - ($i.GOTO @begin) - ($i.label @slice) + tuple-tailI (_.ASTORE +0) + updated-idxI (_.ISTORE +1) + (_.GOTO @begin) + (_.label @slice) sliceI - $i.ARETURN - ($i.label @tail) - ## $i.POP2 + _.ARETURN + (_.label @tail) + ## _.POP2 tuple-elemI - $i.ARETURN))) + _.ARETURN))) ))) (def: io-methods Def - (let [string-writerI (|>> ($i.NEW "java.io.StringWriter") - $i.DUP - ($i.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) #0)) - print-writerI (|>> ($i.NEW "java.io.PrintWriter") - $i.SWAP - $i.DUP2 - $i.POP - $i.SWAP - ($i.boolean #1) - ($i.INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) #0) + (let [string-writerI (|>> (_.NEW "java.io.StringWriter") + _.DUP + (_.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) #0)) + print-writerI (|>> (_.NEW "java.io.PrintWriter") + _.SWAP + _.DUP2 + _.POP + _.SWAP + (_.boolean #1) + (_.INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) #0) )] (|>> ($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) #0) + (<| _.with-label (function (_ @from)) + _.with-label (function (_ @to)) + _.with-label (function (_ @handler)) + (|>> (_.try @from @to @handler "java.lang.Throwable") + (_.label @from) + (_.ALOAD +0) + _.NULL + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) rightI - $i.ARETURN - ($i.label @to) - ($i.label @handler) + _.ARETURN + (_.label @to) + (_.label @handler) string-writerI ## TW - $i.DUP2 ## TWTW + _.DUP2 ## TWTW print-writerI ## TWTP - ($i.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) #0) ## TW - ($i.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) #0) ## TS - $i.SWAP $i.POP leftI - $i.ARETURN))) + (_.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) #0) ## TW + (_.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) #0) ## TS + _.SWAP _.POP leftI + _.ARETURN))) ))) (def: process-methods @@ -377,55 +378,55 @@ (let [executor-class "java.util.concurrent.ScheduledThreadPoolExecutor" executorT ($t.class executor-class (list)) executor-field "executor" - endI (|>> ($i.string //.unit) - $i.ARETURN) + endI (|>> (_.string //.unit) + _.ARETURN) runnableI (: (-> Inst Inst) (function (_ functionI) - (|>> ($i.NEW //.runnable-class) - $i.DUP + (|>> (_.NEW //.runnable-class) + _.DUP functionI - ($i.INVOKESPECIAL //.runnable-class "<init>" ($t.method (list $Function) #.None (list)) #0)))) + (_.INVOKESPECIAL //.runnable-class "<init>" ($t.method (list $Function) #.None (list)) #0)))) threadI (: (-> Inst Inst) (function (_ runnableI) - (|>> ($i.NEW "java.lang.Thread") - $i.DUP + (|>> (_.NEW "java.lang.Thread") + _.DUP runnableI - ($i.INVOKESPECIAL "java.lang.Thread" "<init>" ($t.method (list $Runnable) #.None (list)) #0))))] + (_.INVOKESPECIAL "java.lang.Thread" "<init>" ($t.method (list $Runnable) #.None (list)) #0))))] (|>> ($d.field #$.Public ($.++F $.finalF $.staticF) executor-field executorT) ($d.method #$.Public $.staticM "<clinit>" ($t.method (list) #.None (list)) - (let [parallelism-levelI (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some $Runtime) (list)) #0) - ($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0)) - executorI (|>> ($i.NEW executor-class) - $i.DUP + (let [parallelism-levelI (|>> (_.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some $Runtime) (list)) #0) + (_.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0)) + executorI (|>> (_.NEW executor-class) + _.DUP parallelism-levelI - ($i.INVOKESPECIAL executor-class "<init>" ($t.method (list $t.int) #.None (list)) #0))] + (_.INVOKESPECIAL executor-class "<init>" ($t.method (list $t.int) #.None (list)) #0))] (|>> executorI - ($i.PUTSTATIC //.runtime-class executor-field executorT) - $i.RETURN))) + (_.PUTSTATIC //.runtime-class executor-field executorT) + _.RETURN))) ($d.method #$.Public $.staticM "schedule" ($t.method (list $t.long $Function) (#.Some $Object) (list)) - (let [delayI ($i.LLOAD +0) + (let [delayI (_.LLOAD +0) immediacy-checkI (|>> delayI - ($i.long 0) - $i.LCMP) + (_.long 0) + _.LCMP) time-unit-class "java.util.concurrent.TimeUnit" time-unitT ($t.class time-unit-class (list)) futureT ($t.class "java.util.concurrent.ScheduledFuture" (list)) - executorI ($i.GETSTATIC //.runtime-class executor-field executorT) + executorI (_.GETSTATIC //.runtime-class executor-field executorT) schedule-laterI (|>> executorI - (runnableI ($i.ALOAD +2)) + (runnableI (_.ALOAD +2)) delayI - ($i.GETSTATIC time-unit-class "MILLISECONDS" time-unitT) - ($i.INVOKEVIRTUAL executor-class "schedule" ($t.method (list $Runnable $t.long time-unitT) (#.Some futureT) (list)) #0)) + (_.GETSTATIC time-unit-class "MILLISECONDS" time-unitT) + (_.INVOKEVIRTUAL executor-class "schedule" ($t.method (list $Runnable $t.long time-unitT) (#.Some futureT) (list)) #0)) schedule-immediatelyI (|>> executorI - (runnableI ($i.ALOAD +2)) - ($i.INVOKEVIRTUAL executor-class "execute" ($t.method (list $Runnable) #.None (list)) #0))] - (<| $i.with-label (function (_ @immediately)) + (runnableI (_.ALOAD +2)) + (_.INVOKEVIRTUAL executor-class "execute" ($t.method (list $Runnable) #.None (list)) #0))] + (<| _.with-label (function (_ @immediately)) (|>> immediacy-checkI - ($i.IFEQ @immediately) + (_.IFEQ @immediately) schedule-laterI endI - ($i.label @immediately) + (_.label @immediately) schedule-immediatelyI endI)))) ))) @@ -439,7 +440,7 @@ pm-methods io-methods process-methods))] - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [_ (translation.execute! [//.runtime-class bytecode])] (wrap bytecode)))) @@ -449,27 +450,27 @@ (list/map (function (_ arity) ($d.method #$.Public $.noneM apply-method (apply-signature arity) (let [preI (|> (list.n/range +0 (dec arity)) - (list/map $i.ALOAD) - $i.fuse)] + (list/map _.ALOAD) + _.fuse)] (|>> preI - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0) - ($i.CHECKCAST //.function-class) - ($i.ALOAD arity) - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) - $i.ARETURN))))) + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0) + (_.CHECKCAST //.function-class) + (_.ALOAD arity) + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + _.ARETURN))))) (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature +1))) $d.fuse) bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list) (|>> ($d.field #$.Public $.finalF partials-field $t.int) ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list)) - (|>> ($i.ALOAD +0) - ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) - ($i.ALOAD +0) - ($i.ILOAD +1) - ($i.PUTFIELD //.function-class partials-field $t.int) - $i.RETURN)) + (|>> (_.ALOAD +0) + (_.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) + (_.ALOAD +0) + (_.ILOAD +1) + (_.PUTFIELD //.function-class partials-field $t.int) + _.RETURN)) applyI))] - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [_ (translation.execute! [//.function-class bytecode])] (wrap bytecode)))) @@ -479,26 +480,26 @@ bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runnable-class (list) ["java.lang.Object" (list)] (list ["java.lang.Runnable" (list)]) (|>> ($d.field #$.Public $.finalF procedure-field $Function) ($d.method #$.Public $.noneM "<init>" ($t.method (list $Function) #.None (list)) - (|>> ($i.ALOAD +0) - ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) - ($i.ALOAD +0) - ($i.ALOAD +1) - ($i.PUTFIELD //.runnable-class procedure-field $Function) - $i.RETURN)) + (|>> (_.ALOAD +0) + (_.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) + (_.ALOAD +0) + (_.ALOAD +1) + (_.PUTFIELD //.runnable-class procedure-field $Function) + _.RETURN)) ($d.method #$.Public $.noneM "run" ($t.method (list) #.None (list)) - (|>> ($i.ALOAD +0) - ($i.GETFIELD //.runnable-class procedure-field $Function) - $i.NULL - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) - $i.RETURN)) + (|>> (_.ALOAD +0) + (_.GETFIELD //.runnable-class procedure-field $Function) + _.NULL + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + _.RETURN)) ))] - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [_ (translation.execute! [//.runnable-class bytecode])] (wrap bytecode)))) (def: #export translate (Operation [ByteCode ByteCode ByteCode]) - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [runtime-bc translate-runtime function-bc translate-function runnable-bc translate-runnable] |