diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux')
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux | 421 |
1 files changed, 214 insertions, 207 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux index 384193d99..c8076cada 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux @@ -26,7 +26,6 @@ ["." constant [pool (#+ Resource)]] [encoding - ["." unsigned] ["." name]] ["." type (#+ Type) ["." category (#+ Return' Value')] @@ -82,10 +81,6 @@ method.strict )) -(def: local - (-> Nat (Bytecode Any)) - (|>> unsigned.u1 try.assume _.aload)) - (def: this (Bytecode Any) _.aload-0) @@ -126,12 +121,12 @@ (method.method ..modifier ..variant::name ..variant::type (list) - ($_ _.compose - new-variant - (..set! ..variant-tag $tag) - (..set! ..variant-last? $last?) - (..set! ..variant-value $value) - _.areturn)))) + (#.Some ($_ _.compose + new-variant + (..set! ..variant-tag $tag) + (..set! ..variant-last? $last?) + (..set! ..variant-value $value) + _.areturn))))) (def: #export left-flag _.aconst-null) (def: #export right-flag ..unit) @@ -189,11 +184,12 @@ (method.method ..modifier ..variant::name ..variant::type (list) - (..risky - ($_ _.compose - ..this - (_.invokestatic //type.frac "parseDouble" (type.method [(list //type.text) type.double (list)])) - (//value.wrap type.double))))) + (#.Some + (..risky + ($_ _.compose + ..this + (_.invokestatic //type.frac "parseDouble" (type.method [(list //type.text) type.double (list)])) + (//value.wrap type.double)))))) (def: #export log! (Bytecode Any) @@ -224,9 +220,10 @@ (method.method ..modifier name ..failure::type (list) - ($_ _.compose - (..illegal-state-exception message) - _.athrow))) + (#.Some + ($_ _.compose + (..illegal-state-exception message) + _.athrow)))) (def: apply-failure::name "apply_failure") (def: #export apply-failure (..procedure ..apply-failure::name ..failure::type)) @@ -251,16 +248,17 @@ (method.method ..modifier ..push::name ..push::type (list) - (let [new-stack-frame! ($_ _.compose - _.iconst-2 - (_.anewarray //type.value)) - $head _.aload-1 - $tail _.aload-0] - ($_ _.compose - new-stack-frame! - (..set! ..stack-head $head) - (..set! ..stack-tail $tail) - _.areturn)))) + (#.Some + (let [new-stack-frame! ($_ _.compose + _.iconst-2 + (_.anewarray //type.value)) + $head _.aload-1 + $tail _.aload-0] + ($_ _.compose + new-stack-frame! + (..set! ..stack-head $head) + (..set! ..stack-tail $tail) + _.areturn))))) (def: case::name "case") (def: case::type (type.method [(list //type.variant //type.tag //type.flag) //type.value (list)])) @@ -269,79 +267,80 @@ (def: case::method (method.method ..modifier ..case::name ..case::type (list) - (do _.monad - [@loop _.new-label - @perfect-match! _.new-label - @tags-match! _.new-label - @maybe-nested _.new-label - @maybe-super-nested _.new-label - @mismatch! _.new-label - #let [::tag ($_ _.compose - (..get ..variant-tag) - (//value.unwrap type.int)) - ::last? (..get ..variant-last?) - ::value (..get ..variant-value) - - $variant _.aload-0 - $tag _.iload-1 - $last? _.aload-2 - - not-found _.aconst-null - - update-$tag ($_ _.compose - _.isub - _.istore-1) - update-$variant ($_ _.compose - $variant ::value - (_.checkcast //type.variant) - _.astore-0) - recur (: (-> Label (Bytecode Any)) - (function (_ @loop-start) - ($_ _.compose - update-$tag - update-$variant - (_.goto @loop-start)))) - - super-nested-tag ($_ _.compose - $variant ::tag - $tag _.isub) - super-nested ($_ _.compose - super-nested-tag - $variant ::last? - $variant ::value - ..variant)]] - ($_ _.compose - (_.set-label @loop) - $tag - $variant ::tag - _.dup2 (_.if-icmpeq @tags-match!) - _.dup2 (_.if-icmpgt @maybe-nested) - _.dup2 (_.if-icmplt @maybe-super-nested) - ## _.pop2 - not-found - _.areturn - (_.set-label @tags-match!) ## tag, sumT - $last? ## tag, sumT, wants-last? - $variant ::last? ## tag, sumT, wants-last?, is-last? - (_.if-acmpeq @perfect-match!) ## tag, sumT - (_.set-label @maybe-nested) ## tag, sumT - $variant ::last? ## tag, sumT, last? - (_.ifnull @mismatch!) ## tag, sumT - (recur @loop) - (_.set-label @perfect-match!) ## tag, sumT - ## _.pop2 - $variant ::value - _.areturn - (_.set-label @maybe-super-nested) ## tag, sumT - $last? (_.ifnull @mismatch!) - ## _.pop2 - super-nested - _.areturn - (_.set-label @mismatch!) ## tag, sumT - ## _.pop2 - not-found - _.areturn - )))) + (#.Some + (do _.monad + [@loop _.new-label + @perfect-match! _.new-label + @tags-match! _.new-label + @maybe-nested _.new-label + @maybe-super-nested _.new-label + @mismatch! _.new-label + #let [::tag ($_ _.compose + (..get ..variant-tag) + (//value.unwrap type.int)) + ::last? (..get ..variant-last?) + ::value (..get ..variant-value) + + $variant _.aload-0 + $tag _.iload-1 + $last? _.aload-2 + + not-found _.aconst-null + + update-$tag ($_ _.compose + _.isub + _.istore-1) + update-$variant ($_ _.compose + $variant ::value + (_.checkcast //type.variant) + _.astore-0) + recur (: (-> Label (Bytecode Any)) + (function (_ @loop-start) + ($_ _.compose + update-$tag + update-$variant + (_.goto @loop-start)))) + + super-nested-tag ($_ _.compose + $variant ::tag + $tag _.isub) + super-nested ($_ _.compose + super-nested-tag + $variant ::last? + $variant ::value + ..variant)]] + ($_ _.compose + (_.set-label @loop) + $tag + $variant ::tag + _.dup2 (_.if-icmpeq @tags-match!) + _.dup2 (_.if-icmpgt @maybe-nested) + _.dup2 (_.if-icmplt @maybe-super-nested) + ## _.pop2 + not-found + _.areturn + (_.set-label @tags-match!) ## tag, sumT + $last? ## tag, sumT, wants-last? + $variant ::last? ## tag, sumT, wants-last?, is-last? + (_.if-acmpeq @perfect-match!) ## tag, sumT + (_.set-label @maybe-nested) ## tag, sumT + $variant ::last? ## tag, sumT, last? + (_.ifnull @mismatch!) ## tag, sumT + (recur @loop) + (_.set-label @perfect-match!) ## tag, sumT + ## _.pop2 + $variant ::value + _.areturn + (_.set-label @maybe-super-nested) ## tag, sumT + $last? (_.ifnull @mismatch!) + ## _.pop2 + super-nested + _.areturn + (_.set-label @mismatch!) ## tag, sumT + ## _.pop2 + not-found + _.areturn + ))))) (def: projection-type (type.method [(list //type.tuple //type.offset) //type.value (list)])) @@ -378,53 +377,55 @@ left-projection::method (method.method ..modifier ..left-projection::name ..projection-type (list) - (do _.monad - [@loop _.new-label - @recursive _.new-label - #let [::left ($_ _.compose - $lefts _.aaload)]] - ($_ _.compose - (_.set-label @loop) - $lefts $last-right (_.if-icmpge @recursive) - $tuple ::left - _.areturn - (_.set-label @recursive) - ## Recursive - (recur @loop)))) + (#.Some + (do _.monad + [@loop _.new-label + @recursive _.new-label + #let [::left ($_ _.compose + $lefts _.aaload)]] + ($_ _.compose + (_.set-label @loop) + $lefts $last-right (_.if-icmpge @recursive) + $tuple ::left + _.areturn + (_.set-label @recursive) + ## Recursive + (recur @loop))))) right-projection::method (method.method ..modifier ..right-projection::name ..projection-type (list) - (do _.monad - [@loop _.new-label - @not-tail _.new-label - @slice _.new-label - #let [$right ($_ _.compose - $lefts - _.iconst-1 - _.iadd) - $::nested ($_ _.compose - $tuple _.swap _.aaload) - super-nested ($_ _.compose - $tuple - $right - $tuple::size - (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange" - (type.method [(list //type.tuple //type.index //type.index) //type.tuple (list)])))]] - ($_ _.compose - (_.set-label @loop) - $last-right $right - _.dup2 (_.if-icmpne @not-tail) - ## _.pop - $::nested - _.areturn - (_.set-label @not-tail) - (_.if-icmpgt @slice) - ## Must recurse - (recur @loop) - (_.set-label @slice) - super-nested - _.areturn)))] + (#.Some + (do _.monad + [@loop _.new-label + @not-tail _.new-label + @slice _.new-label + #let [$right ($_ _.compose + $lefts + _.iconst-1 + _.iadd) + $::nested ($_ _.compose + $tuple _.swap _.aaload) + super-nested ($_ _.compose + $tuple + $right + $tuple::size + (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange" + (type.method [(list //type.tuple //type.index //type.index) //type.tuple (list)])))]] + ($_ _.compose + (_.set-label @loop) + $last-right $right + _.dup2 (_.if-icmpne @not-tail) + ## _.pop + $::nested + _.areturn + (_.set-label @not-tail) + (_.if-icmpgt @slice) + ## Must recurse + (recur @loop) + (_.set-label @slice) + super-nested + _.areturn))))] [left-projection::method right-projection::method])) @@ -447,53 +448,55 @@ (def: try::method (method.method ..modifier ..try::name ..try::type (list) - (do _.monad - [@from _.new-label - @to _.new-label - @handler _.new-label - #let [$unsafe ..this - unit _.aconst-null - - ^StringWriter (type.class "java.io.StringWriter" (list)) - string-writer ($_ _.compose - (_.new ^StringWriter) - _.dup - (_.invokespecial ^StringWriter "<init>" (type.method [(list) type.void (list)]))) - - ^PrintWriter (type.class "java.io.PrintWriter" (list)) - print-writer ($_ _.compose - ## WTW - (_.new ^PrintWriter) ## WTWP - _.dup-x1 ## WTPWP - _.swap ## WTPPW - ..true ## WTPPWZ - (_.invokespecial ^PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) - ## WTP - )]] - ($_ _.compose - (_.try @from @to @handler //type.error) - (_.set-label @from) - $unsafe unit ..apply - ..right-injection _.areturn - (_.set-label @to) - (_.set-label @handler) ## T - string-writer ## TW - _.dup-x1 ## WTW - print-writer ## WTP - (_.invokevirtual //type.error "printStackTrace" (type.method [(list ^PrintWriter) type.void (list)])) ## W - (_.invokevirtual ^StringWriter "toString" (type.method [(list) //type.text (list)])) ## S - ..left-injection _.areturn - )))) + (#.Some + (do _.monad + [@from _.new-label + @to _.new-label + @handler _.new-label + #let [$unsafe ..this + unit _.aconst-null + + ^StringWriter (type.class "java.io.StringWriter" (list)) + string-writer ($_ _.compose + (_.new ^StringWriter) + _.dup + (_.invokespecial ^StringWriter "<init>" (type.method [(list) type.void (list)]))) + + ^PrintWriter (type.class "java.io.PrintWriter" (list)) + print-writer ($_ _.compose + ## WTW + (_.new ^PrintWriter) ## WTWP + _.dup-x1 ## WTPWP + _.swap ## WTPPW + ..true ## WTPPWZ + (_.invokespecial ^PrintWriter "<init>" (type.method [(list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) + ## WTP + )]] + ($_ _.compose + (_.try @from @to @handler //type.error) + (_.set-label @from) + $unsafe unit ..apply + ..right-injection _.areturn + (_.set-label @to) + (_.set-label @handler) ## T + string-writer ## TW + _.dup-x1 ## WTW + print-writer ## WTP + (_.invokevirtual //type.error "printStackTrace" (type.method [(list ^PrintWriter) type.void (list)])) ## W + (_.invokevirtual ^StringWriter "toString" (type.method [(list) //type.text (list)])) ## S + ..left-injection _.areturn + ))))) (def: reflection (All [category] (-> (Type (<| Return' Value' category)) Text)) (|>> type.reflection reflection.reflection)) +(def: ^Object (type.class "java.lang.Object" (list))) + (def: translate-runtime (Operation Any) - (let [^Object (type.class "java.lang.Object" (list)) - class (..reflection ..class) + (let [class (..reflection ..class) modifier (: (Modifier Class) ($_ modifier@compose class.public @@ -517,7 +520,8 @@ left-projection::method right-projection::method - ..try::method)) + ..try::method + )) (row.row)))] (do ////.monad [_ (///.execute! class [class bytecode])] @@ -530,35 +534,38 @@ (list@map (function (_ arity) (method.method method.public ..apply::name (..apply::type arity) (list) - (let [previous-inputs (|> arity - list.indices - (monad.map _.monad ..local))] - ($_ _.compose - previous-inputs - (_.invokevirtual //function.class ..apply::name (..apply::type (dec arity))) - (_.checkcast //function.class) - (..local arity) - (_.invokevirtual //function.class ..apply::name (..apply::type //function/arity.minimum)) - _.areturn))))) + (#.Some + (let [previous-inputs (|> arity + list.indices + (monad.map _.monad _.aload))] + ($_ _.compose + previous-inputs + (_.invokevirtual //function.class ..apply::name (..apply::type (dec arity))) + (_.checkcast //function.class) + (_.aload arity) + (_.invokevirtual //function.class ..apply::name (..apply::type //function/arity.minimum)) + _.areturn)))))) (list& (method.method (modifier@compose method.public method.abstract) ..apply::name (..apply::type //function/arity.minimum) (list) ## TODO: It shouldn't be necessary to set the code for this method, since it's abstract. ## Setting this might be a bug. Verify & fix ASAP. - ($_ _.compose - ..apply-failure - ..this - _.areturn)))) + (#.Some + ($_ _.compose + ..apply-failure + ..this + _.areturn))))) <init>::method (method.method method.public "<init>" //function.init (list) - (let [$partials _.iload-1] - ($_ _.compose - ..this - (_.invokespecial ^Object "<init>" (type.method [(list) type.void (list)])) - ..this - $partials - (_.putfield //function.class //function/count.field //function/count.type) - _.return))) + (#.Some + (let [$partials _.iload-1] + ($_ _.compose + ..this + (_.invokespecial ^Object "<init>" (type.method [(list) type.void (list)])) + ..this + $partials + (_.putfield //function.class //function/count.field //function/count.type) + _.return)))) modifier (: (Modifier Class) ($_ modifier@compose class.public |