From 18f682e86ebec539ae57a37aac45ecb0eb498a1c Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 25 Dec 2019 21:48:58 -0400 Subject: Optimized LuxRuntime::case and fixed a few bugs. --- .../tool/compiler/phase/generation/jvm/debug.lux | 32 ++++++++++++ .../tool/compiler/phase/generation/jvm/host.lux | 2 +- .../tool/compiler/phase/generation/jvm/runtime.lux | 58 +++++++++++----------- stdlib/source/test/lux/target/jvm.lux | 26 ++-------- 4 files changed, 66 insertions(+), 52 deletions(-) create mode 100644 stdlib/source/lux/tool/compiler/phase/generation/jvm/debug.lux (limited to 'stdlib/source') diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/debug.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/debug.lux new file mode 100644 index 000000000..142c46224 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/debug.lux @@ -0,0 +1,32 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + ["." io (#+ IO)] + ["." try (#+ Try)] + [security + ["!" capability]]] + [data + [binary (#+ Binary)] + [text + ["%" format (#+ format)]]] + [world + ["." file (#+ File)]]]) + +(def: extension ".class") + +(def: #export (write-class! name bytecode) + (-> Text Binary (IO Text)) + (let [file-path (format name ..extension)] + (do io.monad + [outcome (do (try.with @) + [file (: (IO (Try (File IO))) + (file.get-file io.monad file.system file-path))] + (!.use (:: file over-write) bytecode))] + (wrap (case outcome + (#try.Success definition) + file-path + + (#try.Failure error) + error))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/host.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/host.lux index 2892ac045..86b9aa095 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/host.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/host.lux @@ -52,7 +52,7 @@ (import: #long java/lang/ClassLoader) -(def: value::field "_value") +(def: value::field "value") (def: value::type (type.class "java.lang.Object" (list))) (def: value::modifier ($_ modifier@compose field.public field.final field.static)) 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 3ed3ecb52..89a1b94c1 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux @@ -97,10 +97,12 @@ (def: (set! index value) (-> (Bytecode Any) (Bytecode Any) (Bytecode Any)) ($_ _.compose - _.dup - index - value - _.aastore)) + ## A + _.dup ## AA + index ## AAI + value ## AAIV + _.aastore ## A + )) (def: #export unit (_.string synthesis.unit)) @@ -125,10 +127,10 @@ ..variant::type (list) (#.Some ($_ _.compose - new-variant - (..set! ..variant-tag $tag) - (..set! ..variant-last? $last?) - (..set! ..variant-value $value) + new-variant ## A[3] + (..set! ..variant-tag $tag) ## A[3] + (..set! ..variant-last? $last?) ## A[3] + (..set! ..variant-value $value) ## A[3] _.areturn))))) (def: #export left-flag _.aconst-null) @@ -184,12 +186,12 @@ (def: decode-frac::method (method.method ..modifier ..decode-frac::name - ..variant::type + ..decode-frac::type (list) (#.Some (..risky ($_ _.compose - ..this + _.aload-0 (_.invokestatic //type.frac "parseDouble" (type.method [(list //type.text) type.double (list)])) (//value.wrap type.double) ))))) @@ -202,7 +204,7 @@ print-type (type.method [(list //type.value) type.void (list)]) print! (function (_ method) (_.invokevirtual ^PrintStream method print-type))] ($_ _.compose - out (_.string "LOG: ") (print! "print") + out (_.string "LUX LOG: ") (print! "print") out _.swap (print! "println")))) (def: exception-constructor (type.method [(list //type.text) type.void (list)])) @@ -290,9 +292,7 @@ not-found _.aconst-null - update-$tag ($_ _.compose - _.isub - _.istore-1) + update-$tag _.isub update-$variant ($_ _.compose $variant ::value (_.checkcast //type.variant) @@ -300,21 +300,24 @@ recur (: (-> Label (Bytecode Any)) (function (_ @loop-start) ($_ _.compose - update-$tag - update-$variant + ## tag, sumT + update-$variant ## tag, sumT + update-$tag ## sub-tag (_.goto @loop-start)))) super-nested-tag ($_ _.compose - $variant ::tag - $tag _.isub) + ## tag, sumT + _.swap ## sumT, tag + _.isub) super-nested ($_ _.compose - super-nested-tag - $variant ::last? - $variant ::value + ## tag, sumT + super-nested-tag ## super-tag + $variant ::last? ## super-tag, super-last + $variant ::value ## super-tag, super-last, super-value ..variant)]] ($_ _.compose - (_.set-label @loop) $tag + (_.set-label @loop) $variant ::tag _.dup2 (_.if-icmpeq @tags-match!) _.dup2 (_.if-icmpgt @maybe-nested) @@ -323,11 +326,11 @@ not-found _.areturn (_.set-label @tags-match!) ## tag, sumT - $last? ## tag, sumT, wants-last? + $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? + (_.set-label @maybe-nested) ## tag, sumT + $variant ::last? ## tag, sumT, last? (_.ifnull @mismatch!) ## tag, sumT (recur @loop) (_.set-label @perfect-match!) ## tag, sumT @@ -335,9 +338,8 @@ $variant ::value _.areturn (_.set-label @maybe-super-nested) ## tag, sumT - $last? (_.ifnull @mismatch!) - ## _.pop2 - super-nested + $last? (_.ifnull @mismatch!) ## tag, sumT + super-nested ## super-variant _.areturn (_.set-label @mismatch!) ## tag, sumT ## _.pop2 diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index ab6cd5867..a4a13cbe4 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -5,14 +5,11 @@ ["." monad (#+ do)]] [control ["." function] - ["." io (#+ IO)] - ["." try (#+ Try)] + ["." io] + ["." try] [concurrency - ["." atom]] - [security - ["!" capability]]] + ["." atom]]] [data - [binary (#+ Binary)] ["." maybe] ["." bit ("#@." equivalence)] [number @@ -31,8 +28,6 @@ ["." row] ["." set] ["." list ("#@." functor)]]] - [world - ["." file (#+ File)]] [math ["." random (#+ Random) ("#@." monad)]] ["_" test (#+ Test)]] @@ -57,21 +52,6 @@ ["#." type (#+ Type) ["." category (#+ Value Object Class)]]]}) -## (def: (write-class! name bytecode) -## (-> Text Binary (IO Text)) -## (let [file-path (format name ".class")] -## (do io.monad -## [outcome (do (try.with @) -## [file (: (IO (Try (File IO))) -## (file.get-file io.monad file.system file-path))] -## (!.use (:: file over-write) bytecode))] -## (wrap (case outcome -## (#try.Success definition) -## (format "Wrote: " (%.text file-path)) - -## (#try.Failure error) -## error))))) - (def: method-modifier ($_ /modifier@compose /method.public -- cgit v1.2.3