diff options
Diffstat (limited to 'lux-jvm/source/luxc/lang/translation/jvm')
10 files changed, 363 insertions, 352 deletions
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index b7b1d6b0f..2c9bfdb61 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -71,6 +71,9 @@ 5 _.ICONST_5 _ (_.int (.int value)))) +(def: projectionJT + (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)])) + (def: (left_projection lefts) (-> Nat Inst) (.let [[indexI accessI] (.case lefts @@ -80,7 +83,7 @@ lefts [(leftsI lefts) - (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)]))])] + (_.INVOKESTATIC //.$Runtime "tuple_left" ..projectionJT)])] (|>> (_.CHECKCAST //.$Tuple) indexI accessI))) @@ -89,17 +92,23 @@ (-> Nat Inst) (|>> (_.CHECKCAST //.$Tuple) (leftsI lefts) - (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list) (list //.$Tuple runtime.$Index) //.$Value (list)])))) + (_.INVOKESTATIC //.$Runtime "tuple_right" ..projectionJT))) + +(def: equalsJT + (type.method [(list) (list //.$Value) type.boolean (list)])) + +(def: sideJT + (type.method [(list) (list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) (def: (path' stack_depth @else @end phase archive path) (-> Nat Label Label Phase Archive Path (Operation Inst)) (.case path #synthesis.Pop - (operation@wrap ..popI) + (operation@in ..popI) (#synthesis.Bind register) - (operation@wrap (|>> peekI - (_.ASTORE register))) + (operation@in (|>> peekI + (_.ASTORE register))) (#synthesis.Bit_Fork when thenP elseP) (do phase.monad @@ -109,15 +118,15 @@ (path' stack_depth @else @end phase archive elseP) #.None - (wrap (_.GOTO @else))) + (in (_.GOTO @else))) #let [ifI (.if when _.IFEQ _.IFNE)]] - (wrap (<| _.with_label (function (_ @else)) - (|>> peekI - (_.unwrap type.boolean) - (ifI @else) - thenG - (_.label @else) - elseG)))) + (in (<| _.with_label (function (_ @else)) + (|>> peekI + (_.unwrap type.boolean) + (ifI @else) + thenG + (_.label @else) + elseG)))) (^template [<tag> <unwrap> <dup> <pop> <test> <comparison> <if>] [(<tag> cons) @@ -126,70 +135,70 @@ (monad.fold @ (function (_ [test thenP] elseG) (do @ [thenG (path' stack_depth @else @end phase archive thenP)] - (wrap (<| _.with_label (function (_ @else)) - (|>> <dup> - (<test> test) - <comparison> - (<if> @else) - <pop> - thenG - (_.label @else) - elseG))))) + (in (<| _.with_label (function (_ @else)) + (|>> <dup> + (<test> test) + <comparison> + (<if> @else) + <pop> + thenG + (_.label @else) + elseG))))) (|>> <pop> (_.GOTO @else)) - (#.Cons cons)))] - (wrap (|>> peekI - <unwrap> - forkG)))]) + (#.Item cons)))] + (in (|>> peekI + <unwrap> + forkG)))]) ([#synthesis.I64_Fork (_.unwrap type.long) _.DUP2 _.POP2 (|>> .int _.long) _.LCMP _.IFNE] [#synthesis.F64_Fork (_.unwrap type.double) _.DUP2 _.POP2 _.double _.DCMPL _.IFNE] [#synthesis.Text_Fork (|>) _.DUP _.POP _.string - (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" (type.method [(list) (list //.$Value) type.boolean (list)])) + (_.INVOKEVIRTUAL (type.class "java.lang.Object" (list)) "equals" ..equalsJT) _.IFEQ]) (#synthesis.Then bodyS) (do phase.monad [bodyI (phase archive bodyS)] - (wrap (|>> (pop_altI stack_depth) - bodyI - (_.GOTO @end)))) + (in (|>> (pop_altI stack_depth) + bodyI + (_.GOTO @end)))) (^template [<pattern> <right?>] [(^ (<pattern> lefts)) - (operation@wrap (<| _.with_label (function (_ @success)) - _.with_label (function (_ @fail)) - (|>> peekI - (_.CHECKCAST //.$Variant) - (structure.tagI lefts <right?>) - (structure.flagI <right?>) - (_.INVOKESTATIC //.$Runtime "pm_variant" (type.method [(list) (list //.$Variant runtime.$Tag runtime.$Flag) runtime.$Value (list)])) - _.DUP - (_.IFNULL @fail) - (_.GOTO @success) - (_.label @fail) - _.POP - (_.GOTO @else) - (_.label @success) - pushI)))]) + (operation@in (<| _.with_label (function (_ @success)) + _.with_label (function (_ @fail)) + (|>> peekI + (_.CHECKCAST //.$Variant) + (structure.tagI lefts <right?>) + (structure.flagI <right?>) + (_.INVOKESTATIC //.$Runtime "pm_variant" ..sideJT) + _.DUP + (_.IFNULL @fail) + (_.GOTO @success) + (_.label @fail) + _.POP + (_.GOTO @else) + (_.label @success) + pushI)))]) ([synthesis.side/left false] [synthesis.side/right true]) ## Extra optimization (^template [<path> <projection>] [(^ (<path> lefts)) - (operation@wrap (|>> peekI - (<projection> lefts) - pushI)) + (operation@in (|>> peekI + (<projection> lefts) + pushI)) (^ (synthesis.path/seq (<path> lefts) (synthesis.!bind_top register thenP))) (do phase.monad [then! (path' stack_depth @else @end phase archive thenP)] - (wrap (|>> peekI - (<projection> lefts) - (_.ASTORE register) - then!)))]) + (in (|>> peekI + (<projection> lefts) + (_.ASTORE register) + then!)))]) ([synthesis.member/left ..left_projection] [synthesis.member/right ..right_projection]) @@ -197,32 +206,35 @@ (do phase.monad [leftI (path' stack_depth @else @end phase archive leftP) rightI (path' stack_depth @else @end phase archive rightP)] - (wrap (|>> leftI - rightI))) + (in (|>> leftI + rightI))) (#synthesis.Alt leftP rightP) (do phase.monad [@alt_else _.make_label leftI (path' (inc stack_depth) @alt_else @end phase archive leftP) rightI (path' stack_depth @else @end phase archive rightP)] - (wrap (|>> _.DUP - leftI - (_.label @alt_else) - _.POP - rightI))) + (in (|>> _.DUP + leftI + (_.label @alt_else) + _.POP + rightI))) )) +(def: failJT + (type.method [(list) (list) type.void (list)])) + (def: (path @end phase archive path) (-> Label Phase Archive Path (Operation Inst)) (do phase.monad [@else _.make_label pathI (..path' 1 @else @end phase archive path)] - (wrap (|>> pathI - (_.label @else) - _.POP - (_.INVOKESTATIC //.$Runtime "pm_fail" (type.method [(list) (list) type.void (list)])) - _.NULL - (_.GOTO @end))))) + (in (|>> pathI + (_.label @else) + _.POP + (_.INVOKESTATIC //.$Runtime "pm_fail" ..failJT) + _.NULL + (_.GOTO @end))))) (def: #export (if phase archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -230,40 +242,40 @@ [testI (phase archive testS) thenI (phase archive thenS) elseI (phase archive elseS)] - (wrap (<| _.with_label (function (_ @else)) - _.with_label (function (_ @end)) - (|>> testI - (_.unwrap type.boolean) - (_.IFEQ @else) - thenI - (_.GOTO @end) - (_.label @else) - elseI - (_.label @end)))))) + (in (<| _.with_label (function (_ @else)) + _.with_label (function (_ @end)) + (|>> testI + (_.unwrap type.boolean) + (_.IFEQ @else) + thenI + (_.GOTO @end) + (_.label @else) + elseI + (_.label @end)))))) (def: #export (let phase archive [inputS register exprS]) (Generator [Synthesis Nat Synthesis]) (do phase.monad [inputI (phase archive inputS) exprI (phase archive exprS)] - (wrap (|>> inputI - (_.ASTORE register) - exprI)))) + (in (|>> inputI + (_.ASTORE register) + exprI)))) (def: #export (get phase archive [path recordS]) (Generator [(List synthesis.Member) Synthesis]) (do phase.monad [recordG (phase archive recordS)] - (wrap (list@fold (function (_ step so_far) - (.let [next (.case step - (#.Left lefts) - (..left_projection lefts) - - (#.Right lefts) - (..right_projection lefts))] - (|>> so_far next))) - recordG - (list.reverse path))))) + (in (list@fold (function (_ step so_far) + (.let [next (.case step + (#.Left lefts) + (..left_projection lefts) + + (#.Right lefts) + (..right_projection lefts))] + (|>> so_far next))) + recordG + (list.reversed path))))) (def: #export (case phase archive [valueS path]) (Generator [Synthesis Path]) @@ -271,8 +283,8 @@ [@end _.make_label valueI (phase archive valueS) pathI (..path @end phase archive path)] - (wrap (|>> _.NULL - valueI - pushI - pathI - (_.label @end))))) + (in (|>> _.NULL + valueI + pushI + pathI + (_.label @end))))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension.lux index 2f1bd6a36..8fced4749 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension.lux @@ -13,5 +13,5 @@ (def: #export bundle Bundle - (dictionary.merge /common.bundle - /host.bundle)) + (dictionary.merged /common.bundle + /host.bundle)) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux index 70175b636..eb3d02be7 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux @@ -52,7 +52,7 @@ (handler extension_name phase archive input') (#try.Failure error) - (phase.throw extension.invalid_syntax [extension_name %synthesis input])))) + (phase.except extension.invalid_syntax [extension_name %synthesis input])))) (import: java/lang/Double ["#::." @@ -103,13 +103,13 @@ (monad.map @ (function (_ [chars branch]) (do @ [branchG (phase archive branch)] - (wrap (<| _.with_label (function (_ @branch)) - [(list@map (function (_ char) - [(.int char) @branch]) - chars) - (|>> (_.label @branch) - branchG - (_.GOTO @end))])))) + (in (<| _.with_label (function (_ @branch)) + [(list@map (function (_ char) + [(.int char) @branch]) + chars) + (|>> (_.label @branch) + branchG + (_.GOTO @end))])))) conditionals)) #let [table (|> conditionalsG+ (list@map product.left) @@ -117,13 +117,12 @@ conditionalsG (|> conditionalsG+ (list@map product.right) _.fuse)]] - (wrap (|>> inputG (_.unwrap type.long) _.L2I - (_.LOOKUPSWITCH @else table) - conditionalsG - (_.label @else) - elseG - (_.label @end) - )))))])) + (in (|>> inputG (_.unwrap type.long) _.L2I + (_.LOOKUPSWITCH @else table) + conditionalsG + (_.label @else) + elseG + (_.label @end))))))])) (def: (lux::is [referenceI sampleI]) (Binary Inst) @@ -372,7 +371,7 @@ Bundle (<| (bundle.prefix "lux") (|> bundle::lux - (dictionary.merge bundle::i64) - (dictionary.merge bundle::f64) - (dictionary.merge bundle::text) - (dictionary.merge bundle::io)))) + (dictionary.merged bundle::i64) + (dictionary.merged bundle::f64) + (dictionary.merged bundle::text) + (dictionary.merged bundle::io)))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux index 4f8210a47..e87ea6510 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -70,7 +70,7 @@ (template [<name> <category> <parser>] [(def: #export <name> (Parser (Type <category>)) - (<text>.embed <parser> <synthesis>.text))] + (<text>.then <parser> <synthesis>.text))] [var Var parser.var] [class Class parser.class] @@ -94,15 +94,15 @@ (def: #export object_array (Parser (Type Object)) (do <>.monad - [arrayJT (<text>.embed parser.array <synthesis>.text)] + [arrayJT (<text>.then parser.array <synthesis>.text)] (case (parser.array? arrayJT) (#.Some elementJT) (case (parser.object? elementJT) (#.Some elementJT) - (wrap elementJT) + (in elementJT) #.None - (<>.failure (exception.construct ..not_an_object_array arrayJT))) + (<>.failure (exception.error ..not_an_object_array [arrayJT]))) #.None (undefined)))) @@ -110,11 +110,11 @@ (template [<name> <inst>] [(def: <name> Inst - <inst>)] + (|>> _.L2I <inst>))] - [L2S (|>> _.L2I _.I2S)] - [L2B (|>> _.L2I _.I2B)] - [L2C (|>> _.L2I _.I2C)] + [L2S _.I2S] + [L2B _.I2B] + [L2C _.I2C] ) (template [<conversion> <name>] @@ -355,9 +355,9 @@ (function (_ extension_name generate archive arrayS) (do phase.monad [arrayI (generate archive arrayS)] - (wrap (|>> arrayI - (_.CHECKCAST (type.array jvm_primitive)) - _.ARRAYLENGTH))))])) + (in (|>> arrayI + (_.CHECKCAST (type.array jvm_primitive)) + _.ARRAYLENGTH))))])) (def: array::length::object Handler @@ -366,9 +366,9 @@ (function (_ extension_name generate archive [elementJT arrayS]) (do phase.monad [arrayI (generate archive arrayS)] - (wrap (|>> arrayI - (_.CHECKCAST (type.array elementJT)) - _.ARRAYLENGTH))))])) + (in (|>> arrayI + (_.CHECKCAST (type.array elementJT)) + _.ARRAYLENGTH))))])) (def: (new_primitive_array_handler jvm_primitive) (-> (Type Primitive) Handler) @@ -377,11 +377,11 @@ (^ (list lengthS)) (do phase.monad [lengthI (generate archive lengthS)] - (wrap (|>> lengthI - (_.array jvm_primitive)))) + (in (|>> lengthI + (_.array jvm_primitive)))) _ - (phase.throw extension.invalid_syntax [extension_name %synthesis inputs])))) + (phase.except extension.invalid_syntax [extension_name %synthesis inputs])))) (def: array::new::object Handler @@ -390,8 +390,8 @@ (function (_ extension_name generate archive [objectJT lengthS]) (do phase.monad [lengthI (generate archive lengthS)] - (wrap (|>> lengthI - (_.ANEWARRAY objectJT)))))])) + (in (|>> lengthI + (_.ANEWARRAY objectJT)))))])) (def: (read_primitive_array_handler jvm_primitive loadI) (-> (Type Primitive) Inst Handler) @@ -401,13 +401,13 @@ (do phase.monad [arrayI (generate archive arrayS) idxI (generate archive idxS)] - (wrap (|>> arrayI - (_.CHECKCAST (type.array jvm_primitive)) - idxI - loadI))) + (in (|>> arrayI + (_.CHECKCAST (type.array jvm_primitive)) + idxI + loadI))) _ - (phase.throw extension.invalid_syntax [extension_name %synthesis inputs])))) + (phase.except extension.invalid_syntax [extension_name %synthesis inputs])))) (def: array::read::object Handler @@ -417,10 +417,10 @@ (do phase.monad [arrayI (generate archive arrayS) idxI (generate archive idxS)] - (wrap (|>> arrayI - (_.CHECKCAST (type.array elementJT)) - idxI - _.AALOAD))))])) + (in (|>> arrayI + (_.CHECKCAST (type.array elementJT)) + idxI + _.AALOAD))))])) (def: (write_primitive_array_handler jvm_primitive storeI) (-> (Type Primitive) Inst Handler) @@ -431,15 +431,15 @@ [arrayI (generate archive arrayS) idxI (generate archive idxS) valueI (generate archive valueS)] - (wrap (|>> arrayI - (_.CHECKCAST (type.array jvm_primitive)) - _.DUP - idxI - valueI - storeI))) + (in (|>> arrayI + (_.CHECKCAST (type.array jvm_primitive)) + _.DUP + idxI + valueI + storeI))) _ - (phase.throw extension.invalid_syntax [extension_name %synthesis inputs])))) + (phase.except extension.invalid_syntax [extension_name %synthesis inputs])))) (def: array::write::object Handler @@ -450,61 +450,61 @@ [arrayI (generate archive arrayS) idxI (generate archive idxS) valueI (generate archive valueS)] - (wrap (|>> arrayI - (_.CHECKCAST (type.array elementJT)) - _.DUP - idxI - valueI - _.AASTORE))))])) + (in (|>> arrayI + (_.CHECKCAST (type.array elementJT)) + _.DUP + idxI + valueI + _.AASTORE))))])) (def: array_bundle Bundle (<| (bundle.prefix "array") (|> bundle.empty - (dictionary.merge (<| (bundle.prefix "length") - (|> bundle.empty - (bundle.install (reflection.reflection reflection.boolean) (primitive_array_length_handler type.boolean)) - (bundle.install (reflection.reflection reflection.byte) (primitive_array_length_handler type.byte)) - (bundle.install (reflection.reflection reflection.short) (primitive_array_length_handler type.short)) - (bundle.install (reflection.reflection reflection.int) (primitive_array_length_handler type.int)) - (bundle.install (reflection.reflection reflection.long) (primitive_array_length_handler type.long)) - (bundle.install (reflection.reflection reflection.float) (primitive_array_length_handler type.float)) - (bundle.install (reflection.reflection reflection.double) (primitive_array_length_handler type.double)) - (bundle.install (reflection.reflection reflection.char) (primitive_array_length_handler type.char)) - (bundle.install "object" array::length::object)))) - (dictionary.merge (<| (bundle.prefix "new") - (|> bundle.empty - (bundle.install (reflection.reflection reflection.boolean) (new_primitive_array_handler type.boolean)) - (bundle.install (reflection.reflection reflection.byte) (new_primitive_array_handler type.byte)) - (bundle.install (reflection.reflection reflection.short) (new_primitive_array_handler type.short)) - (bundle.install (reflection.reflection reflection.int) (new_primitive_array_handler type.int)) - (bundle.install (reflection.reflection reflection.long) (new_primitive_array_handler type.long)) - (bundle.install (reflection.reflection reflection.float) (new_primitive_array_handler type.float)) - (bundle.install (reflection.reflection reflection.double) (new_primitive_array_handler type.double)) - (bundle.install (reflection.reflection reflection.char) (new_primitive_array_handler type.char)) - (bundle.install "object" array::new::object)))) - (dictionary.merge (<| (bundle.prefix "read") - (|> bundle.empty - (bundle.install (reflection.reflection reflection.boolean) (read_primitive_array_handler type.boolean _.BALOAD)) - (bundle.install (reflection.reflection reflection.byte) (read_primitive_array_handler type.byte _.BALOAD)) - (bundle.install (reflection.reflection reflection.short) (read_primitive_array_handler type.short _.SALOAD)) - (bundle.install (reflection.reflection reflection.int) (read_primitive_array_handler type.int _.IALOAD)) - (bundle.install (reflection.reflection reflection.long) (read_primitive_array_handler type.long _.LALOAD)) - (bundle.install (reflection.reflection reflection.float) (read_primitive_array_handler type.float _.FALOAD)) - (bundle.install (reflection.reflection reflection.double) (read_primitive_array_handler type.double _.DALOAD)) - (bundle.install (reflection.reflection reflection.char) (read_primitive_array_handler type.char _.CALOAD)) - (bundle.install "object" array::read::object)))) - (dictionary.merge (<| (bundle.prefix "write") - (|> bundle.empty - (bundle.install (reflection.reflection reflection.boolean) (write_primitive_array_handler type.boolean _.BASTORE)) - (bundle.install (reflection.reflection reflection.byte) (write_primitive_array_handler type.byte _.BASTORE)) - (bundle.install (reflection.reflection reflection.short) (write_primitive_array_handler type.short _.SASTORE)) - (bundle.install (reflection.reflection reflection.int) (write_primitive_array_handler type.int _.IASTORE)) - (bundle.install (reflection.reflection reflection.long) (write_primitive_array_handler type.long _.LASTORE)) - (bundle.install (reflection.reflection reflection.float) (write_primitive_array_handler type.float _.FASTORE)) - (bundle.install (reflection.reflection reflection.double) (write_primitive_array_handler type.double _.DASTORE)) - (bundle.install (reflection.reflection reflection.char) (write_primitive_array_handler type.char _.CASTORE)) - (bundle.install "object" array::write::object)))) + (dictionary.merged (<| (bundle.prefix "length") + (|> bundle.empty + (bundle.install (reflection.reflection reflection.boolean) (primitive_array_length_handler type.boolean)) + (bundle.install (reflection.reflection reflection.byte) (primitive_array_length_handler type.byte)) + (bundle.install (reflection.reflection reflection.short) (primitive_array_length_handler type.short)) + (bundle.install (reflection.reflection reflection.int) (primitive_array_length_handler type.int)) + (bundle.install (reflection.reflection reflection.long) (primitive_array_length_handler type.long)) + (bundle.install (reflection.reflection reflection.float) (primitive_array_length_handler type.float)) + (bundle.install (reflection.reflection reflection.double) (primitive_array_length_handler type.double)) + (bundle.install (reflection.reflection reflection.char) (primitive_array_length_handler type.char)) + (bundle.install "object" array::length::object)))) + (dictionary.merged (<| (bundle.prefix "new") + (|> bundle.empty + (bundle.install (reflection.reflection reflection.boolean) (new_primitive_array_handler type.boolean)) + (bundle.install (reflection.reflection reflection.byte) (new_primitive_array_handler type.byte)) + (bundle.install (reflection.reflection reflection.short) (new_primitive_array_handler type.short)) + (bundle.install (reflection.reflection reflection.int) (new_primitive_array_handler type.int)) + (bundle.install (reflection.reflection reflection.long) (new_primitive_array_handler type.long)) + (bundle.install (reflection.reflection reflection.float) (new_primitive_array_handler type.float)) + (bundle.install (reflection.reflection reflection.double) (new_primitive_array_handler type.double)) + (bundle.install (reflection.reflection reflection.char) (new_primitive_array_handler type.char)) + (bundle.install "object" array::new::object)))) + (dictionary.merged (<| (bundle.prefix "read") + (|> bundle.empty + (bundle.install (reflection.reflection reflection.boolean) (read_primitive_array_handler type.boolean _.BALOAD)) + (bundle.install (reflection.reflection reflection.byte) (read_primitive_array_handler type.byte _.BALOAD)) + (bundle.install (reflection.reflection reflection.short) (read_primitive_array_handler type.short _.SALOAD)) + (bundle.install (reflection.reflection reflection.int) (read_primitive_array_handler type.int _.IALOAD)) + (bundle.install (reflection.reflection reflection.long) (read_primitive_array_handler type.long _.LALOAD)) + (bundle.install (reflection.reflection reflection.float) (read_primitive_array_handler type.float _.FALOAD)) + (bundle.install (reflection.reflection reflection.double) (read_primitive_array_handler type.double _.DALOAD)) + (bundle.install (reflection.reflection reflection.char) (read_primitive_array_handler type.char _.CALOAD)) + (bundle.install "object" array::read::object)))) + (dictionary.merged (<| (bundle.prefix "write") + (|> bundle.empty + (bundle.install (reflection.reflection reflection.boolean) (write_primitive_array_handler type.boolean _.BASTORE)) + (bundle.install (reflection.reflection reflection.byte) (write_primitive_array_handler type.byte _.BASTORE)) + (bundle.install (reflection.reflection reflection.short) (write_primitive_array_handler type.short _.SASTORE)) + (bundle.install (reflection.reflection reflection.int) (write_primitive_array_handler type.int _.IASTORE)) + (bundle.install (reflection.reflection reflection.long) (write_primitive_array_handler type.long _.LASTORE)) + (bundle.install (reflection.reflection reflection.float) (write_primitive_array_handler type.float _.FASTORE)) + (bundle.install (reflection.reflection reflection.double) (write_primitive_array_handler type.double _.DASTORE)) + (bundle.install (reflection.reflection reflection.char) (write_primitive_array_handler type.char _.CASTORE)) + (bundle.install "object" array::write::object)))) ))) (def: (object::null _) @@ -546,11 +546,11 @@ (^ (list (synthesis.text class))) (do phase.monad [] - (wrap (|>> (_.string class) - (_.INVOKESTATIC $Class "forName" (type.method [(list) (list (type.class "java.lang.String" (list))) $Class (list)]))))) + (in (|>> (_.string class) + (_.INVOKESTATIC $Class "forName" (type.method [(list) (list (type.class "java.lang.String" (list))) $Class (list)]))))) _ - (phase.throw extension.invalid_syntax [extension_name %synthesis inputs]))) + (phase.except extension.invalid_syntax [extension_name %synthesis inputs]))) (def: object::instance? Handler @@ -559,9 +559,9 @@ (function (_ extension_name generate archive [class objectS]) (do phase.monad [objectI (generate archive objectS)] - (wrap (|>> objectI - (_.INSTANCEOF (type.class class (list))) - (_.wrap type.boolean)))))])) + (in (|>> objectI + (_.INSTANCEOF (type.class class (list))) + (_.wrap type.boolean)))))])) (def: (object::cast extension_name generate archive inputs) Handler @@ -574,13 +574,13 @@ from) (text\= <object> to)) - (wrap (|>> valueI (_.wrap <primitive>))) + (in (|>> valueI (_.wrap <primitive>))) (and (text\= <object> from) (text\= (reflection.reflection (type.reflection <primitive>)) to)) - (wrap (|>> valueI (_.unwrap <primitive>)))] + (in (|>> valueI (_.unwrap <primitive>)))] [box.boolean type.boolean] [box.byte type.byte] @@ -591,10 +591,10 @@ [box.double type.double] [box.char type.char])) ## else - (wrap valueI)))) + (in valueI)))) _ - (phase.throw extension.invalid_syntax [extension_name %synthesis inputs]))) + (phase.except extension.invalid_syntax [extension_name %synthesis inputs]))) (def: object_bundle Bundle @@ -630,10 +630,10 @@ [] (case (dictionary.get unboxed ..primitives) (#.Some primitive) - (wrap (_.GETSTATIC (type.class class (list)) field primitive)) + (in (_.GETSTATIC (type.class class (list)) field primitive)) #.None - (wrap (_.GETSTATIC (type.class class (list)) field (type.class unboxed (list)))))))])) + (in (_.GETSTATIC (type.class class (list)) field (type.class unboxed (list)))))))])) (def: put::static Handler @@ -645,15 +645,15 @@ #let [$class (type.class class (list))]] (case (dictionary.get unboxed ..primitives) (#.Some primitive) - (wrap (|>> valueI - (_.PUTSTATIC $class field primitive) - (_.string synthesis.unit))) + (in (|>> valueI + (_.PUTSTATIC $class field primitive) + (_.string synthesis.unit))) #.None - (wrap (|>> valueI - (_.CHECKCAST $class) - (_.PUTSTATIC $class field $class) - (_.string synthesis.unit))))))])) + (in (|>> valueI + (_.CHECKCAST $class) + (_.PUTSTATIC $class field $class) + (_.string synthesis.unit))))))])) (def: get::virtual Handler @@ -669,9 +669,9 @@ #.None (_.GETFIELD $class field (type.class unboxed (list))))]] - (wrap (|>> objectI - (_.CHECKCAST $class) - getI))))])) + (in (|>> objectI + (_.CHECKCAST $class) + getI))))])) (def: put::virtual Handler @@ -690,11 +690,11 @@ (let [$unboxed (type.class unboxed (list))] (|>> (_.CHECKCAST $unboxed) (_.PUTFIELD $class field $unboxed))))]] - (wrap (|>> objectI - (_.CHECKCAST $class) - _.DUP - valueI - putI))))])) + (in (|>> objectI + (_.CHECKCAST $class) + _.DUP + valueI + putI))))])) (type: Input (Typed Synthesis)) @@ -710,11 +710,11 @@ [valueI (generate archive valueS)] (case (type.primitive? valueT) (#.Right valueT) - (wrap [valueT valueI]) + (in [valueT valueI]) (#.Left valueT) - (wrap [valueT (|>> valueI - (_.CHECKCAST valueT))])))) + (in [valueT (|>> valueI + (_.CHECKCAST valueT))])))) (def: voidI (_.string synthesis.unit)) @@ -735,9 +735,9 @@ (function (_ extension_name generate archive [class method outputT inputsTS]) (do {! phase.monad} [inputsTI (monad.map ! (generate_input generate archive) inputsTS)] - (wrap (|>> (_.fuse (list\map product.right inputsTI)) - (_.INVOKESTATIC class method (type.method [(list) (list\map product.left inputsTI) outputT (list)])) - (prepare_output outputT)))))])) + (in (|>> (_.fuse (list\map product.right inputsTI)) + (_.INVOKESTATIC class method (type.method [(list) (list\map product.left inputsTI) outputT (list)])) + (prepare_output outputT)))))])) (template [<name> <invoke>] [(def: <name> @@ -748,15 +748,15 @@ (do {! phase.monad} [objectI (generate archive objectS) inputsTI (monad.map ! (generate_input generate archive) inputsTS)] - (wrap (|>> objectI - (_.CHECKCAST class) - (_.fuse (list\map product.right inputsTI)) - (<invoke> class method - (type.method [(list) - (list\map product.left inputsTI) - outputT - (list)])) - (prepare_output outputT)))))]))] + (in (|>> objectI + (_.CHECKCAST class) + (_.fuse (list\map product.right inputsTI)) + (<invoke> class method + (type.method [(list) + (list\map product.left inputsTI) + outputT + (list)])) + (prepare_output outputT)))))]))] [invoke::virtual _.INVOKEVIRTUAL] [invoke::special _.INVOKESPECIAL] @@ -770,30 +770,30 @@ (function (_ extension_name generate archive [class inputsTS]) (do {! phase.monad} [inputsTI (monad.map ! (generate_input generate archive) inputsTS)] - (wrap (|>> (_.NEW class) - _.DUP - (_.fuse (list\map product.right inputsTI)) - (_.INVOKESPECIAL class "<init>" (type.method [(list) (list\map product.left inputsTI) type.void (list)]))))))])) + (in (|>> (_.NEW class) + _.DUP + (_.fuse (list\map product.right inputsTI)) + (_.INVOKESPECIAL class "<init>" (type.method [(list) (list\map product.left inputsTI) type.void (list)]))))))])) (def: member_bundle Bundle (<| (bundle.prefix "member") (|> (: Bundle bundle.empty) - (dictionary.merge (<| (bundle.prefix "get") - (|> (: Bundle bundle.empty) - (bundle.install "static" get::static) - (bundle.install "virtual" get::virtual)))) - (dictionary.merge (<| (bundle.prefix "put") - (|> (: Bundle bundle.empty) - (bundle.install "static" put::static) - (bundle.install "virtual" put::virtual)))) - (dictionary.merge (<| (bundle.prefix "invoke") - (|> (: Bundle bundle.empty) - (bundle.install "static" invoke::static) - (bundle.install "virtual" invoke::virtual) - (bundle.install "special" invoke::special) - (bundle.install "interface" invoke::interface) - (bundle.install "constructor" invoke::constructor)))) + (dictionary.merged (<| (bundle.prefix "get") + (|> (: Bundle bundle.empty) + (bundle.install "static" get::static) + (bundle.install "virtual" get::virtual)))) + (dictionary.merged (<| (bundle.prefix "put") + (|> (: Bundle bundle.empty) + (bundle.install "static" put::static) + (bundle.install "virtual" put::virtual)))) + (dictionary.merged (<| (bundle.prefix "invoke") + (|> (: Bundle bundle.empty) + (bundle.install "static" invoke::static) + (bundle.install "virtual" invoke::virtual) + (bundle.install "special" invoke::special) + (bundle.install "interface" invoke::interface) + (bundle.install "constructor" invoke::constructor)))) ))) (def: annotation_parameter @@ -858,11 +858,11 @@ <synthesis>.tuple (<>.after <synthesis>.any) <synthesis>.any)] - (wrap [environment - [ownerT name - strict_fp? annotations vars - self_name arguments returnT exceptionsT - (..hidden_method_body (list.size arguments) body)]])))) + (in [environment + [ownerT name + strict_fp? annotations vars + self_name arguments returnT exceptionsT + (..hidden_method_body (list.size arguments) body)]])))) (def: (normalize_path normalize) (-> (-> Synthesis Synthesis) @@ -918,7 +918,7 @@ (^ (synthesis.variable var)) (|> mapping (dictionary.get body) - (maybe.default var) + (maybe.else var) synthesis.variable) (^ (synthesis.branch/case [inputS pathS])) @@ -945,7 +945,7 @@ (^ (synthesis.variable var)) (|> mapping (dictionary.get captured) - (maybe.default var) + (maybe.else var) synthesis.variable) _ @@ -991,10 +991,10 @@ (-> Phase Archive (Type Class) (Environment Synthesis) (Operation Inst)) (do {! phase.monad} [captureI+ (monad.map ! (generate archive) env)] - (wrap (|>> (_.NEW class) - _.DUP - (_.fuse captureI+) - (_.INVOKESPECIAL class "<init>" (anonymous_init_method env)))))) + (in (|>> (_.NEW class) + _.DUP + (_.fuse captureI+) + (_.INVOKESPECIAL class "<init>" (anonymous_init_method env)))))) (def: (prepare_argument lux_register argumentT jvm_register) (-> Register (Type Value) Register [Register Inst]) @@ -1086,7 +1086,7 @@ inputsTS overriden_methods]) (do {! phase.monad} - [[context _] (generation.with_new_context archive (wrap [])) + [[context _] (generation.with_new_context archive (in [])) #let [[module_id artifact_id] context anonymous_class_name (///.class_name context) class (type.class anonymous_class_name (list)) @@ -1132,15 +1132,15 @@ [bodyG (generation.with_context artifact_id (generate archive bodyS)) #let [argumentsT (list\map product.right arguments)]] - (wrap (_def.method #$.Public - (if strict_fp? - ($_ $.++M $.finalM $.strictM) - $.finalM) - name - (type.method [varsT argumentsT returnT exceptionsT]) - (|>> (prepare_arguments 1 argumentsT) - bodyG - (returnI returnT))))))) + (in (_def.method #$.Public + (if strict_fp? + ($_ $.++M $.finalM $.strictM) + $.finalM) + name + (type.method [varsT argumentsT returnT exceptionsT]) + (|>> (prepare_arguments 1 argumentsT) + bodyG + (returnI returnT))))))) (\ ! map _def.fuse)) #let [directive [anonymous_class_name (_def.class #$.V1_6 #$.Public $.finalC @@ -1164,13 +1164,13 @@ Bundle (<| (bundle.prefix "jvm") (|> ..conversion_bundle - (dictionary.merge ..int_bundle) - (dictionary.merge ..long_bundle) - (dictionary.merge ..float_bundle) - (dictionary.merge ..double_bundle) - (dictionary.merge ..char_bundle) - (dictionary.merge ..array_bundle) - (dictionary.merge ..object_bundle) - (dictionary.merge ..member_bundle) - (dictionary.merge ..class_bundle) + (dictionary.merged ..int_bundle) + (dictionary.merged ..long_bundle) + (dictionary.merged ..float_bundle) + (dictionary.merged ..double_bundle) + (dictionary.merged ..char_bundle) + (dictionary.merged ..array_bundle) + (dictionary.merged ..object_bundle) + (dictionary.merged ..member_bundle) + (dictionary.merged ..class_bundle) ))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux index fcbfe1277..bb592ca32 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -115,11 +115,11 @@ (list (_.int +0)) _.fuse) function.identity)]] - (wrap (|>> (_.NEW class) - _.DUP - (_.fuse captureI+) - argsI - (_.INVOKESPECIAL class "<init>" (init_method env arity)))))) + (in (|>> (_.NEW class) + _.DUP + (_.fuse captureI+) + argsI + (_.INVOKESPECIAL class "<init>" (init_method env arity)))))) (def: (reset_method return) (-> (Type Class) (Type Method)) @@ -301,7 +301,7 @@ ))] (do phase.monad [instanceI (..instance generate archive classD arity env)] - (wrap [functionD instanceI])))) + (in [functionD instanceI])))) (def: #export (function' forced_context generate archive [env arity bodyS]) (-> (Maybe Context) (Generator Abstraction)) @@ -312,8 +312,8 @@ (do ! [without_context (generation.with_anchor [@begin 1] (generate archive bodyS))] - (wrap [function_context - without_context])) + (in [function_context + without_context])) #.None (generation.with_new_context archive @@ -332,8 +332,8 @@ (generation.save! (product.right function_context) #.None directive) (#.Some function_context) - (wrap []))] - (wrap instanceI))) + (in []))] + (in instanceI))) (def: #export function (Generator Abstraction) @@ -351,5 +351,5 @@ (_.fuse chunkI+) (_.INVOKEVIRTUAL //.$Function //runtime.apply_method (//runtime.apply_signature (list.size chunkI+)))))) _.fuse)]] - (wrap (|>> functionI - applyI)))) + (in (|>> functionI + applyI)))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux index d17d3dfe2..40f8ef0de 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux @@ -55,7 +55,7 @@ valuesI+ (monad.map @ (function (_ [register argS]) (: (Operation Inst) (if (invariant? register argS) - (wrap function.identity) + (in function.identity) (translate archive argS)))) pairs) #let [storesI+ (list@map (function (_ [register argS]) @@ -63,10 +63,10 @@ (if (invariant? register argS) function.identity (_.ASTORE register)))) - (list.reverse pairs))]] - (wrap (|>> (_.fuse valuesI+) - (_.fuse storesI+) - (_.GOTO @begin))))) + (list.reversed pairs))]] + (in (|>> (_.fuse valuesI+) + (_.fuse storesI+) + (_.GOTO @begin))))) (def: #export (scope translate archive [start initsS+ iterationS]) (Generator [Nat (List Synthesis) Synthesis]) @@ -80,6 +80,6 @@ (|>> initI (_.ASTORE (n.+ start register))))) _.fuse)]] - (wrap (|>> initializationI - (_.label @begin) - iterationI)))) + (in (|>> initializationI + (_.label @begin) + iterationI)))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux index 1bced2ffc..2c814d24f 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/primitive.lux @@ -21,7 +21,7 @@ (-> Bit (Operation Inst)) (let [Boolean (type.class "java.lang.Boolean" (list))] (function (_ value) - (operation@wrap (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean))))) + (operation@in (_.GETSTATIC Boolean (if value "TRUE" "FALSE") Boolean))))) (import: java/lang/Byte ["#::." @@ -38,13 +38,13 @@ (case (.int value) (^template [<int> <instruction>] [<int> - (operation@wrap (|>> <instruction> (_.wrap type.long)))]) + (operation@in (|>> <instruction> (_.wrap type.long)))]) ([+0 _.LCONST_0] [+1 _.LCONST_1]) (^template [<int> <instruction>] [<int> - (operation@wrap (|>> <instruction> _.I2L (_.wrap type.long)))]) + (operation@in (|>> <instruction> _.I2L (_.wrap type.long)))]) ([-1 _.ICONST_M1] ## [+0 _.ICONST_0] ## [+1 _.ICONST_1] @@ -64,7 +64,7 @@ ## else (|> value .int _.long))] - (operation@wrap (|>> constantI (_.wrap type.long)))))) + (operation@in (|>> constantI (_.wrap type.long)))))) (import: java/lang/Double ["#::." @@ -79,17 +79,17 @@ (case value (^template [<int> <instruction>] [<int> - (operation@wrap (|>> <instruction> (_.wrap type.double)))]) + (operation@in (|>> <instruction> (_.wrap type.double)))]) ([+1.0 _.DCONST_1]) (^template [<int> <instruction>] [<int> - (operation@wrap (|>> <instruction> _.F2D (_.wrap type.double)))]) + (operation@in (|>> <instruction> _.F2D (_.wrap type.double)))]) ([+2.0 _.FCONST_2]) (^template [<int> <instruction>] [<int> - (operation@wrap (|>> <instruction> _.I2D (_.wrap type.double)))]) + (operation@in (|>> <instruction> _.I2D (_.wrap type.double)))]) ([-1.0 _.ICONST_M1] ## [+0.0 _.ICONST_0] ## [+1.0 _.ICONST_1] @@ -105,8 +105,8 @@ (i.= ..d0-bits)) _.DCONST_0 (_.double value))] - (operation@wrap (|>> constantI (_.wrap type.double)))))) + (operation@in (|>> constantI (_.wrap type.double)))))) (def: #export text (-> Text (Operation Inst)) - (|>> _.string operation@wrap)) + (|>> _.string operation@in)) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux index bfbda85be..b2dfe7676 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux @@ -41,10 +41,10 @@ (do {@ phase.monad} [class_name (\ @ map //.class_name (generation.context archive))] - (wrap (|>> (_.ALOAD 0) - (_.GETFIELD (type.class class_name (list)) - (|> variable .nat foreign_name) - //.$Value))))) + (in (|>> (_.ALOAD 0) + (_.GETFIELD (type.class class_name (list)) + (|> variable .nat foreign_name) + //.$Value))))) (def: local (-> Register Inst) @@ -54,7 +54,7 @@ (-> Archive Variable (Operation Inst)) (case variable (#variable.Local variable) - (operation@wrap (local variable)) + (operation@in (local variable)) (#variable.Foreign variable) (foreign archive variable))) @@ -64,4 +64,4 @@ (do {@ phase.monad} [class_name (\ @ map //.class_name (generation.remember archive name))] - (wrap (_.GETSTATIC (type.class class_name (list)) //.value_field //.$Value)))) + (in (_.GETSTATIC (type.class class_name (list)) //.value_field //.$Value)))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index cccdf42bf..e8f678211 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -351,7 +351,7 @@ (do phase.monad [_ (generation.execute! directive) _ (generation.save! ..runtime_id #.None directive)] - (wrap [..runtime_id #.None bytecode])))) + (in [..runtime_id #.None bytecode])))) (def: function_id 1) @@ -388,17 +388,17 @@ (do phase.monad [_ (generation.execute! directive) _ (generation.save! ..function_id #.None directive)] - (wrap [..function_id #.None bytecode])))) + (in [..function_id #.None bytecode])))) (def: #export translate (Operation [Registry Output]) (do phase.monad [runtime_payload ..translate_runtime function_payload ..translate_function] - (wrap [(|> artifact.empty - artifact.resource - product.right - artifact.resource - product.right) - (row.row runtime_payload - function_payload)]))) + (in [(|> artifact.empty + artifact.resource + product.right + artifact.resource + product.right) + (row.row runtime_payload + function_payload)]))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index a9666958b..86b4431da 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -46,21 +46,21 @@ (Generator (List Synthesis)) (do {@ phase.monad} [#let [size (list.size members)] - _ (phase.assert ..not_a_tuple size - (n.>= 2 size)) + _ (phase.assertion ..not_a_tuple size + (n.>= 2 size)) membersI (|> members list.enumeration (monad.map @ (function (_ [idx member]) (do @ [memberI (generate archive member)] - (wrap (|>> _.DUP - (_.int (.int idx)) - memberI - _.AASTORE))))) + (in (|>> _.DUP + (_.int (.int idx)) + memberI + _.AASTORE))))) (\ @ map _.fuse))] - (wrap (|>> (_.int (.int size)) - (_.array //runtime.$Value) - membersI)))) + (in (|>> (_.int (.int size)) + (_.array //runtime.$Value) + membersI)))) (import: java/lang/Byte ["#::." @@ -109,12 +109,12 @@ (do phase.monad [memberI (generate archive member) #let [tagI (..tagI lefts right?)]] - (wrap (|>> tagI - (flagI right?) - memberI - (_.INVOKESTATIC //.$Runtime - "variant_make" - (type.method [(list) - (list //runtime.$Tag //runtime.$Flag //runtime.$Value) - //.$Variant - (list)])))))) + (in (|>> tagI + (flagI right?) + memberI + (_.INVOKESTATIC //.$Runtime + "variant_make" + (type.method [(list) + (list //runtime.$Tag //runtime.$Flag //runtime.$Value) + //.$Variant + (list)])))))) |