diff options
Diffstat (limited to 'stdlib/source/library/lux/target/jvm/bytecode.lux')
| -rw-r--r-- | stdlib/source/library/lux/target/jvm/bytecode.lux | 134 |
1 files changed, 67 insertions, 67 deletions
diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux index 882c0dfdf..99901a4a3 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode.lux @@ -64,7 +64,7 @@ #next Label #known Resolver])) -(def: fresh +(def fresh Tracker [#program_counter /address.start #next 0 @@ -73,16 +73,16 @@ (type: .public Relative (-> Resolver (Try [(Sequence Exception) Instruction]))) -(def: no_exceptions +(def no_exceptions (Sequence Exception) sequence.empty) -(def: relative#identity +(def relative#identity Relative (function (_ _) {try.#Success [..no_exceptions _.empty]})) -(def: try|do +(def try|do (template (_ <binding> <term> <then>) [(.case <term> {try.#Success <binding>} @@ -91,11 +91,11 @@ failure (as_expected failure))])) -(def: try|in +(def try|in (template (_ <it>) [{try.#Success <it>}])) -(def: (relative#composite left right) +(def (relative#composite left right) (-> Relative Relative Relative) (cond (same? ..relative#identity left) right @@ -110,16 +110,16 @@ (try|in [(at sequence.monoid composite left_exceptions right_exceptions) (_#composite left_instruction right_instruction)]))))) -(def: relative_monoid +(def relative_monoid (Monoid Relative) (implementation - (def: identity ..relative#identity) - (def: composite ..relative#composite))) + (def identity ..relative#identity) + (def composite ..relative#composite))) (type: .public (Bytecode a) (+State Try [Pool Environment Tracker] (Writer Relative a))) -(def: .public new_label +(def .public new_label (Bytecode Label) (function (_ [pool environment tracker]) {try.#Success [[pool @@ -144,7 +144,7 @@ "Expected" (/stack.format expected) "Actual" (/stack.format actual))) -(def: .public (set? label) +(def .public (set? label) (-> Label (Bytecode (Maybe [Stack Address]))) (function (_ state) (let [[pool environment tracker] state] @@ -157,7 +157,7 @@ _ {.#None})]]}))) -(def: .public (acknowledged? label) +(def .public (acknowledged? label) (-> Label (Bytecode (Maybe Stack))) (function (_ state) (let [[pool environment tracker] state] @@ -170,7 +170,7 @@ _ {.#None})]]}))) -(def: .public stack +(def .public stack (Bytecode (Maybe Stack)) (function (_ state) (let [[pool environment tracker] state] @@ -185,7 +185,7 @@ tracker)] [..relative#identity []]]))] - (def: .public (set_label label) + (def .public (set_label label) (-> Label (Bytecode Any)) (function (_ [pool environment tracker]) (let [@here (the #program_counter tracker)] @@ -205,10 +205,10 @@ environment)) <success>)))))) -(def: .public functor +(def .public functor (Functor Bytecode) (implementation - (def: (each $ it) + (def (each $ it) (function (_ state) (case (it state) {try.#Success [state' [relative it]]} @@ -218,16 +218,16 @@ failure (as_expected failure)))))) -(def: .public monad +(def .public monad (Monad Bytecode) (implementation - (def: functor ..functor) + (def functor ..functor) - (def: (in it) + (def (in it) (function (_ state) {try.#Success [state [relative#identity it]]})) - (def: (conjoint ^^it) + (def (conjoint ^^it) (function (_ state) (case (^^it state) {try.#Success [state' [left ^it]]} @@ -243,7 +243,7 @@ failure (as_expected failure)))))) -(def: .public (when_continuous it) +(def .public (when_continuous it) (-> (Bytecode Any) (Bytecode Any)) (do ..monad [stack ..stack] @@ -255,7 +255,7 @@ _ (in [])))) -(def: .public (when_acknowledged @ it) +(def .public (when_acknowledged @ it) (-> Label (Bytecode Any) (Bytecode Any)) (do ..monad [?@ (..acknowledged? @)] @@ -267,27 +267,27 @@ _ (in [])))) -(def: .public (failure error) +(def .public (failure error) (-> Text Bytecode) (function (_ _) {try.#Failure error})) -(def: .public (except exception value) +(def .public (except exception value) (All (_ e) (-> (exception.Exception e) e Bytecode)) (..failure (exception.error exception value))) -(def: .public (resolve environment bytecode) +(def .public (resolve environment bytecode) (All (_ a) (-> Environment (Bytecode a) (Resource [Environment (Sequence Exception) Instruction a]))) (function (_ pool) (<| (try|do [[pool environment tracker] [relative output]] (bytecode [pool environment ..fresh])) (try|do [exceptions instruction] (relative (the #known tracker))) (try|in [pool [environment exceptions instruction output]])))) -(def: (step estimator counter) +(def (step estimator counter) (-> Estimator Address (Try Address)) (/address.move (estimator counter) counter)) -(def: (bytecode consumption production registry [estimator bytecode] input) +(def (bytecode consumption production registry [estimator bytecode] input) (All (_ a) (-> U2 U2 Registry [Estimator (-> [a] Instruction)] a (Bytecode Any))) (function (_ [pool environment tracker]) (<| (try|do environment' (|> environment @@ -304,7 +304,7 @@ []]])))) (with_template [<name> <frames>] - [(def: <name> U2 + [(def <name> U2 (|> <frames> //unsigned.u2 try.trusted))] [$0 0] @@ -317,7 +317,7 @@ ) (with_template [<name> <registry>] - [(def: <name> Registry (|> <registry> //unsigned.u2 try.trusted /registry.registry))] + [(def <name> Registry (|> <registry> //unsigned.u2 try.trusted /registry.registry))] [@_ 0] [@0 1] @@ -328,7 +328,7 @@ ) (with_template [<name> <consumption> <production> <registry> <instruction>] - [(def: .public <name> + [(def .public <name> (Bytecode Any) (..bytecode <consumption> <production> @@ -511,7 +511,7 @@ [monitorexit $1 $0 @_ _.monitorexit] ) -(def: discontinuity! +(def discontinuity! (Bytecode Any) (function (_ [pool environment tracker]) (<| (try|do _ (/environment.stack environment)) @@ -522,7 +522,7 @@ []]])))) (with_template [<name> <consumption> <instruction>] - [(def: .public <name> + [(def .public <name> (Bytecode Any) (do ..monad [_ (..bytecode <consumption> $0 @_ <instruction> [])] @@ -538,11 +538,11 @@ [athrow $1 _.athrow] ) -(def: .public (bipush byte) +(def .public (bipush byte) (-> S1 (Bytecode Any)) (..bytecode $0 $1 @_ _.bipush [byte])) -(def: (lifted resource) +(def (lifted resource) (All (_ a) (-> (Resource a) (Bytecode a))) @@ -552,7 +552,7 @@ [..relative#identity output]])))) -(def: .public (string value) +(def .public (string value) (-> //constant.UTF8 (Bytecode Any)) (do ..monad [index (..lifted (//constant/pool.string value))] @@ -572,7 +572,7 @@ ("static" doubleToRawLongBits "manual" [double] long)) (with_template [<name> <type> <constructor> <constant> <wide> <to_lux> <specializations>] - [(def: .public (<name> value) + [(def .public (<name> value) (-> <type> (Bytecode Any)) (case (|> value <to_lux>) (^.with_template [<special> <instruction>] @@ -599,7 +599,7 @@ [+5 _.iconst_5])] ) -(def: (arbitrary_float value) +(def (arbitrary_float value) (-> java/lang/Float (Bytecode Any)) (do ..monad [index (..lifted (//constant/pool.float (//constant.float value)))] @@ -610,16 +610,16 @@ {try.#Failure _} (..bytecode $0 $1 @_ _.ldc_w/float [index])))) -(def: float_bits +(def float_bits (-> java/lang/Float Int) (|>> java/lang/Float::floatToRawIntBits ffi.int_to_long (as Int))) -(def: negative_zero_float_bits +(def negative_zero_float_bits (|> -0.0 (as java/lang/Double) ffi.double_to_float ..float_bits)) -(def: .public (float value) +(def .public (float value) (-> java/lang/Float (Bytecode Any)) (if (i.= ..negative_zero_float_bits (..float_bits value)) @@ -634,7 +634,7 @@ _ (..arbitrary_float value)))) (with_template [<name> <type> <constructor> <constant> <wide> <to_lux> <specializations>] - [(def: .public (<name> value) + [(def .public (<name> value) (-> <type> (Bytecode Any)) (case (|> value <to_lux>) (^.with_template [<special> <instruction>] @@ -651,21 +651,21 @@ [+1 _.lconst_1])] ) -(def: (arbitrary_double value) +(def (arbitrary_double value) (-> java/lang/Double (Bytecode Any)) (do ..monad [index (..lifted (//constant/pool.double (//constant.double (as Frac value))))] (..bytecode $0 $2 @_ _.ldc2_w/double [index]))) -(def: double_bits +(def double_bits (-> java/lang/Double Int) (|>> java/lang/Double::doubleToRawLongBits (as Int))) -(def: negative_zero_double_bits +(def negative_zero_double_bits (..double_bits (as java/lang/Double -0.0))) -(def: .public (double value) +(def .public (double value) (-> java/lang/Double (Bytecode Any)) (if (i.= ..negative_zero_double_bits (..double_bits value)) @@ -682,7 +682,7 @@ (exception.report "ID" (%.nat id))) -(def: (register id) +(def (register id) (-> Nat (Bytecode Register)) (case (//unsigned.u1 id) {try.#Success register} @@ -692,7 +692,7 @@ (..except ..invalid_register [id]))) (with_template [<for> <size> <name> <general> <specials>] - [(def: .public (<name> local) + [(def .public (<name> local) (-> Nat (Bytecode Any)) (with_expansions [<specials>' (template.spliced <specials>)] (`` (case local @@ -732,7 +732,7 @@ ) (with_template [<for> <size> <name> <general> <specials>] - [(def: .public (<name> local) + [(def .public (<name> local) (-> Nat (Bytecode Any)) (with_expansions [<specials>' (template.spliced <specials>)] (`` (case local @@ -772,7 +772,7 @@ ) (with_template [<consumption> <production> <name> <instruction> <input>] - [(def: .public <name> + [(def .public <name> (-> <input> (Bytecode Any)) (..bytecode <consumption> <production> @_ <instruction>))] @@ -796,7 +796,7 @@ (Either Big_Jump Jump)) -(def: (jump @from @to) +(def (jump @from @to) (-> Address Address (Try Any_Jump)) (<| (try|do jump (try#each //signed.value (/address.jump @from @to))) @@ -812,7 +812,7 @@ (exception.report "Label" (%.nat label))) -(def: (resolve_label label resolver) +(def (resolve_label label resolver) (-> Label Resolver (Try [Stack Address])) (case (dictionary.value label resolver) {.#Some [actual {.#Some address}]} @@ -825,7 +825,7 @@ _ (exception.except ..unknown_label [label]))) -(def: (acknowledge_label stack label tracker) +(def (acknowledge_label stack label tracker) (-> Stack Label Tracker Tracker) (case (dictionary.value label (the #known tracker)) {.#Some _} @@ -836,7 +836,7 @@ (revised #known (dictionary.has label [stack {.#None}]) tracker))) (with_template [<consumption> <name> <instruction>] - [(def: .public (<name> label) + [(def .public (<name> label) (-> Label (Bytecode Any)) (let [[estimator bytecode] <instruction>] (function (_ [pool environment tracker]) @@ -886,7 +886,7 @@ ) (with_template [<name> <instruction> <on_long_jump> <on_short_jump>] - [(def: .public (<name> label) + [(def .public (<name> label) (-> Label (Bytecode Any)) (let [[estimator bytecode] <instruction>] (function (_ [pool environment tracker]) @@ -928,7 +928,7 @@ (try|in [..no_exceptions (bytecode (/jump.lifted jump))])] ) -(def: (big_jump jump) +(def (big_jump jump) (-> Any_Jump Big_Jump) (case jump {.#Left big} @@ -939,7 +939,7 @@ (exception: .public invalid_tableswitch) -(def: .public (tableswitch minimum default [at_minimum afterwards]) +(def .public (tableswitch minimum default [at_minimum afterwards]) (-> S4 Label [Label (List Label)] (Bytecode Any)) (let [[estimator bytecode] _.tableswitch] (function (_ [pool environment tracker]) @@ -977,7 +977,7 @@ (exception: .public invalid_lookupswitch) -(def: .public (lookupswitch default cases) +(def .public (lookupswitch default cases) (-> Label (List [S4 Label]) (Bytecode Any)) (let [cases (list.sorted (function (_ [left _] [right _]) (i.< (//signed.value left) @@ -1016,13 +1016,13 @@ (exception.except ..invalid_lookupswitch [])))) []]])))))) -(def: reflection +(def reflection (All (_ category) (-> (Type (<| Return' Value' category)) Text)) (|>> type.reflection reflection.reflection)) (with_template [<consumption> <production> <name> <category> <instruction>] - [(def: .public (<name> class) + [(def .public (<name> class) (-> (Type <category>) (Bytecode Any)) (do ..monad [... TODO: Make sure it's impossible to have indexes greater than U2. @@ -1035,7 +1035,7 @@ [$1 $1 instanceof Object _.instanceof] ) -(def: .public (iinc register increase) +(def .public (iinc register increase) (-> Nat U1 (Bytecode Any)) (do ..monad [register (..register register)] @@ -1045,7 +1045,7 @@ (exception.report "Class" (..reflection class))) -(def: .public (multianewarray class dimensions) +(def .public (multianewarray class dimensions) (-> (Type Object) U1 (Bytecode Any)) (do ..monad [_ (is (Bytecode Any) @@ -1055,7 +1055,7 @@ index (..lifted (//constant/pool.class (//name.internal (..reflection class))))] (..bytecode (//unsigned.lifted/2 dimensions) $1 @_ _.multianewarray [index dimensions]))) -(def: (type_size type) +(def (type_size type) (-> (Type Return) Nat) (cond (same? type.void type) 0 @@ -1068,7 +1068,7 @@ 1)) (with_template [<static?> <name> <instruction> <method>] - [(def: .public (<name> class method type) + [(def .public (<name> class method type) (-> (Type Class) Text (Type Method) (Bytecode Any)) (let [[type_variables inputs output exceptions] (parser.method type)] (do ..monad @@ -1094,7 +1094,7 @@ ) (with_template [<consumption> <name> <1> <2>] - [(def: .public (<name> class field type) + [(def .public (<name> class field type) (-> (Type Class) Text (Type Value) (Bytecode Any)) (do ..monad [index (<| ..lifted @@ -1111,7 +1111,7 @@ ) (with_template [<name> <consumption/1> <1> <consumption/2> <2>] - [(def: .public (<name> class field type) + [(def .public (<name> class field type) (-> (Type Class) Text (Type Value) (Bytecode Any)) (do [! ..monad] [index (<| ..lifted @@ -1133,7 +1133,7 @@ "Start" (|> start /address.value //unsigned.value %.nat) "End" (|> end /address.value //unsigned.value %.nat))) -(def: .public (try @start @end @handler catch) +(def .public (try @start @end @handler catch) (-> Label Label Label (Type Class) (Bytecode Any)) (do ..monad [@catch (..lifted (//constant/pool.class (//name.internal (..reflection catch))))] @@ -1157,7 +1157,7 @@ _.empty]))) []]]}))) -(def: .public (composite pre post) +(def .public (composite pre post) (All (_ pre post) (-> (Bytecode pre) (Bytecode post) (Bytecode post))) (function (_ state) |