diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase')
12 files changed, 113 insertions, 114 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux index a56629158..e583b36b7 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux @@ -11,7 +11,7 @@ [target [jvm ["." constant] - ["_" instruction (#+ Label Instruction) ("#@." monad)] + ["_" bytecode (#+ Label Bytecode) ("#@." monad)] ["." type (#+ Type) [category (#+ Method)]] [encoding @@ -33,7 +33,7 @@ (type.method [(list //type.value) type.boolean (list)])) (def: (pop-alt stack-depth) - (-> Nat (Instruction Any)) + (-> Nat (Bytecode Any)) (.case stack-depth 0 (_@wrap []) 1 _.pop @@ -44,31 +44,31 @@ (pop-alt (n.- 2 stack-depth))))) (def: ldc/integer - (-> (I64 Any) (Instruction Any)) + (-> (I64 Any) (Bytecode Any)) (|>> .i64 i32.i32 constant.integer _.ldc/integer)) (def: ldc/long - (-> (I64 Any) (Instruction Any)) + (-> (I64 Any) (Bytecode Any)) (|>> .int constant.long _.ldc/long)) (def: ldc/double - (-> Frac (Instruction Any)) + (-> Frac (Bytecode Any)) (|>> constant.double _.ldc/double)) (def: peek - (Instruction Any) + (Bytecode Any) ($_ _.compose _.dup (//runtime.get //runtime.stack-head))) (def: pop - (Instruction Any) + (Bytecode Any) ($_ _.compose (//runtime.get //runtime.stack-tail) (_.checkcast //type.stack))) (def: (path' phase stack-depth @else @end path) - (-> Phase Nat Label Label Path (Operation (Instruction Any))) + (-> Phase Nat Label Label Path (Operation (Bytecode Any))) (.case path #synthesis.Pop (operation@wrap ..pop) @@ -214,7 +214,7 @@ )) (def: (path phase path @end) - (-> Phase Path Label (Operation (Instruction Any))) + (-> Phase Path Label (Operation (Bytecode Any))) (do phase.monad [@else //runtime.forge-label pathG (..path' phase 1 @else @end path)] @@ -227,7 +227,7 @@ (_.goto @end))))) (def: #export (if phase conditionS thenS elseS) - (-> Phase Synthesis Synthesis Synthesis (Operation (Instruction Any))) + (-> Phase Synthesis Synthesis Synthesis (Operation (Bytecode Any))) (do phase.monad [conditionG (phase conditionS) thenG (phase thenS) @@ -246,7 +246,7 @@ (_.set-label @end)))))) (def: #export (let phase inputS register bodyS) - (-> Phase Synthesis Register Synthesis (Operation (Instruction Any))) + (-> Phase Synthesis Register Synthesis (Operation (Bytecode Any))) (do phase.monad [inputG (phase inputS) bodyG (phase bodyS)] @@ -256,7 +256,7 @@ bodyG)))) (def: #export (case phase valueS path) - (-> Phase Synthesis Path (Operation (Instruction Any))) + (-> Phase Synthesis Path (Operation (Bytecode Any))) (do phase.monad [@end //runtime.forge-label valueG (phase valueS) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux index d8ac81cc4..1fba35532 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/common.lux @@ -5,9 +5,9 @@ ["." monad (#+ do)]] [control ["." try] + ["." exception (#+ exception:)] ["<>" parser - ["<s>" synthesis (#+ Parser)]] - ["." exception (#+ exception:)]] + ["<s>" synthesis (#+ Parser)]]] [data ["." product] [number @@ -18,7 +18,7 @@ ["." dictionary]]] [target [jvm - ["_" instruction (#+ Label Instruction) ("#@." monad)] + ["_" bytecode (#+ Label Bytecode) ("#@." monad)] ["." constant] [encoding ["." signed (#+ S4)]] @@ -42,7 +42,7 @@ (def: #export (custom [parser handler]) (All [s] (-> [(Parser s) - (-> Text Phase s (Operation (Instruction Any)))] + (-> Text Phase s (Operation (Bytecode Any)))] Handler)) (function (_ extension-name phase input) (case (<s>.run parser input) @@ -63,29 +63,29 @@ (def: $Error (type.class "java.lang.Error" (list))) (def: lux-int - (Instruction Any) + (Bytecode Any) ($_ _.compose _.i2l (///value.wrap type.long))) (def: jvm-int - (Instruction Any) + (Bytecode Any) ($_ _.compose (///value.unwrap type.long) _.l2i)) (def: ensure-string - (Instruction Any) + (Bytecode Any) (_.checkcast $String)) -(def: (predicate instruction) - (-> (-> Label (Instruction Any)) - (Instruction Any)) +(def: (predicate bytecode) + (-> (-> Label (Bytecode Any)) + (Bytecode Any)) (do _.monad [@then _.new-label @end _.new-label] ($_ _.compose - (instruction @then) + (bytecode @then) (_.getstatic $Boolean "FALSE" $Boolean) (_.goto @end) (_.set-label @then) @@ -107,7 +107,7 @@ inputG (phase inputS) elseG (phase elseS) conditionalsG+ (: (Operation (List [(List [S4 Label]) - (Instruction Any)])) + (Bytecode Any)])) (monad.map @ (function (_ [chars branch]) (do @ [branchG (phase branch) @@ -138,14 +138,14 @@ )))))])) (def: (lux::is [referenceG sampleG]) - (Binary (Instruction Any)) + (Binary (Bytecode Any)) ($_ _.compose referenceG sampleG (..predicate _.if-acmpeq))) (def: (lux::try riskyG) - (Unary (Instruction Any)) + (Unary (Bytecode Any)) ($_ _.compose riskyG (_.checkcast ///function.class) @@ -160,7 +160,7 @@ (template [<name> <op>] [(def: (<name> [maskG inputG]) - (Binary (Instruction Any)) + (Binary (Bytecode Any)) ($_ _.compose inputG (///value.unwrap type.long) maskG (///value.unwrap type.long) @@ -173,7 +173,7 @@ (template [<name> <op>] [(def: (<name> [shiftG inputG]) - (Binary (Instruction Any)) + (Binary (Bytecode Any)) ($_ _.compose inputG (///value.unwrap type.long) shiftG ..jvm-int @@ -190,7 +190,7 @@ (template [<name> <const>] [(def: (<name> _) - (Nullary (Instruction Any)) + (Nullary (Bytecode Any)) ($_ _.compose (_.ldc/double (constant.double <const>)) (///value.wrap type.double)))] @@ -202,7 +202,7 @@ (template [<name> <type> <op>] [(def: (<name> [paramG subjectG]) - (Binary (Instruction Any)) + (Binary (Bytecode Any)) ($_ _.compose subjectG (///value.unwrap <type>) paramG (///value.unwrap <type>) @@ -224,7 +224,7 @@ (template [<eq> <lt> <type> <cmp>] [(template [<name> <reference>] [(def: (<name> [paramG subjectG]) - (Binary (Instruction Any)) + (Binary (Bytecode Any)) ($_ _.compose subjectG (///value.unwrap <type>) paramG (///value.unwrap <type>) @@ -240,12 +240,12 @@ ) (def: (to-string class from) - (-> (Type Class) (Type Primitive) (Instruction Any)) + (-> (Type Class) (Type Primitive) (Bytecode Any)) (_.invokestatic class "toString" (type.method [(list from) ..$String (list)]))) (template [<name> <prepare> <transform>] [(def: (<name> inputG) - (Unary (Instruction Any)) + (Unary (Bytecode Any)) ($_ _.compose inputG <prepare> @@ -318,18 +318,18 @@ (/////bundle.install "decode" (unary ..f64::decode))))) (def: (text::size inputG) - (Unary (Instruction Any)) + (Unary (Bytecode Any)) ($_ _.compose inputG ..ensure-string (_.invokevirtual ..$String "length" (type.method [(list) type.int (list)])) ..lux-int)) -(def: no-op (Instruction Any) (_@wrap [])) +(def: no-op (Bytecode Any) (_@wrap [])) (template [<name> <pre-subject> <pre-param> <op> <post>] [(def: (<name> [paramG subjectG]) - (Binary (Instruction Any)) + (Binary (Bytecode Any)) ($_ _.compose subjectG <pre-subject> paramG <pre-param> @@ -347,14 +347,14 @@ ) (def: (text::concat [leftG rightG]) - (Binary (Instruction Any)) + (Binary (Bytecode Any)) ($_ _.compose leftG ..ensure-string rightG ..ensure-string (_.invokevirtual ..$String "concat" (type.method [(list ..$String) ..$String (list)])))) (def: (text::clip [startG endG subjectG]) - (Trinary (Instruction Any)) + (Trinary (Bytecode Any)) ($_ _.compose subjectG ..ensure-string startG ..jvm-int @@ -363,7 +363,7 @@ (def: index-method (type.method [(list ..$String type.int) type.int (list)])) (def: (text::index [startG partG textG]) - (Trinary (Instruction Any)) + (Trinary (Bytecode Any)) (do _.monad [@not-found _.new-label @end _.new-label] @@ -397,7 +397,7 @@ (def: string-method (type.method [(list ..$String) type.void (list)])) (def: (io::log messageG) - (Unary (Instruction Any)) + (Unary (Bytecode Any)) ($_ _.compose (_.getstatic ..$System "out" ..$PrintStream) messageG @@ -406,7 +406,7 @@ ///runtime.unit)) (def: (io::error messageG) - (Unary (Instruction Any)) + (Unary (Bytecode Any)) ($_ _.compose (_.new ..$Error) _.dup @@ -417,7 +417,7 @@ (def: exit-method (type.method [(list type.int) type.void (list)])) (def: (io::exit codeG) - (Unary (Instruction Any)) + (Unary (Bytecode Any)) ($_ _.compose codeG ..jvm-int (_.invokestatic ..$System "exit" ..exit-method) @@ -425,7 +425,7 @@ (def: time-method (type.method [(list) type.long (list)])) (def: (io::current-time _) - (Nullary (Instruction Any)) + (Nullary (Bytecode Any)) ($_ _.compose (_.invokestatic ..$System "currentTimeMillis" ..time-method) (///value.wrap type.long))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux index 6a66f78f8..35137a77b 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux @@ -19,7 +19,7 @@ ["." modifier (#+ Modifier) ("#@." monoid)] ["." field (#+ Field)] ["." method (#+ Method)] - ["_" instruction (#+ Label Instruction) ("#@." monad)] + ["_" bytecode (#+ Label Bytecode) ("#@." monad)] ["." class (#+ Class)] ["." type (#+ Type) [category (#+ Return' Value')] @@ -54,10 +54,10 @@ ["." generation]]]]]) (def: #export (with @begin class environment arity body) - (-> Label External Environment Arity (Instruction Any) + (-> Label External Environment Arity (Bytecode Any) (Operation [(List (State Pool Field)) (List (State Pool Method)) - (Instruction Any)])) + (Bytecode Any)])) (let [classT (type.class class (list)) fields (: (List (State Pool Field)) (list& /arity.constant @@ -91,7 +91,7 @@ (|>> type.reflection reflection.reflection name.internal)) (def: #export (abstraction generate [environment arity bodyS]) - (-> Phase Abstraction (Operation (Instruction Any))) + (-> Phase Abstraction (Operation (Bytecode Any))) (do phase.monad [@begin //runtime.forge-label [function-class bodyG] (generation.with-context @@ -111,7 +111,7 @@ (wrap instance))) (def: #export (apply generate [abstractionS inputsS]) - (-> Phase Apply (Operation (Instruction Any))) + (-> Phase Apply (Operation (Bytecode Any))) (do phase.monad [abstractionG (generate abstractionS) inputsG (monad.map @ generate inputsS)] diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant.lux index 456e46b86..dd8144ea8 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant.lux @@ -1,7 +1,5 @@ (.module: [lux (#- Type type) - [control - [state (#+ State)]] [data [collection ["." row]]] @@ -12,7 +10,7 @@ [type (#+ Type) [category (#+ Value)]] [constant - [pool (#+ Pool)]]]]]) + [pool (#+ Resource)]]]]]) (def: modifier (Modifier Field) @@ -23,5 +21,5 @@ )) (def: #export (constant name type) - (-> Text (Type Value) (State Pool Field)) + (-> Text (Type Value) (Resource Field)) (field.field ..modifier name type (row.row))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant/arity.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant/arity.lux index 589d9c43d..d4d1a2a68 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant/arity.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/constant/arity.lux @@ -1,13 +1,11 @@ (.module: [lux (#- type) - [control - [state (#+ State)]] [target [jvm ["." type] ["." field (#+ Field)] [constant - [pool (#+ Pool)]]]]] + [pool (#+ Resource)]]]]] ["." // [/////// [arity (#+ Arity)]]]) @@ -19,5 +17,5 @@ (def: #export maximum Arity 8) (def: #export constant - (State Pool Field) + (Resource Field) (//.constant ..name ..type)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial/count.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial/count.lux index 4806e3ba1..579a63992 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial/count.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function/field/variable/partial/count.lux @@ -1,8 +1,10 @@ (.module: [lux (#- type) + [control + ["." try]] [target [jvm - ["_" instruction (#+ Instruction)] + ["_" bytecode (#+ Bytecode)] [encoding [name (#+ External)] ["." unsigned]] @@ -14,14 +16,14 @@ (def: #export type type.int) (def: #export initial - (Instruction Any) - (_.bipush (unsigned.u1 0))) + (Bytecode Any) + (|> 0 unsigned.u1 try.assume _.bipush)) (def: this _.aload-0) (def: #export value - (Instruction Any) + (Bytecode Any) ($_ _.compose ..this (_.getfield /////abstract.class ..field ..type) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux index 6e7ac6f23..371b900a7 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux @@ -12,7 +12,7 @@ ["." list ("#@." functor)]]] [target [jvm - ["_" instruction (#+ Label Instruction) ("#@." monad)] + ["_" bytecode (#+ Label Bytecode) ("#@." monad)] [encoding ["." unsigned]]]]] ["." // #_ @@ -37,7 +37,7 @@ (_@wrap [])) (def: #export (recur translate updatesS) - (-> Phase (List Synthesis) (Operation (Instruction Any))) + (-> Phase (List Synthesis) (Operation (Bytecode Any))) (do phase.monad [[@begin offset] generation.anchor updatesG (|> updatesS @@ -71,7 +71,7 @@ (_.goto @begin))))) (def: #export (scope translate [offset initsS+ iterationS]) - (-> Phase [Nat (List Synthesis) Synthesis] (Operation (Instruction Any))) + (-> Phase [Nat (List Synthesis) Synthesis] (Operation (Bytecode Any))) (do phase.monad [@begin //runtime.forge-label initsI+ (monad.map @ translate initsS+) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux index f17b3f2d1..946ea34d5 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/primitive.lux @@ -5,7 +5,7 @@ [target [jvm ["." constant] - ["_" instruction (#+ Instruction)] + ["_" bytecode (#+ Bytecode)] ["." type]]] [macro ["." template]]] @@ -17,12 +17,12 @@ (def: $Double (type.class "java.lang.Double" (list))) (def: #export (bit value) - (-> Bit (Instruction Any)) + (-> Bit (Bytecode Any)) (_.getstatic $Boolean (if value "TRUE" "FALSE") $Boolean)) (template [<name> <inputT> <ldc> <class> <inputD>] [(def: #export (<name> value) - (-> <inputT> (Instruction Any)) + (-> <inputT> (Bytecode Any)) (do _.monad [_ (`` (|> value (~~ (template.splice <ldc>))))] (_.invokestatic <class> "valueOf" (type.method [(list <inputD>) <class> (list)]))))] @@ -31,4 +31,4 @@ [f64 Frac [constant.double _.ldc/double] $Double type.double] ) -(def: #export text _.ldc/string) +(def: #export text _.string) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux index 6c9a963d7..a5c4c3156 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux @@ -12,7 +12,7 @@ ["." generation]]]] [target [jvm - ["_" instruction (#+ Instruction)] + ["_" bytecode (#+ Bytecode)] ["." type] [encoding ["." unsigned]]]]] @@ -22,11 +22,11 @@ ["#." type]]) (def: local - (-> Register (Instruction Any)) + (-> Register (Bytecode Any)) (|>> unsigned.u1 _.aload)) (def: #export this - (Instruction Any) + (Bytecode Any) _.aload-0) (template [<name> <prefix>] @@ -39,7 +39,7 @@ ) (def: (foreign variable) - (-> Register (Operation (Instruction Any))) + (-> Register (Operation (Bytecode Any))) (do phase.monad [function-class generation.context] (wrap ($_ _.compose @@ -49,7 +49,7 @@ //type.value))))) (def: #export (variable variable) - (-> Variable (Operation (Instruction Any))) + (-> Variable (Operation (Bytecode Any))) (case variable (#reference.Local variable) (operation@wrap (..local variable)) @@ -58,7 +58,7 @@ (..foreign variable))) (def: #export (constant name) - (-> Name (Operation (Instruction Any))) + (-> Name (Operation (Bytecode Any))) (do phase.monad [bytecode-name (generation.remember name)] (wrap (_.getstatic (type.class bytecode-name (list)) //value.field //type.value)))) 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 a47892039..384193d99 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux @@ -3,7 +3,7 @@ [abstract ["." monad (#+ do)]] [control - [state (#+ State)]] + ["." try]] [data [binary (#+ Binary)] [number @@ -13,18 +13,18 @@ [collection ["." list ("#@." functor)] ["." row]] - [format - [".F" binary]]] + ["." format #_ + ["#" binary]]] [target [jvm - ["_" instruction (#+ Label Instruction)] + ["_" bytecode (#+ Label Bytecode)] ["." modifier (#+ Modifier) ("#@." monoid)] ["." field (#+ Field)] ["." method (#+ Method)] ["." version] ["." class (#+ Class)] ["." constant - [pool (#+ Pool)]] + [pool (#+ Resource)]] [encoding ["." unsigned] ["." name]] @@ -57,7 +57,7 @@ (template [<name> <base>] [(type: #export <name> - (<base> Anchor (Instruction Any) Definition))] + (<base> Anchor (Bytecode Any) Definition))] [Operation ///.Operation] [Phase ///.Phase] @@ -66,12 +66,12 @@ ) (type: #export (Generator i) - (-> Phase i (Operation (Instruction Any)))) + (-> Phase i (Operation (Bytecode Any)))) (def: #export class (type.class "LuxRuntime" (list))) (def: procedure - (-> Text (Type category.Method) (Instruction Any)) + (-> Text (Type category.Method) (Bytecode Any)) (_.invokestatic ..class)) (def: modifier @@ -83,28 +83,28 @@ )) (def: local - (-> Nat (Instruction Any)) - (|>> unsigned.u1 _.aload)) + (-> Nat (Bytecode Any)) + (|>> unsigned.u1 try.assume _.aload)) (def: this - (Instruction Any) + (Bytecode Any) _.aload-0) (def: #export (get index) - (-> (Instruction Any) (Instruction Any)) + (-> (Bytecode Any) (Bytecode Any)) ($_ _.compose index _.aaload)) (def: (set! index value) - (-> (Instruction Any) (Instruction Any) (Instruction Any)) + (-> (Bytecode Any) (Bytecode Any) (Bytecode Any)) ($_ _.compose _.dup index value _.aastore)) -(def: #export unit (_.ldc/string synthesis.unit)) +(def: #export unit (_.string synthesis.unit)) (def: variant::name "variant") (def: variant::type (type.method [(list //type.tag //type.flag //type.value) //type.variant (list)])) @@ -137,7 +137,7 @@ (def: #export right-flag ..unit) (def: #export left-injection - (Instruction Any) + (Bytecode Any) ($_ _.compose _.iconst-0 ..left-flag @@ -146,7 +146,7 @@ ..variant)) (def: #export right-injection - (Instruction Any) + (Bytecode Any) ($_ _.compose _.iconst-1 ..right-flag @@ -157,7 +157,7 @@ (def: #export some-injection ..right-injection) (def: #export none-injection - (Instruction Any) + (Bytecode Any) ($_ _.compose _.iconst-0 _.aconst-null @@ -165,7 +165,7 @@ ..variant)) (def: (risky $unsafe) - (-> (Instruction Any) (Instruction Any)) + (-> (Bytecode Any) (Bytecode Any)) (do _.monad [@from _.new-label @to _.new-label @@ -196,31 +196,31 @@ (//value.wrap type.double))))) (def: #export log! - (Instruction Any) + (Bytecode Any) (let [^PrintStream (type.class "java.io.PrintStream" (list)) ^System (type.class "java.lang.System" (list)) out (_.getstatic ^System "out" ^PrintStream) print-type (type.method [(list //type.value) type.void (list)]) print! (function (_ method) (_.invokevirtual ^PrintStream method print-type))] ($_ _.compose - out (_.ldc/string "LOG: ") (print! "print") + out (_.string "LOG: ") (print! "print") out _.swap (print! "println")))) (def: exception-constructor (type.method [(list //type.text) type.void (list)])) (def: (illegal-state-exception message) - (-> Text (Instruction Any)) + (-> Text (Bytecode Any)) (let [^IllegalStateException (type.class "java.lang.IllegalStateException" (list))] ($_ _.compose (_.new ^IllegalStateException) _.dup - (_.ldc/string message) + (_.string message) (_.invokespecial ^IllegalStateException "<init>" ..exception-constructor)))) (def: failure::type (type.method [(list) type.void (list)])) (def: (failure name message) - (-> Text Text (State Pool Method)) + (-> Text Text (Resource Method)) (method.method ..modifier name ..failure::type (list) @@ -295,7 +295,7 @@ $variant ::value (_.checkcast //type.variant) _.astore-0) - recur (: (-> Label (Instruction Any)) + recur (: (-> Label (Bytecode Any)) (function (_ @loop-start) ($_ _.compose update-$tag @@ -352,7 +352,7 @@ (def: #export right-projection (..procedure ..right-projection::name ..projection-type)) (def: projection::method2 - [(State Pool Method) (State Pool Method)] + [(Resource Method) (Resource Method)] (let [$tuple _.aload-0 $tuple::size ($_ _.compose $tuple _.arraylength) @@ -368,7 +368,7 @@ update-$tuple ($_ _.compose $tuple $last-right _.aaload (_.checkcast //type.tuple) _.astore-0) - recur (: (-> Label (Instruction Any)) + recur (: (-> Label (Bytecode Any)) (function (_ @loop) ($_ _.compose update-$lefts @@ -490,16 +490,16 @@ (-> (Type (<| Return' Value' category)) Text)) (|>> type.reflection reflection.reflection)) -(def: #export ^Object (type.class "java.lang.Object" (list))) - (def: translate-runtime (Operation Any) - (let [class (..reflection ..class) + (let [^Object (type.class "java.lang.Object" (list)) + class (..reflection ..class) modifier (: (Modifier Class) ($_ modifier@compose class.public class.final)) - bytecode (<| (binaryF.run class.writer) + bytecode (<| (format.run class.writer) + try.assume (class.class version.v6_0 modifier (name.internal class) @@ -554,7 +554,7 @@ (let [$partials _.iload-1] ($_ _.compose ..this - (_.invokespecial ..^Object "<init>" (type.method [(list) type.void (list)])) + (_.invokespecial ^Object "<init>" (type.method [(list) type.void (list)])) ..this $partials (_.putfield //function.class //function/count.field //function/count.type) @@ -564,16 +564,17 @@ class.public class.abstract)) class (..reflection //function.class) - partial-count (: (State Pool Field) + partial-count (: (Resource Field) (field.field (modifier@compose field.public field.final) //function/count.field //function/count.type (row.row))) - bytecode (<| (binaryF.run class.writer) + bytecode (<| (format.run class.writer) + try.assume (class.class version.v6_0 modifier (name.internal class) - (name.internal (..reflection ..^Object)) (list) + (name.internal (..reflection ^Object)) (list) (list partial-count) (list& <init>::method apply::method+) (row.row)))] @@ -592,5 +593,5 @@ (let [shift (n./ 4 i64.width)] ## This shift is done to avoid the possibility of forged labels ## to be in the range of the labels that are generated automatically - ## during the evaluation of Instruction expressions. + ## during the evaluation of Bytecode expressions. (:: ////.monad map (i64.left-shift shift) ///.next))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux index b75c646e8..b48711dd0 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/structure.lux @@ -10,7 +10,7 @@ [target [jvm ["." constant] - ["_" instruction (#+ Instruction)] + ["_" bytecode (#+ Bytecode)] ["." type]]]] ["." // #_ ["#." runtime (#+ Operation Phase Generator)] @@ -22,7 +22,7 @@ (def: $Object (type.class "java.lang.Object" (list))) -(def: unitG (Instruction Any) (//primitive.text /////synthesis.unit)) +(def: unitG (Bytecode Any) (//primitive.text /////synthesis.unit)) (template: (!integer <value>) (|> <value> .i64 i32.i32 constant.integer)) @@ -54,7 +54,7 @@ (monad.seq @ membersI)))))) (def: (flagG right?) - (-> Bit (Instruction Any)) + (-> Bit (Bytecode Any)) (if right? ..unitG _.aconst-null)) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux index e6deaf205..462c625c9 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/value.lux @@ -2,7 +2,7 @@ [lux (#- Type type) [target [jvm - ["_" instruction (#+ Instruction)] + ["_" bytecode (#+ Bytecode)] ["." type (#+ Type) ("#@." equivalence) [category (#+ Primitive)] ["." box]]]]]) @@ -35,13 +35,13 @@ ) (def: #export (wrap type) - (-> (Type Primitive) (Instruction Any)) + (-> (Type Primitive) (Bytecode Any)) (let [wrapper (type.class (primitive-wrapper type) (list))] (_.invokestatic wrapper "valueOf" (type.method [(list type) wrapper (list)])))) (def: #export (unwrap type) - (-> (Type Primitive) (Instruction Any)) + (-> (Type Primitive) (Bytecode Any)) (let [wrapper (type.class (primitive-wrapper type) (list))] ($_ _.compose (_.checkcast wrapper) |