diff options
Diffstat (limited to '')
6 files changed, 474 insertions, 474 deletions
diff --git a/stdlib/source/lux/target/jvm/bytecode.lux b/stdlib/source/lux/target/jvm/bytecode.lux index af843c6cf..700f3b27e 100644 --- a/stdlib/source/lux/target/jvm/bytecode.lux +++ b/stdlib/source/lux/target/jvm/bytecode.lux @@ -27,8 +27,8 @@ ["." template]]] ["." / #_ ["#." address (#+ Address)] - ["#." jump (#+ Jump Big-Jump)] - ["_" instruction (#+ Primitive-Array-Type Instruction Estimator) ("#\." monoid)] + ["#." jump (#+ Jump Big_Jump)] + ["_" instruction (#+ Primitive_Array_Type Instruction Estimator) ("#\." monoid)] ["#." environment (#+ Environment) [limit ["/." registry (#+ Register Registry)] @@ -54,64 +54,64 @@ (type: #export Resolver (Dictionary Label [Stack (Maybe Address)])) (type: #export Tracker - {#program-counter Address + {#program_counter Address #next Label #known Resolver}) (def: fresh Tracker - {#program-counter /address.start + {#program_counter /address.start #next 0 #known (dictionary.new n.hash)}) (type: #export Relative (-> Resolver (Try [(Row Exception) Instruction]))) -(def: no-exceptions +(def: no_exceptions (Row Exception) row.empty) -(def: relative-identity +(def: relative_identity Relative - (function.constant (#try.Success [..no-exceptions _.empty]))) + (function.constant (#try.Success [..no_exceptions _.empty]))) -(structure: relative-monoid +(structure: relative_monoid (Monoid Relative) - (def: identity ..relative-identity) + (def: identity ..relative_identity) (def: (compose left right) - (cond (is? ..relative-identity left) + (cond (is? ..relative_identity left) right - (is? ..relative-identity right) + (is? ..relative_identity right) left ## else (function (_ resolver) (do try.monad - [[left-exceptions left-instruction] (left resolver) - [right-exceptions right-instruction] (right resolver)] - (wrap [(\ row.monoid compose left-exceptions right-exceptions) - (_\compose left-instruction right-instruction)])))))) + [[left_exceptions left_instruction] (left resolver) + [right_exceptions right_instruction] (right resolver)] + (wrap [(\ row.monoid compose left_exceptions right_exceptions) + (_\compose left_instruction right_instruction)])))))) (type: #export (Bytecode a) (State' Try [Pool Environment Tracker] (Writer Relative a))) -(def: #export new-label +(def: #export new_label (Bytecode Label) (function (_ [pool environment tracker]) (#try.Success [[pool environment (update@ #next inc tracker)] - [..relative-identity + [..relative_identity (get@ #next tracker)]]))) -(exception: #export (label-has-already-been-set {label Label}) +(exception: #export (label_has_already_been_set {label Label}) (exception.report ["Label" (%.nat label)])) -(exception: #export (mismatched-environments {instruction Name} +(exception: #export (mismatched_environments {instruction Name} {label Label} {address Address} {expected Stack} @@ -123,20 +123,20 @@ ["Expected" (/stack.format expected)] ["Actual" (/stack.format actual)])) -(with-expansions [<success> (as-is (wrap [[pool +(with_expansions [<success> (as_is (wrap [[pool environment (update@ #known (dictionary.put label [actual (#.Some @here)]) tracker)] - [..relative-identity + [..relative_identity []]]))] - (def: #export (set-label label) + (def: #export (set_label label) (-> Label (Bytecode Any)) (function (_ [pool environment tracker]) - (let [@here (get@ #program-counter tracker)] + (let [@here (get@ #program_counter tracker)] (case (dictionary.get label (get@ #known tracker)) (#.Some [expected (#.Some address)]) - (exception.throw ..label-has-already-been-set [label]) + (exception.throw ..label_has_already_been_set [label]) (#.Some [expected #.None]) (do try.monad @@ -154,7 +154,7 @@ (def: #export monad (Monad Bytecode) (<| (:coerce (Monad Bytecode)) - (writer.with ..relative-monoid) + (writer.with ..relative_monoid) (: (Monad (State' Try [Pool Environment Tracker]))) state.with (: (Monad Try)) @@ -188,11 +188,11 @@ (/environment.consumes consumption) (monad.bind ! (/environment.produces production)) (monad.bind ! (/environment.has registry))) - program-counter' (step estimator (get@ #program-counter tracker))] + program_counter' (step estimator (get@ #program_counter tracker))] (wrap [[pool environment' - (set@ #program-counter program-counter' tracker)] - [(function.constant (wrap [..no-exceptions (bytecode input)])) + (set@ #program_counter program_counter' tracker)] + [(function.constant (wrap [..no_exceptions (bytecode input)])) []]])))) (template [<name> <frames>] @@ -229,35 +229,35 @@ [nop $0 $0 @_ _.nop] - [aconst-null $0 $1 @_ _.aconst-null] - - [iconst-m1 $0 $1 @_ _.iconst-m1] - [iconst-0 $0 $1 @_ _.iconst-0] - [iconst-1 $0 $1 @_ _.iconst-1] - [iconst-2 $0 $1 @_ _.iconst-2] - [iconst-3 $0 $1 @_ _.iconst-3] - [iconst-4 $0 $1 @_ _.iconst-4] - [iconst-5 $0 $1 @_ _.iconst-5] - - [lconst-0 $0 $2 @_ _.lconst-0] - [lconst-1 $0 $2 @_ _.lconst-1] - - [fconst-0 $0 $1 @_ _.fconst-0] - [fconst-1 $0 $1 @_ _.fconst-1] - [fconst-2 $0 $1 @_ _.fconst-2] + [aconst_null $0 $1 @_ _.aconst_null] + + [iconst_m1 $0 $1 @_ _.iconst_m1] + [iconst_0 $0 $1 @_ _.iconst_0] + [iconst_1 $0 $1 @_ _.iconst_1] + [iconst_2 $0 $1 @_ _.iconst_2] + [iconst_3 $0 $1 @_ _.iconst_3] + [iconst_4 $0 $1 @_ _.iconst_4] + [iconst_5 $0 $1 @_ _.iconst_5] + + [lconst_0 $0 $2 @_ _.lconst_0] + [lconst_1 $0 $2 @_ _.lconst_1] + + [fconst_0 $0 $1 @_ _.fconst_0] + [fconst_1 $0 $1 @_ _.fconst_1] + [fconst_2 $0 $1 @_ _.fconst_2] - [dconst-0 $0 $2 @_ _.dconst-0] - [dconst-1 $0 $2 @_ _.dconst-1] + [dconst_0 $0 $2 @_ _.dconst_0] + [dconst_1 $0 $2 @_ _.dconst_1] [pop $1 $0 @_ _.pop] [pop2 $2 $0 @_ _.pop2] [dup $1 $2 @_ _.dup] - [dup-x1 $2 $3 @_ _.dup-x1] - [dup-x2 $3 $4 @_ _.dup-x2] + [dup_x1 $2 $3 @_ _.dup_x1] + [dup_x2 $3 $4 @_ _.dup_x2] [dup2 $2 $4 @_ _.dup2] - [dup2-x1 $3 $5 @_ _.dup2-x1] - [dup2-x2 $4 $6 @_ _.dup2-x2] + [dup2_x1 $3 $5 @_ _.dup2_x1] + [dup2_x2 $4 $6 @_ _.dup2_x2] [swap $2 $2 @_ _.swap] @@ -270,30 +270,30 @@ [caload $2 $1 @_ _.caload] [saload $2 $1 @_ _.saload] - [iload-0 $0 $1 @0 _.iload-0] - [iload-1 $0 $1 @1 _.iload-1] - [iload-2 $0 $1 @2 _.iload-2] - [iload-3 $0 $1 @3 _.iload-3] + [iload_0 $0 $1 @0 _.iload_0] + [iload_1 $0 $1 @1 _.iload_1] + [iload_2 $0 $1 @2 _.iload_2] + [iload_3 $0 $1 @3 _.iload_3] - [lload-0 $0 $2 @1 _.lload-0] - [lload-1 $0 $2 @2 _.lload-1] - [lload-2 $0 $2 @3 _.lload-2] - [lload-3 $0 $2 @4 _.lload-3] + [lload_0 $0 $2 @1 _.lload_0] + [lload_1 $0 $2 @2 _.lload_1] + [lload_2 $0 $2 @3 _.lload_2] + [lload_3 $0 $2 @4 _.lload_3] - [fload-0 $0 $1 @0 _.fload-0] - [fload-1 $0 $1 @1 _.fload-1] - [fload-2 $0 $1 @2 _.fload-2] - [fload-3 $0 $1 @3 _.fload-3] + [fload_0 $0 $1 @0 _.fload_0] + [fload_1 $0 $1 @1 _.fload_1] + [fload_2 $0 $1 @2 _.fload_2] + [fload_3 $0 $1 @3 _.fload_3] - [dload-0 $0 $2 @1 _.dload-0] - [dload-1 $0 $2 @2 _.dload-1] - [dload-2 $0 $2 @3 _.dload-2] - [dload-3 $0 $2 @4 _.dload-3] + [dload_0 $0 $2 @1 _.dload_0] + [dload_1 $0 $2 @2 _.dload_1] + [dload_2 $0 $2 @3 _.dload_2] + [dload_3 $0 $2 @4 _.dload_3] - [aload-0 $0 $1 @0 _.aload-0] - [aload-1 $0 $1 @1 _.aload-1] - [aload-2 $0 $1 @2 _.aload-2] - [aload-3 $0 $1 @3 _.aload-3] + [aload_0 $0 $1 @0 _.aload_0] + [aload_1 $0 $1 @1 _.aload_1] + [aload_2 $0 $1 @2 _.aload_2] + [aload_3 $0 $1 @3 _.aload_3] [iastore $3 $1 @_ _.iastore] [lastore $4 $1 @_ _.lastore] @@ -304,30 +304,30 @@ [castore $3 $1 @_ _.castore] [sastore $3 $1 @_ _.sastore] - [istore-0 $1 $0 @0 _.istore-0] - [istore-1 $1 $0 @1 _.istore-1] - [istore-2 $1 $0 @2 _.istore-2] - [istore-3 $1 $0 @3 _.istore-3] - - [lstore-0 $2 $0 @1 _.lstore-0] - [lstore-1 $2 $0 @2 _.lstore-1] - [lstore-2 $2 $0 @3 _.lstore-2] - [lstore-3 $2 $0 @4 _.lstore-3] - - [fstore-0 $1 $0 @0 _.fstore-0] - [fstore-1 $1 $0 @1 _.fstore-1] - [fstore-2 $1 $0 @2 _.fstore-2] - [fstore-3 $1 $0 @3 _.fstore-3] - - [dstore-0 $2 $0 @1 _.dstore-0] - [dstore-1 $2 $0 @2 _.dstore-1] - [dstore-2 $2 $0 @3 _.dstore-2] - [dstore-3 $2 $0 @4 _.dstore-3] + [istore_0 $1 $0 @0 _.istore_0] + [istore_1 $1 $0 @1 _.istore_1] + [istore_2 $1 $0 @2 _.istore_2] + [istore_3 $1 $0 @3 _.istore_3] + + [lstore_0 $2 $0 @1 _.lstore_0] + [lstore_1 $2 $0 @2 _.lstore_1] + [lstore_2 $2 $0 @3 _.lstore_2] + [lstore_3 $2 $0 @4 _.lstore_3] + + [fstore_0 $1 $0 @0 _.fstore_0] + [fstore_1 $1 $0 @1 _.fstore_1] + [fstore_2 $1 $0 @2 _.fstore_2] + [fstore_3 $1 $0 @3 _.fstore_3] + + [dstore_0 $2 $0 @1 _.dstore_0] + [dstore_1 $2 $0 @2 _.dstore_1] + [dstore_2 $2 $0 @3 _.dstore_2] + [dstore_3 $2 $0 @4 _.dstore_3] - [astore-0 $1 $0 @0 _.astore-0] - [astore-1 $1 $0 @1 _.astore-1] - [astore-2 $1 $0 @2 _.astore-2] - [astore-3 $1 $0 @3 _.astore-3] + [astore_0 $1 $0 @0 _.astore_0] + [astore_1 $1 $0 @1 _.astore_1] + [astore_2 $1 $0 @2 _.astore_2] + [astore_3 $1 $0 @3 _.astore_3] [iadd $2 $1 @_ _.iadd] [isub $2 $1 @_ _.isub] @@ -410,7 +410,7 @@ (wrap [[pool (/environment.discontinue environment) tracker] - [..relative-identity + [..relative_identity []]])))) (template [<name> <consumption> <instruction>] @@ -442,7 +442,7 @@ (do try.monad [[pool' output] (resource pool)] (wrap [[pool' environment tracker] - [..relative-identity + [..relative_identity output]])))) (def: #export (string value) @@ -454,7 +454,7 @@ (..bytecode $0 $1 @_ _.ldc [index]) (#try.Failure _) - (..bytecode $0 $1 @_ _.ldc-w/string [index])))) + (..bytecode $0 $1 @_ _.ldc_w/string [index])))) (import: java/lang/Float ["#::." @@ -464,10 +464,10 @@ ["#::." (#static doubleToRawLongBits #manual [double] int)]) -(template [<name> <type> <constructor> <constant> <wide> <to-lux> <specializations>] +(template [<name> <type> <constructor> <constant> <wide> <to_lux> <specializations>] [(def: #export (<name> value) (-> <type> (Bytecode Any)) - (case (|> value <to-lux>) + (case (|> value <to_lux>) (^template [<special> <instruction>] [<special> (..bytecode $0 $1 @_ <instruction> [])]) <specializations> @@ -481,18 +481,18 @@ (#try.Failure _) (..bytecode $0 $1 @_ <wide> [index])))))] - [int I32 //constant.integer //constant/pool.integer _.ldc-w/integer + [int I32 //constant.integer //constant/pool.integer _.ldc_w/integer (<| .int i32.i64) - ([-1 _.iconst-m1] - [+0 _.iconst-0] - [+1 _.iconst-1] - [+2 _.iconst-2] - [+3 _.iconst-3] - [+4 _.iconst-4] - [+5 _.iconst-5])] + ([-1 _.iconst_m1] + [+0 _.iconst_0] + [+1 _.iconst_1] + [+2 _.iconst_2] + [+3 _.iconst_3] + [+4 _.iconst_4] + [+5 _.iconst_5])] ) -(def: (arbitrary-float value) +(def: (arbitrary_float value) (-> java/lang/Float (Bytecode Any)) (do ..monad [index (..lift (//constant/pool.float (//constant.float value)))] @@ -501,35 +501,35 @@ (..bytecode $0 $1 @_ _.ldc [index]) (#try.Failure _) - (..bytecode $0 $1 @_ _.ldc-w/float [index])))) + (..bytecode $0 $1 @_ _.ldc_w/float [index])))) -(def: float-bits +(def: float_bits (-> java/lang/Float Int) (|>> java/lang/Float::floatToRawIntBits - host.int-to-long + host.int_to_long (:coerce Int))) -(def: negative-zero-float-bits - (|> -0.0 host.double-to-float ..float-bits)) +(def: negative_zero_float_bits + (|> -0.0 host.double_to_float ..float_bits)) (def: #export (float value) (-> java/lang/Float (Bytecode Any)) - (if (i.= ..negative-zero-float-bits - (..float-bits value)) - (..arbitrary-float value) - (case (|> value host.float-to-double (:coerce Frac)) + (if (i.= ..negative_zero_float_bits + (..float_bits value)) + (..arbitrary_float value) + (case (|> value host.float_to_double (:coerce Frac)) (^template [<special> <instruction>] [<special> (..bytecode $0 $1 @_ <instruction> [])]) - ([+0.0 _.fconst-0] - [+1.0 _.fconst-1] - [+2.0 _.fconst-2]) + ([+0.0 _.fconst_0] + [+1.0 _.fconst_1] + [+2.0 _.fconst_2]) - _ (..arbitrary-float value)))) + _ (..arbitrary_float value)))) -(template [<name> <type> <constructor> <constant> <wide> <to-lux> <specializations>] +(template [<name> <type> <constructor> <constant> <wide> <to_lux> <specializations>] [(def: #export (<name> value) (-> <type> (Bytecode Any)) - (case (|> value <to-lux>) + (case (|> value <to_lux>) (^template [<special> <instruction>] [<special> (..bytecode $0 $2 @_ <instruction> [])]) <specializations> @@ -538,40 +538,40 @@ [index (..lift (<constant> (<constructor> value)))] (..bytecode $0 $2 @_ <wide> [index]))))] - [long Int //constant.long //constant/pool.long _.ldc2-w/long + [long Int //constant.long //constant/pool.long _.ldc2_w/long (<|) - ([+0 _.lconst-0] - [+1 _.lconst-1])] + ([+0 _.lconst_0] + [+1 _.lconst_1])] ) -(def: (arbitrary-double value) +(def: (arbitrary_double value) (-> java/lang/Double (Bytecode Any)) (do ..monad [index (..lift (//constant/pool.double (//constant.double value)))] - (..bytecode $0 $2 @_ _.ldc2-w/double [index]))) + (..bytecode $0 $2 @_ _.ldc2_w/double [index]))) -(def: double-bits +(def: double_bits (-> java/lang/Double Int) (|>> java/lang/Double::doubleToRawLongBits (:coerce Int))) -(def: negative-zero-double-bits - (..double-bits -0.0)) +(def: negative_zero_double_bits + (..double_bits -0.0)) (def: #export (double value) (-> java/lang/Double (Bytecode Any)) - (if (i.= ..negative-zero-double-bits - (..double-bits value)) - (..arbitrary-double value) + (if (i.= ..negative_zero_double_bits + (..double_bits value)) + (..arbitrary_double value) (case value (^template [<special> <instruction>] [<special> (..bytecode $0 $2 @_ <instruction> [])]) - ([+0.0 _.dconst-0] - [+1.0 _.dconst-1]) + ([+0.0 _.dconst_0] + [+1.0 _.dconst_1]) - _ (..arbitrary-double value)))) + _ (..arbitrary_double value)))) -(exception: #export (invalid-register {id Nat}) +(exception: #export (invalid_register {id Nat}) (exception.report ["ID" (%.nat id)])) @@ -582,12 +582,12 @@ (\ ..monad wrap register) (#try.Failure error) - (..throw ..invalid-register [id]))) + (..throw ..invalid_register [id]))) (template [<for> <size> <name> <general> <specials>] [(def: #export (<name> local) (-> Nat (Bytecode Any)) - (with-expansions [<specials>' (template.splice <specials>)] + (with_expansions [<specials>' (template.splice <specials>)] (`` (case local (~~ (template [<case> <instruction> <registry>] [<case> (..bytecode $0 <size> <registry> <instruction> [])] @@ -598,36 +598,36 @@ (..bytecode $0 <size> (<for> local) <general> [local]))))))] [/registry.for $1 iload _.iload - [[0 _.iload-0 @0] - [1 _.iload-1 @1] - [2 _.iload-2 @2] - [3 _.iload-3 @3]]] - [/registry.for-wide $2 lload _.lload - [[0 _.lload-0 @1] - [1 _.lload-1 @2] - [2 _.lload-2 @3] - [3 _.lload-3 @4]]] + [[0 _.iload_0 @0] + [1 _.iload_1 @1] + [2 _.iload_2 @2] + [3 _.iload_3 @3]]] + [/registry.for_wide $2 lload _.lload + [[0 _.lload_0 @1] + [1 _.lload_1 @2] + [2 _.lload_2 @3] + [3 _.lload_3 @4]]] [/registry.for $1 fload _.fload - [[0 _.fload-0 @0] - [1 _.fload-1 @1] - [2 _.fload-2 @2] - [3 _.fload-3 @3]]] - [/registry.for-wide $2 dload _.dload - [[0 _.dload-0 @1] - [1 _.dload-1 @2] - [2 _.dload-2 @3] - [3 _.dload-3 @4]]] + [[0 _.fload_0 @0] + [1 _.fload_1 @1] + [2 _.fload_2 @2] + [3 _.fload_3 @3]]] + [/registry.for_wide $2 dload _.dload + [[0 _.dload_0 @1] + [1 _.dload_1 @2] + [2 _.dload_2 @3] + [3 _.dload_3 @4]]] [/registry.for $1 aload _.aload - [[0 _.aload-0 @0] - [1 _.aload-1 @1] - [2 _.aload-2 @2] - [3 _.aload-3 @3]]] + [[0 _.aload_0 @0] + [1 _.aload_1 @1] + [2 _.aload_2 @2] + [3 _.aload_3 @3]]] ) (template [<for> <size> <name> <general> <specials>] [(def: #export (<name> local) (-> Nat (Bytecode Any)) - (with-expansions [<specials>' (template.splice <specials>)] + (with_expansions [<specials>' (template.splice <specials>)] (`` (case local (~~ (template [<case> <instruction> <registry>] [<case> (..bytecode <size> $0 <registry> <instruction> [])] @@ -638,30 +638,30 @@ (..bytecode <size> $0 (<for> local) <general> [local]))))))] [/registry.for $1 istore _.istore - [[0 _.istore-0 @0] - [1 _.istore-1 @1] - [2 _.istore-2 @2] - [3 _.istore-3 @3]]] - [/registry.for-wide $2 lstore _.lstore - [[0 _.lstore-0 @1] - [1 _.lstore-1 @2] - [2 _.lstore-2 @3] - [3 _.lstore-3 @4]]] + [[0 _.istore_0 @0] + [1 _.istore_1 @1] + [2 _.istore_2 @2] + [3 _.istore_3 @3]]] + [/registry.for_wide $2 lstore _.lstore + [[0 _.lstore_0 @1] + [1 _.lstore_1 @2] + [2 _.lstore_2 @3] + [3 _.lstore_3 @4]]] [/registry.for $1 fstore _.fstore - [[0 _.fstore-0 @0] - [1 _.fstore-1 @1] - [2 _.fstore-2 @2] - [3 _.fstore-3 @3]]] - [/registry.for-wide $2 dstore _.dstore - [[0 _.dstore-0 @1] - [1 _.dstore-1 @2] - [2 _.dstore-2 @3] - [3 _.dstore-3 @4]]] + [[0 _.fstore_0 @0] + [1 _.fstore_1 @1] + [2 _.fstore_2 @2] + [3 _.fstore_3 @3]]] + [/registry.for_wide $2 dstore _.dstore + [[0 _.dstore_0 @1] + [1 _.dstore_1 @2] + [2 _.dstore_2 @3] + [3 _.dstore_3 @4]]] [/registry.for $1 astore _.astore - [[0 _.astore-0 @0] - [1 _.astore-1 @1] - [2 _.astore-2 @2] - [3 _.astore-3 @3]]] + [[0 _.astore_0 @0] + [1 _.astore_1 @1] + [2 _.astore_2 @2] + [3 _.astore_3 @3]]] ) (template [<consumption> <production> <name> <instruction> <input>] @@ -669,26 +669,26 @@ (-> <input> (Bytecode Any)) (..bytecode <consumption> <production> @_ <instruction>))] - [$1 $1 newarray _.newarray Primitive-Array-Type] + [$1 $1 newarray _.newarray Primitive_Array_Type] [$0 $1 sipush _.sipush S2] ) -(exception: #export (unknown-label {label Label}) +(exception: #export (unknown_label {label Label}) (exception.report ["Label" (%.nat label)])) -(exception: #export (cannot-do-a-big-jump {label Label} +(exception: #export (cannot_do_a_big_jump {label Label} {@from Address} - {jump Big-Jump}) + {jump Big_Jump}) (exception.report ["Label" (%.nat label)] ["Start" (|> @from /address.value //unsigned.value %.nat)] ["Target" (|> jump //signed.value %.int)])) -(type: Any-Jump (Either Big-Jump Jump)) +(type: Any_Jump (Either Big_Jump Jump)) (def: (jump @from @to) - (-> Address Address (Try Any-Jump)) + (-> Address Address (Try Any_Jump)) (do {! try.monad} [jump (\ ! map //signed.value (/address.jump @from @to))] @@ -701,23 +701,23 @@ (\ ! map (|>> #.Left) (//signed.s4 jump)) (\ ! map (|>> #.Right) (//signed.s2 jump)))))) -(exception: #export (unset-label {label Label}) +(exception: #export (unset_label {label Label}) (exception.report ["Label" (%.nat label)])) -(def: (resolve-label label resolver) +(def: (resolve_label label resolver) (-> Label Resolver (Try [Stack Address])) (case (dictionary.get label resolver) (#.Some [actual (#.Some address)]) (#try.Success [actual address]) (#.Some [actual #.None]) - (exception.throw ..unset-label [label]) + (exception.throw ..unset_label [label]) #.None - (exception.throw ..unknown-label [label]))) + (exception.throw ..unknown_label [label]))) -(def: (acknowledge-label stack label tracker) +(def: (acknowledge_label stack label tracker) (-> Stack Label Tracker Tracker) (case (dictionary.get label (get@ #known tracker)) (#.Some _) @@ -731,30 +731,30 @@ (-> Label (Bytecode Any)) (let [[estimator bytecode] <instruction>] (function (_ [pool environment tracker]) - (let [@here (get@ #program-counter tracker)] + (let [@here (get@ #program_counter tracker)] (do try.monad [environment' (|> environment (/environment.consumes <consumption>)) actual (/environment.stack environment') - program-counter' (step estimator @here)] + program_counter' (step estimator @here)] (wrap (let [@from @here] [[pool environment' (|> tracker - (..acknowledge-label actual label) - (set@ #program-counter program-counter'))] + (..acknowledge_label actual label) + (set@ #program_counter program_counter'))] [(function (_ resolver) (do try.monad - [[expected @to] (..resolve-label label resolver) - _ (exception.assert ..mismatched-environments [(name-of <instruction>) label @here expected actual] + [[expected @to] (..resolve_label label resolver) + _ (exception.assert ..mismatched_environments [(name_of <instruction>) label @here expected actual] (\ /stack.equivalence = expected actual)) jump (..jump @from @to)] (case jump (#.Left jump) - (exception.throw ..cannot-do-a-big-jump [label @from jump]) + (exception.throw ..cannot_do_a_big_jump [label @from jump]) (#.Right jump) - (wrap [..no-exceptions (bytecode jump)])))) + (wrap [..no_exceptions (bytecode jump)])))) []]])))))))] [$1 ifeq _.ifeq] @@ -767,63 +767,63 @@ [$1 ifnull _.ifnull] [$1 ifnonnull _.ifnonnull] - [$2 if-icmpeq _.if-icmpeq] - [$2 if-icmpne _.if-icmpne] - [$2 if-icmplt _.if-icmplt] - [$2 if-icmpge _.if-icmpge] - [$2 if-icmpgt _.if-icmpgt] - [$2 if-icmple _.if-icmple] + [$2 if_icmpeq _.if_icmpeq] + [$2 if_icmpne _.if_icmpne] + [$2 if_icmplt _.if_icmplt] + [$2 if_icmpge _.if_icmpge] + [$2 if_icmpgt _.if_icmpgt] + [$2 if_icmple _.if_icmple] - [$2 if-acmpeq _.if-acmpeq] - [$2 if-acmpne _.if-acmpne] + [$2 if_acmpeq _.if_acmpeq] + [$2 if_acmpne _.if_acmpne] ) -(template [<name> <instruction> <on-long-jump> <on-short-jump>] +(template [<name> <instruction> <on_long_jump> <on_short_jump>] [(def: #export (<name> label) (-> Label (Bytecode Any)) (let [[estimator bytecode] <instruction>] (function (_ [pool environment tracker]) (do try.monad [actual (/environment.stack environment) - #let [@here (get@ #program-counter tracker)] - program-counter' (step estimator @here)] + #let [@here (get@ #program_counter tracker)] + program_counter' (step estimator @here)] (wrap (let [@from @here] [[pool (/environment.discontinue environment) (|> tracker - (..acknowledge-label actual label) - (set@ #program-counter program-counter'))] + (..acknowledge_label actual label) + (set@ #program_counter program_counter'))] [(function (_ resolver) (case (dictionary.get label resolver) (#.Some [expected (#.Some @to)]) (do try.monad - [_ (exception.assert ..mismatched-environments [(name-of <instruction>) label @here expected actual] + [_ (exception.assert ..mismatched_environments [(name_of <instruction>) label @here expected actual] (\ /stack.equivalence = expected actual)) jump (..jump @from @to)] (case jump (#.Left jump) - <on-long-jump> + <on_long_jump> (#.Right jump) - <on-short-jump>)) + <on_short_jump>)) (#.Some [expected #.None]) - (exception.throw ..unset-label [label]) + (exception.throw ..unset_label [label]) #.None - (exception.throw ..unknown-label [label]))) + (exception.throw ..unknown_label [label]))) []]]))))))] [goto _.goto - (exception.throw ..cannot-do-a-big-jump [label @from jump]) - (wrap [..no-exceptions (bytecode jump)])] - [goto-w _.goto-w - (wrap [..no-exceptions (bytecode jump)]) - (wrap [..no-exceptions (bytecode (/jump.lift jump))])] + (exception.throw ..cannot_do_a_big_jump [label @from jump]) + (wrap [..no_exceptions (bytecode jump)])] + [goto_w _.goto_w + (wrap [..no_exceptions (bytecode jump)]) + (wrap [..no_exceptions (bytecode (/jump.lift jump))])] ) -(def: (big-jump jump) - (-> Any-Jump Big-Jump) +(def: (big_jump jump) + (-> Any_Jump Big_Jump) (case jump (#.Left big) big @@ -831,9 +831,9 @@ (#.Right small) (/jump.lift small))) -(exception: #export invalid-tableswitch) +(exception: #export invalid_tableswitch) -(def: #export (tableswitch minimum default [at-minimum afterwards]) +(def: #export (tableswitch minimum default [at_minimum afterwards]) (-> S4 Label [Label (List Label)] (Bytecode Any)) (let [[estimator bytecode] _.tableswitch] (function (_ [pool environment tracker]) @@ -841,36 +841,36 @@ [environment' (|> environment (/environment.consumes $1)) actual (/environment.stack environment') - program-counter' (step (estimator (list.size afterwards)) (get@ #program-counter tracker))] - (wrap (let [@from (get@ #program-counter tracker)] + program_counter' (step (estimator (list.size afterwards)) (get@ #program_counter tracker))] + (wrap (let [@from (get@ #program_counter tracker)] [[pool environment' - (|> (list\fold (..acknowledge-label actual) tracker (list& default at-minimum afterwards)) - (set@ #program-counter program-counter'))] + (|> (list\fold (..acknowledge_label actual) tracker (list& default at_minimum afterwards)) + (set@ #program_counter program_counter'))] [(function (_ resolver) (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) (dictionary.get label resolver)))] (case (do {! maybe.monad} [@default (|> default get (monad.bind ! product.right)) - @at-minimum (|> at-minimum get (monad.bind ! product.right)) + @at_minimum (|> at_minimum get (monad.bind ! product.right)) @afterwards (|> afterwards (monad.map ! get) (monad.bind ! (monad.map ! product.right)))] - (wrap [@default @at-minimum @afterwards])) - (#.Some [@default @at-minimum @afterwards]) + (wrap [@default @at_minimum @afterwards])) + (#.Some [@default @at_minimum @afterwards]) (do {! try.monad} - [>default (\ ! map ..big-jump (..jump @from @default)) - >at-minimum (\ ! map ..big-jump (..jump @from @at-minimum)) - >afterwards (monad.map ! (|>> (..jump @from) (\ ! map ..big-jump)) + [>default (\ ! map ..big_jump (..jump @from @default)) + >at_minimum (\ ! map ..big_jump (..jump @from @at_minimum)) + >afterwards (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump)) @afterwards)] - (wrap [..no-exceptions (bytecode minimum >default [>at-minimum >afterwards])])) + (wrap [..no_exceptions (bytecode minimum >default [>at_minimum >afterwards])])) #.None - (exception.throw ..invalid-tableswitch [])))) + (exception.throw ..invalid_tableswitch [])))) []]])))))) -(exception: #export invalid-lookupswitch) +(exception: #export invalid_lookupswitch) (def: #export (lookupswitch default cases) (-> Label (List [S4 Label]) (Bytecode Any)) @@ -884,12 +884,12 @@ [environment' (|> environment (/environment.consumes $1)) actual (/environment.stack environment') - program-counter' (step (estimator (list.size cases)) (get@ #program-counter tracker))] - (wrap (let [@from (get@ #program-counter tracker)] + program_counter' (step (estimator (list.size cases)) (get@ #program_counter tracker))] + (wrap (let [@from (get@ #program_counter tracker)] [[pool environment' - (|> (list\fold (..acknowledge-label actual) tracker (list& default (list\map product.right cases))) - (set@ #program-counter program-counter'))] + (|> (list\fold (..acknowledge_label actual) tracker (list& default (list\map product.right cases))) + (set@ #program_counter program_counter'))] [(function (_ resolver) (let [get (: (-> Label (Maybe [Stack (Maybe Address)])) (function (_ label) @@ -902,14 +902,14 @@ (wrap [@default @cases])) (#.Some [@default @cases]) (do {! try.monad} - [>default (\ ! map ..big-jump (..jump @from @default)) + [>default (\ ! map ..big_jump (..jump @from @default)) >cases (|> @cases - (monad.map ! (|>> (..jump @from) (\ ! map ..big-jump))) + (monad.map ! (|>> (..jump @from) (\ ! map ..big_jump))) (\ ! map (|>> (list.zip/2 (list\map product.left cases)))))] - (wrap [..no-exceptions (bytecode >default >cases)])) + (wrap [..no_exceptions (bytecode >default >cases)])) #.None - (exception.throw ..invalid-lookupswitch [])))) + (exception.throw ..invalid_lookupswitch [])))) []]])))))) (def: reflection @@ -937,7 +937,7 @@ [register (..register register)] (..bytecode $0 $0 (/registry.for register) _.iinc [register increase]))) -(exception: #export (multiarray-cannot-be-zero-dimensional {class (Type Object)}) +(exception: #export (multiarray_cannot_be_zero_dimensional {class (Type Object)}) (exception.report ["Class" (..reflection class)])) (def: #export (multianewarray class dimensions) @@ -945,12 +945,12 @@ (do ..monad [_ (: (Bytecode Any) (case (|> dimensions //unsigned.value) - 0 (..throw ..multiarray-cannot-be-zero-dimensional [class]) + 0 (..throw ..multiarray_cannot_be_zero_dimensional [class]) _ (wrap []))) index (..lift (//constant/pool.class (//name.internal (..reflection class))))] (..bytecode (//unsigned.lift/2 dimensions) $1 @_ _.multianewarray [index dimensions]))) -(def: (type-size type) +(def: (type_size type) (-> (Type Return) Nat) (cond (is? type.void type) 0 @@ -972,11 +972,11 @@ {#//constant/pool.name method #//constant/pool.descriptor (type.descriptor type)}) #let [consumption (|> inputs - (list\map ..type-size) + (list\map ..type_size) (list\fold n.+ (if <static?> 0 1)) //unsigned.u1 try.assume) - production (|> output ..type-size //unsigned.u1 try.assume)]] + production (|> output ..type_size //unsigned.u1 try.assume)]] (..bytecode (//unsigned.lift/2 consumption) (//unsigned.lift/2 production) @_ @@ -985,7 +985,7 @@ [#1 invokestatic _.invokestatic //constant/pool.method] [#0 invokevirtual _.invokevirtual //constant/pool.method] [#0 invokespecial _.invokespecial //constant/pool.method] - [#0 invokeinterface _.invokeinterface //constant/pool.interface-method] + [#0 invokeinterface _.invokeinterface //constant/pool.interface_method] ) (template [<consumption> <name> <1> <2>] @@ -1007,7 +1007,7 @@ [$2 putfield _.putfield/1 _.putfield/2] ) -(exception: #export (invalid-range-for-try {start Address} {end Address}) +(exception: #export (invalid_range_for_try {start Address} {end Address}) (exception.report ["Start" (|> start /address.value //unsigned.value %.nat)] ["End" (|> end /address.value //unsigned.value %.nat)])) @@ -1020,15 +1020,15 @@ (#try.Success [[pool environment - (..acknowledge-label /stack.catch @handler tracker)] + (..acknowledge_label /stack.catch @handler tracker)] [(function (_ resolver) (do try.monad - [[_ @start] (..resolve-label @start resolver) - [_ @end] (..resolve-label @end resolver) + [[_ @start] (..resolve_label @start resolver) + [_ @end] (..resolve_label @end resolver) _ (if (/address.after? @start @end) (wrap []) - (exception.throw ..invalid-range-for-try [@start @end])) - [_ @handler] (..resolve-label @handler resolver)] + (exception.throw ..invalid_range_for_try [@start @end])) + [_ @handler] (..resolve_label @handler resolver)] (wrap [(row.row {#//exception.start @start #//exception.end @end #//exception.handler @handler diff --git a/stdlib/source/lux/target/jvm/bytecode/address.lux b/stdlib/source/lux/target/jvm/bytecode/address.lux index 9f003db8d..6a16ab5cd 100644 --- a/stdlib/source/lux/target/jvm/bytecode/address.lux +++ b/stdlib/source/lux/target/jvm/bytecode/address.lux @@ -15,7 +15,7 @@ [type abstract]] ["." // #_ - [jump (#+ Big-Jump)] + [jump (#+ Big_Jump)] ["/#" // #_ [encoding ["#." unsigned (#+ U2)] @@ -38,15 +38,15 @@ (///unsigned.+/2 distance) (\ try.functor map (|>> :abstraction)))) - (def: with-sign + (def: with_sign (-> Address (Try S4)) (|>> :representation ///unsigned.value .int ///signed.s4)) (def: #export (jump from to) - (-> Address Address (Try Big-Jump)) + (-> Address Address (Try Big_Jump)) (do try.monad - [from (with-sign from) - to (with-sign to)] + [from (with_sign from) + to (with_sign to)] (///signed.-/4 from to))) (def: #export (after? reference subject) diff --git a/stdlib/source/lux/target/jvm/bytecode/environment.lux b/stdlib/source/lux/target/jvm/bytecode/environment.lux index 7d70bdd81..932fe0e28 100644 --- a/stdlib/source/lux/target/jvm/bytecode/environment.lux +++ b/stdlib/source/lux/target/jvm/bytecode/environment.lux @@ -61,7 +61,7 @@ (-> Environment Environment) (set@ #..stack #.None)) -(exception: #export (mismatched-stacks {expected Stack} +(exception: #export (mismatched_stacks {expected Stack} {actual Stack}) (exception.report ["Expected" (/stack.format expected)] @@ -73,7 +73,7 @@ (#.Some actual) (if (\ /stack.equivalence = expected actual) (#try.Success [actual environment]) - (exception.throw ..mismatched-stacks [expected actual])) + (exception.throw ..mismatched_stacks [expected actual])) #.None (#try.Success [expected (set@ #..stack (#.Some expected) environment)]))) diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux index a0b8b67ab..802b99320 100644 --- a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux +++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux @@ -81,7 +81,7 @@ :abstraction)))] [for ..normal] - [for-wide ..wide] + [for_wide ..wide] ) ) diff --git a/stdlib/source/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/lux/target/jvm/bytecode/instruction.lux index f72314163..91bba4ec3 100644 --- a/stdlib/source/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/lux/target/jvm/bytecode/instruction.lux @@ -21,7 +21,7 @@ abstract]] ["." // #_ ["#." address (#+ Address)] - ["#." jump (#+ Jump Big-Jump)] + ["#." jump (#+ Jump Big_Jump)] [environment [limit [registry (#+ Register)]]] @@ -52,50 +52,50 @@ (def: #export run (-> Instruction Specification) - (function.apply format.no-op)) + (function.apply format.no_op)) (type: Opcode Nat) (template [<name> <size>] [(def: <name> Size (|> <size> ///unsigned.u2 try.assume))] - [opcode-size 1] - [register-size 1] - [byte-size 1] - [index-size 2] - [big-jump-size 4] - [integer-size 4] + [opcode_size 1] + [register_size 1] + [byte_size 1] + [index_size 2] + [big_jump_size 4] + [integer_size 4] ) (def: (nullary' opcode) (-> Opcode Mutation) (function (_ [offset binary]) - [(n.+ (///unsigned.value ..opcode-size) + [(n.+ (///unsigned.value ..opcode_size) offset) (try.assume (binary.write/8 offset opcode binary))])) (def: nullary [Estimator (-> Opcode Instruction)] - [(..fixed ..opcode-size) + [(..fixed ..opcode_size) (function (_ opcode [size mutation]) - [(n.+ (///unsigned.value ..opcode-size) + [(n.+ (///unsigned.value ..opcode_size) size) (|>> mutation ((nullary' opcode)))])]) (template [<name> <size>] [(def: <name> Size - (|> ..opcode-size + (|> ..opcode_size (///unsigned.+/2 <size>) try.assume))] - [size/1 ..register-size] - [size/2 ..index-size] - [size/4 ..big-jump-size] + [size/1 ..register_size] + [size/2 ..index_size] + [size/4 ..big_jump_size] ) (template [<shift> <name> <inputT> <writer> <unwrap>] - [(with-expansions [<private> (template.identifier ["'" <name>])] + [(with_expansions [<private> (template.identifier ["'" <name>])] (def: (<private> opcode input0) (-> Opcode <inputT> Mutation) (function (_ [offset binary]) @@ -103,7 +103,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary)] - (<writer> (n.+ (///unsigned.value ..opcode-size) offset) + (<writer> (n.+ (///unsigned.value ..opcode_size) offset) (<unwrap> input0) binary)))])) @@ -117,11 +117,11 @@ [..size/1 unary/1 U1 binary.write/8 ///unsigned.value] [..size/2 unary/2 U2 binary.write/16 ///unsigned.value] [..size/2 jump/2 Jump binary.write/16 ///signed.value] - [..size/4 jump/4 Big-Jump binary.write/32 ///signed.value] + [..size/4 jump/4 Big_Jump binary.write/32 ///signed.value] ) (template [<shift> <name> <inputT> <writer>] - [(with-expansions [<private> (template.identifier ["'" <name>])] + [(with_expansions [<private> (template.identifier ["'" <name>])] (def: (<private> opcode input0) (-> Opcode <inputT> Mutation) (function (_ [offset binary]) @@ -129,7 +129,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary)] - (<writer> (n.+ (///unsigned.value ..opcode-size) offset) + (<writer> (n.+ (///unsigned.value ..opcode_size) offset) (///signed.value input0) binary)))])) @@ -146,9 +146,9 @@ (def: size/11 Size - (|> ..opcode-size - (///unsigned.+/2 ..register-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume)) + (|> ..opcode_size + (///unsigned.+/2 ..register_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume)) (def: (binary/11' opcode input0 input1) (-> Opcode U1 U1 Mutation) @@ -157,7 +157,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary) - _ (binary.write/8 (n.+ (///unsigned.value ..opcode-size) offset) + _ (binary.write/8 (n.+ (///unsigned.value ..opcode_size) offset) (///unsigned.value input0) binary)] (binary.write/8 (n.+ (///unsigned.value ..size/1) offset) @@ -173,9 +173,9 @@ (def: size/21 Size - (|> ..opcode-size - (///unsigned.+/2 ..index-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume)) + (|> ..opcode_size + (///unsigned.+/2 ..index_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume)) (def: (binary/21' opcode input0 input1) (-> Opcode U2 U1 Mutation) @@ -184,7 +184,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary) - _ (binary.write/16 (n.+ (///unsigned.value ..opcode-size) offset) + _ (binary.write/16 (n.+ (///unsigned.value ..opcode_size) offset) (///unsigned.value input0) binary)] (binary.write/8 (n.+ (///unsigned.value ..size/2) offset) @@ -200,10 +200,10 @@ (def: size/211 Size - (|> ..opcode-size - (///unsigned.+/2 ..index-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume - (///unsigned.+/2 ..byte-size) try.assume)) + (|> ..opcode_size + (///unsigned.+/2 ..index_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume + (///unsigned.+/2 ..byte_size) try.assume)) (def: (trinary/211' opcode input0 input1 input2) (-> Opcode U2 U1 U1 Mutation) @@ -212,7 +212,7 @@ (try.assume (do try.monad [_ (binary.write/8 offset opcode binary) - _ (binary.write/16 (n.+ (///unsigned.value ..opcode-size) offset) + _ (binary.write/16 (n.+ (///unsigned.value ..opcode_size) offset) (///unsigned.value input0) binary) _ (binary.write/8 (n.+ (///unsigned.value ..size/2) offset) @@ -229,50 +229,50 @@ [(n.+ (///unsigned.value ..size/211) size) (|>> mutation ((trinary/211' opcode input0 input1 input2)))])]) -(abstract: #export Primitive-Array-Type +(abstract: #export Primitive_Array_Type U1 (def: code - (-> Primitive-Array-Type U1) + (-> Primitive_Array_Type U1) (|>> :representation)) (template [<code> <name>] [(def: #export <name> (|> <code> ///unsigned.u1 try.assume :abstraction))] - [04 t-boolean] - [05 t-char] - [06 t-float] - [07 t-double] - [08 t-byte] - [09 t-short] - [10 t-int] - [11 t-long] + [04 t_boolean] + [05 t_char] + [06 t_float] + [07 t_double] + [08 t_byte] + [09 t_short] + [10 t_int] + [11 t_long] )) ## https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-6.html#jvms-6.5 -(with-expansions [<constants> (template [<code> <name>] +(with_expansions [<constants> (template [<code> <name>] [[<code> <name> [] []]] - ["01" aconst-null] + ["01" aconst_null] - ["02" iconst-m1] - ["03" iconst-0] - ["04" iconst-1] - ["05" iconst-2] - ["06" iconst-3] - ["07" iconst-4] - ["08" iconst-5] + ["02" iconst_m1] + ["03" iconst_0] + ["04" iconst_1] + ["05" iconst_2] + ["06" iconst_3] + ["07" iconst_4] + ["08" iconst_5] - ["09" lconst-0] - ["0A" lconst-1] + ["09" lconst_0] + ["0A" lconst_1] - ["0B" fconst-0] - ["0C" fconst-1] - ["0D" fconst-2] + ["0B" fconst_0] + ["0C" fconst_1] + ["0D" fconst_2] - ["0E" dconst-0] - ["0F" dconst-1]) - <register-loads> (template [<code> <name>] + ["0E" dconst_0] + ["0F" dconst_1]) + <register_loads> (template [<code> <name>] [[<code> <name> [[register Register]] [register]]] ["15" iload] @@ -280,34 +280,34 @@ ["17" fload] ["18" dload] ["19" aload]) - <simple-register-loads> (template [<code> <name>] + <simple_register_loads> (template [<code> <name>] [[<code> <name> [] []]] - ["1A" iload-0] - ["1B" iload-1] - ["1C" iload-2] - ["1D" iload-3] + ["1A" iload_0] + ["1B" iload_1] + ["1C" iload_2] + ["1D" iload_3] - ["1E" lload-0] - ["1F" lload-1] - ["20" lload-2] - ["21" lload-3] + ["1E" lload_0] + ["1F" lload_1] + ["20" lload_2] + ["21" lload_3] - ["22" fload-0] - ["23" fload-1] - ["24" fload-2] - ["25" fload-3] + ["22" fload_0] + ["23" fload_1] + ["24" fload_2] + ["25" fload_3] - ["26" dload-0] - ["27" dload-1] - ["28" dload-2] - ["29" dload-3] + ["26" dload_0] + ["27" dload_1] + ["28" dload_2] + ["29" dload_3] - ["2A" aload-0] - ["2B" aload-1] - ["2C" aload-2] - ["2D" aload-3]) - <register-stores> (template [<code> <name>] + ["2A" aload_0] + ["2B" aload_1] + ["2C" aload_2] + ["2D" aload_3]) + <register_stores> (template [<code> <name>] [[<code> <name> [[register Register]] [register]]] ["36" istore] @@ -315,34 +315,34 @@ ["38" fstore] ["39" dstore] ["3A" astore]) - <simple-register-stores> (template [<code> <name>] + <simple_register_stores> (template [<code> <name>] [[<code> <name> [] []]] - ["3B" istore-0] - ["3C" istore-1] - ["3D" istore-2] - ["3E" istore-3] - - ["3F" lstore-0] - ["40" lstore-1] - ["41" lstore-2] - ["42" lstore-3] - - ["43" fstore-0] - ["44" fstore-1] - ["45" fstore-2] - ["46" fstore-3] - - ["47" dstore-0] - ["48" dstore-1] - ["49" dstore-2] - ["4A" dstore-3] + ["3B" istore_0] + ["3C" istore_1] + ["3D" istore_2] + ["3E" istore_3] + + ["3F" lstore_0] + ["40" lstore_1] + ["41" lstore_2] + ["42" lstore_3] + + ["43" fstore_0] + ["44" fstore_1] + ["45" fstore_2] + ["46" fstore_3] + + ["47" dstore_0] + ["48" dstore_1] + ["49" dstore_2] + ["4A" dstore_3] - ["4B" astore-0] - ["4C" astore-1] - ["4D" astore-2] - ["4E" astore-3]) - <array-loads> (template [<code> <name>] + ["4B" astore_0] + ["4C" astore_1] + ["4D" astore_2] + ["4E" astore_3]) + <array_loads> (template [<code> <name>] [[<code> <name> [] []]] ["2E" iaload] @@ -353,7 +353,7 @@ ["33" baload] ["34" caload] ["35" saload]) - <array-stores> (template [<code> <name>] + <array_stores> (template [<code> <name>] [[<code> <name> [] []]] ["4f" iastore] @@ -454,15 +454,15 @@ ["9D" ifgt] ["9E" ifle] - ["9F" if-icmpeq] - ["A0" if-icmpne] - ["A1" if-icmplt] - ["A2" if-icmpge] - ["A3" if-icmpgt] - ["A4" if-icmple] + ["9F" if_icmpeq] + ["A0" if_icmpne] + ["A1" if_icmplt] + ["A2" if_icmpge] + ["A3" if_icmpgt] + ["A4" if_icmple] - ["A5" if-acmpeq] - ["A6" if-acmpne] + ["A5" if_acmpeq] + ["A6" if_acmpne] ["A7" goto] ["A8" jsr] @@ -477,23 +477,23 @@ ["B4" getfield/1] ["B4" getfield/2] ["B5" putfield/1] ["B5" putfield/2])] (template [<arity> <definitions>] - [(with-expansions [<definitions>' (template.splice <definitions>)] - (template [<code> <name> <instruction-inputs> <arity-inputs>] - [(with-expansions [<inputs>' (template.splice <instruction-inputs>) - <input-types> (template [<input-name> <input-type>] - [<input-type>] + [(with_expansions [<definitions>' (template.splice <definitions>)] + (template [<code> <name> <instruction_inputs> <arity_inputs>] + [(with_expansions [<inputs>' (template.splice <instruction_inputs>) + <input_types> (template [<input_name> <input_type>] + [<input_type>] <inputs>') - <input-names> (template [<input-name> <input-type>] - [<input-name>] + <input_names> (template [<input_name> <input_type>] + [<input_name>] <inputs>')] (def: #export <name> - [Estimator (-> [<input-types>] Instruction)] + [Estimator (-> [<input_types>] Instruction)] (let [[estimator <arity>'] <arity>] [estimator - (function (_ [<input-names>]) - (`` (<arity>' (hex <code>) (~~ (template.splice <arity-inputs>)))))])))] + (function (_ [<input_names>]) + (`` (<arity>' (hex <code>) (~~ (template.splice <arity_inputs>)))))])))] <definitions>' ))] @@ -504,16 +504,16 @@ ["57" pop [] []] ["58" pop2 [] []] ["59" dup [] []] - ["5A" dup-x1 [] []] - ["5B" dup-x2 [] []] + ["5A" dup_x1 [] []] + ["5B" dup_x2 [] []] ["5C" dup2 [] []] - ["5D" dup2-x1 [] []] - ["5E" dup2-x2 [] []] + ["5D" dup2_x1 [] []] + ["5E" dup2_x2 [] []] ["5F" swap [] []] - <simple-register-loads> - <array-loads> - <simple-register-stores> - <array-stores> + <simple_register_loads> + <array_loads> + <simple_register_stores> + <array_stores> <arithmetic> ["79" lshl [] []] ["7B" lshr [] []] @@ -528,28 +528,28 @@ [..unary/1 [["12" ldc [[index U1]] [index]] - <register-loads> - <register-stores> + <register_loads> + <register_stores> ["A9" ret [[register Register]] [register]] - ["BC" newarray [[type Primitive-Array-Type]] [(..code type)]]]] + ["BC" newarray [[type Primitive_Array_Type]] [(..code type)]]]] [..unary/1' [["10" bipush [[byte S1]] [byte]]]] [..unary/2 - [["13" ldc-w/integer [[index (Index ///constant.Integer)]] [(///index.value index)]] - ["13" ldc-w/float [[index (Index ///constant.Float)]] [(///index.value index)]] - ["13" ldc-w/string [[index (Index ///constant.String)]] [(///index.value index)]] - ["14" ldc2-w/long [[index (Index ///constant.Long)]] [(///index.value index)]] - ["14" ldc2-w/double [[index (Index ///constant.Double)]] [(///index.value index)]] + [["13" ldc_w/integer [[index (Index ///constant.Integer)]] [(///index.value index)]] + ["13" ldc_w/float [[index (Index ///constant.Float)]] [(///index.value index)]] + ["13" ldc_w/string [[index (Index ///constant.String)]] [(///index.value index)]] + ["14" ldc2_w/long [[index (Index ///constant.Long)]] [(///index.value index)]] + ["14" ldc2_w/double [[index (Index ///constant.Double)]] [(///index.value index)]] <fields> ["BB" new [[index (Index Class)]] [(///index.value index)]] ["BD" anewarray [[index (Index Class)]] [(///index.value index)]] ["C0" checkcast [[index (Index Class)]] [(///index.value index)]] ["C1" instanceof [[index (Index Class)]] [(///index.value index)]] - ["B6" invokevirtual [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]] - ["B7" invokespecial [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]] - ["B8" invokestatic [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index)]]]] + ["B6" invokevirtual [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]] + ["B7" invokespecial [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]] + ["B8" invokestatic [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index)]]]] [..unary/2' [["11" sipush [[short S2]] [short]]]] @@ -558,8 +558,8 @@ [<jumps>]] [..jump/4 - [["C8" goto-w [[jump Big-Jump]] [jump]] - ["C9" jsr-w [[jump Big-Jump]] [jump]]]] + [["C8" goto_w [[jump Big_Jump]] [jump]] + ["C9" jsr_w [[jump Big_Jump]] [jump]]]] [..binary/11 [["84" iinc [[register Register] [byte U1]] [register byte]]]] @@ -568,52 +568,52 @@ [["C5" multianewarray [[index (Index Class)] [count U1]] [(///index.value index) count]]]] [..trinary/211 - [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output-count U1]] [(///index.value index) count (try.assume (///unsigned.u1 0))]]]] + [["B9" invokeinterface [[index (Index (Reference Method))] [count U1] [output_count U1]] [(///index.value index) count (try.assume (///unsigned.u1 0))]]]] )) -(def: (switch-padding offset) +(def: (switch_padding offset) (-> Nat Nat) - (let [parameter-start (n.+ (///unsigned.value ..opcode-size) + (let [parameter_start (n.+ (///unsigned.value ..opcode_size) offset)] (n.% 4 - (n.- (n.% 4 parameter-start) + (n.- (n.% 4 parameter_start) 4)))) (def: #export tableswitch [(-> Nat Estimator) - (-> S4 Big-Jump [Big-Jump (List Big-Jump)] Instruction)] + (-> S4 Big_Jump [Big_Jump (List Big_Jump)] Instruction)] (let [estimator (: (-> Nat Estimator) - (function (_ amount-of-afterwards offset) + (function (_ amount_of_afterwards offset) (|> ($_ n.+ - (///unsigned.value ..opcode-size) - (switch-padding (///unsigned.value (//address.value offset))) - (///unsigned.value ..big-jump-size) - (///unsigned.value ..integer-size) - (///unsigned.value ..integer-size) - (n.* (///unsigned.value ..big-jump-size) - (inc amount-of-afterwards))) + (///unsigned.value ..opcode_size) + (switch_padding (///unsigned.value (//address.value offset))) + (///unsigned.value ..big_jump_size) + (///unsigned.value ..integer_size) + (///unsigned.value ..integer_size) + (n.* (///unsigned.value ..big_jump_size) + (inc amount_of_afterwards))) ///unsigned.u2 try.assume)))] [estimator - (function (_ minimum default [at-minimum afterwards]) - (let [amount-of-afterwards (list.size afterwards) - estimator (estimator amount-of-afterwards)] + (function (_ minimum default [at_minimum afterwards]) + (let [amount_of_afterwards (list.size afterwards) + estimator (estimator amount_of_afterwards)] (function (_ [size mutation]) - (let [padding (switch-padding size) - tableswitch-size (try.assume + (let [padding (switch_padding size) + tableswitch_size (try.assume (do {! try.monad} [size (///unsigned.u2 size)] (\ ! map (|>> estimator ///unsigned.value) (//address.move size //address.start)))) - tableswitch-mutation (: Mutation + tableswitch_mutation (: Mutation (function (_ [offset binary]) - [(n.+ tableswitch-size offset) + [(n.+ tableswitch_size offset) (try.assume (do {! try.monad} - [amount-of-afterwards (|> amount-of-afterwards .int ///signed.s4) - maximum (///signed.+/4 minimum amount-of-afterwards) + [amount_of_afterwards (|> amount_of_afterwards .int ///signed.s4) + maximum (///signed.+/4 minimum amount_of_afterwards) _ (binary.write/8 offset (hex "AA") binary) - #let [offset (n.+ (///unsigned.value ..opcode-size) offset)] + #let [offset (n.+ (///unsigned.value ..opcode_size) offset)] _ (case padding 3 (do ! [_ (binary.write/8 offset 0 binary)] @@ -623,13 +623,13 @@ _ (wrap binary)) #let [offset (n.+ padding offset)] _ (binary.write/32 offset (///signed.value default) binary) - #let [offset (n.+ (///unsigned.value ..big-jump-size) offset)] + #let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] _ (binary.write/32 offset (///signed.value minimum) binary) - #let [offset (n.+ (///unsigned.value ..integer-size) offset)] + #let [offset (n.+ (///unsigned.value ..integer_size) offset)] _ (binary.write/32 offset (///signed.value maximum) binary)] - (loop [offset (n.+ (///unsigned.value ..integer-size) offset) - afterwards (: (List Big-Jump) - (#.Cons at-minimum afterwards))] + (loop [offset (n.+ (///unsigned.value ..integer_size) offset) + afterwards (: (List Big_Jump) + (#.Cons at_minimum afterwards))] (case afterwards #.Nil (wrap binary) @@ -637,45 +637,45 @@ (#.Cons head tail) (do ! [_ (binary.write/32 offset (///signed.value head) binary)] - (recur (n.+ (///unsigned.value ..big-jump-size) offset) + (recur (n.+ (///unsigned.value ..big_jump_size) offset) tail))))))]))] - [(n.+ tableswitch-size + [(n.+ tableswitch_size size) - (|>> mutation tableswitch-mutation)]))))])) + (|>> mutation tableswitch_mutation)]))))])) (def: #export lookupswitch [(-> Nat Estimator) - (-> Big-Jump (List [S4 Big-Jump]) Instruction)] - (let [case-size (n.+ (///unsigned.value ..integer-size) - (///unsigned.value ..big-jump-size)) + (-> Big_Jump (List [S4 Big_Jump]) Instruction)] + (let [case_size (n.+ (///unsigned.value ..integer_size) + (///unsigned.value ..big_jump_size)) estimator (: (-> Nat Estimator) - (function (_ amount-of-cases offset) + (function (_ amount_of_cases offset) (|> ($_ n.+ - (///unsigned.value ..opcode-size) - (switch-padding (///unsigned.value (//address.value offset))) - (///unsigned.value ..big-jump-size) - (///unsigned.value ..integer-size) - (n.* amount-of-cases case-size)) + (///unsigned.value ..opcode_size) + (switch_padding (///unsigned.value (//address.value offset))) + (///unsigned.value ..big_jump_size) + (///unsigned.value ..integer_size) + (n.* amount_of_cases case_size)) ///unsigned.u2 try.assume)))] [estimator (function (_ default cases) - (let [amount-of-cases (list.size cases) - estimator (estimator amount-of-cases)] + (let [amount_of_cases (list.size cases) + estimator (estimator amount_of_cases)] (function (_ [size mutation]) - (let [padding (switch-padding size) - lookupswitch-size (try.assume + (let [padding (switch_padding size) + lookupswitch_size (try.assume (do {! try.monad} [size (///unsigned.u2 size)] (\ ! map (|>> estimator ///unsigned.value) (//address.move size //address.start)))) - lookupswitch-mutation (: Mutation + lookupswitch_mutation (: Mutation (function (_ [offset binary]) - [(n.+ lookupswitch-size offset) + [(n.+ lookupswitch_size offset) (try.assume (do {! try.monad} [_ (binary.write/8 offset (hex "AB") binary) - #let [offset (n.+ (///unsigned.value ..opcode-size) offset)] + #let [offset (n.+ (///unsigned.value ..opcode_size) offset)] _ (case padding 3 (do ! [_ (binary.write/8 offset 0 binary)] @@ -685,9 +685,9 @@ _ (wrap binary)) #let [offset (n.+ padding offset)] _ (binary.write/32 offset (///signed.value default) binary) - #let [offset (n.+ (///unsigned.value ..big-jump-size) offset)] - _ (binary.write/32 offset amount-of-cases binary)] - (loop [offset (n.+ (///unsigned.value ..integer-size) offset) + #let [offset (n.+ (///unsigned.value ..big_jump_size) offset)] + _ (binary.write/32 offset amount_of_cases binary)] + (loop [offset (n.+ (///unsigned.value ..integer_size) offset) cases cases] (case cases #.Nil @@ -696,12 +696,12 @@ (#.Cons [value jump] tail) (do ! [_ (binary.write/32 offset (///signed.value value) binary) - _ (binary.write/32 (n.+ (///unsigned.value ..integer-size) offset) (///signed.value jump) binary)] - (recur (n.+ case-size offset) + _ (binary.write/32 (n.+ (///unsigned.value ..integer_size) offset) (///signed.value jump) binary)] + (recur (n.+ case_size offset) tail))))))]))] - [(n.+ lookupswitch-size + [(n.+ lookupswitch_size size) - (|>> mutation lookupswitch-mutation)]))))])) + (|>> mutation lookupswitch_mutation)]))))])) (structure: #export monoid (Monoid Instruction) diff --git a/stdlib/source/lux/target/jvm/bytecode/jump.lux b/stdlib/source/lux/target/jvm/bytecode/jump.lux index 79ec9fa9b..4670b07ea 100644 --- a/stdlib/source/lux/target/jvm/bytecode/jump.lux +++ b/stdlib/source/lux/target/jvm/bytecode/jump.lux @@ -19,8 +19,8 @@ (Writer Jump) ///signed.writer/2) -(type: #export Big-Jump S4) +(type: #export Big_Jump S4) (def: #export lift - (-> Jump Big-Jump) + (-> Jump Big_Jump) ///signed.lift/4) |