From eff4c59794868b89d60fdc411f9b544a270b817e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 2 Aug 2021 20:26:21 -0400 Subject: Fixed a bug in the new compiler which allowed the same module to be imported more than once. --- lux-jvm/source/luxc/lang/directive/jvm.lux | 204 ++++++------ lux-jvm/source/luxc/lang/host/jvm.lux | 38 +-- lux-jvm/source/luxc/lang/host/jvm/def.lux | 6 +- lux-jvm/source/luxc/lang/host/jvm/inst.lux | 12 +- lux-jvm/source/luxc/lang/translation/jvm.lux | 28 +- lux-jvm/source/luxc/lang/translation/jvm/case.lux | 198 ++++++------ .../source/luxc/lang/translation/jvm/extension.lux | 4 +- .../luxc/lang/translation/jvm/extension/common.lux | 37 ++- .../luxc/lang/translation/jvm/extension/host.lux | 352 ++++++++++----------- .../source/luxc/lang/translation/jvm/function.lux | 24 +- lux-jvm/source/luxc/lang/translation/jvm/loop.lux | 16 +- .../source/luxc/lang/translation/jvm/primitive.lux | 18 +- .../source/luxc/lang/translation/jvm/reference.lux | 12 +- .../source/luxc/lang/translation/jvm/runtime.lux | 18 +- .../source/luxc/lang/translation/jvm/structure.lux | 36 +-- lux-jvm/source/program.lux | 44 +-- 16 files changed, 529 insertions(+), 518 deletions(-) (limited to 'lux-jvm/source') diff --git a/lux-jvm/source/luxc/lang/directive/jvm.lux b/lux-jvm/source/luxc/lang/directive/jvm.lux index fe3889c38..93a356c0e 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -446,7 +446,7 @@ (let [[mapping input] (..relabel [mapping input])] [mapping (list& input output)])) [mapping (list)] labels)] - [mapping (#/.TABLESWITCH min max default (list.reverse labels))]) + [mapping (#/.TABLESWITCH min max default (list.reversed labels))]) (#/.LOOKUPSWITCH default keys+labels) (let [[mapping default] (..relabel [mapping default]) @@ -454,7 +454,7 @@ (let [[mapping input] (..relabel [mapping input])] [mapping (list& [expected input] output)])) [mapping (list)] keys+labels)] - [mapping (#/.LOOKUPSWITCH default (list.reverse keys+labels))]) + [mapping (#/.LOOKUPSWITCH default (list.reversed keys+labels))]) )) (def: (relabel_exception [mapping instruction]) @@ -523,7 +523,7 @@ (def: fresh Mapping - (dictionary.new nat.hash)) + (dictionary.empty nat.hash)) (def: bytecode (-> (/.Bytecode Inst /.Label) jvm.Inst) @@ -575,10 +575,10 @@ directive.lift_generation) _ (directive.lift_generation (generation.log! (format "Generation " (%.text (:as Text name)))))] - (wrap directive.no_requirements)) + (in directive.no_requirements)) _ - (phase.throw extension.invalid_syntax [extension_name %.code inputsC+])))) + (phase.except extension.invalid_syntax [extension_name %.code inputsC+])))) (def: #export (custom [parser handler]) (All [i] @@ -591,7 +591,7 @@ (handler extension_name phase archive input') (#try.Failure error) - (phase.throw extension.invalid_syntax [extension_name %.code input])))) + (phase.except extension.invalid_syntax [extension_name %.code input])))) (type: Declaration [External (List (Type Var))]) @@ -678,7 +678,7 @@ state ..state _ (.tuple (<>.some ..annotation)) type ..value] - (wrap [name privacy state (list) type])))) + (in [name privacy state (list) type])))) (type: Argument [Text (Type Value)]) @@ -1021,7 +1021,7 @@ [typeL (//A.reflection_type mapping typeJ) termA (typeA.with_type typeL (analyse archive termC))] - (wrap [typeJ termA]))) + (in [typeJ termA]))) constructor_argumentsC) selfT (//A.reflection_type mapping (/type.class class_name class_tvars)) arguments' (monad.map ! @@ -1031,14 +1031,14 @@ arguments) returnT (//A.boxed_reflection_return mapping /type.void) [_scope bodyA] (|> arguments' - (#.Cons [self selfT]) - list.reverse + (#.Item [self selfT]) + list.reversed (list\fold scopeA.with_local (analyse archive bodyC)) (typeA.with_type returnT) analysis.with_scope)] - (wrap [privacy strict_floating_point? annotations method_tvars exceptions - self arguments constructor_argumentsA - bodyA]))))) + (in [privacy strict_floating_point? annotations method_tvars exceptions + self arguments constructor_argumentsA + bodyA]))))) (def: (override_method_analysis archive [class_name class_tvars] supers method) (-> Archive Declaration (List (Type Class)) (Override Code) (Operation (Override Analysis))) @@ -1061,14 +1061,14 @@ arguments) returnT (//A.boxed_reflection_return mapping returnJ) [_scope bodyA] (|> arguments' - (#.Cons [self selfT]) - list.reverse + (#.Item [self selfT]) + list.reversed (list\fold scopeA.with_local (analyse archive bodyC)) (typeA.with_type returnT) analysis.with_scope)] - (wrap [[super_name super_tvars] method_name strict_floating_point? annotations - method_tvars self arguments returnJ exceptionsJ - bodyA]))))) + (in [[super_name super_tvars] method_name strict_floating_point? annotations + method_tvars self arguments returnJ exceptionsJ + bodyA]))))) (def: (virtual_method_analysis archive [class_name class_tvars] method) (-> Archive Declaration (Virtual Code) (Operation (Virtual Analysis))) @@ -1089,14 +1089,14 @@ arguments) returnT (//A.boxed_reflection_return mapping returnJ) [_scope bodyA] (|> arguments' - (#.Cons [self selfT]) - list.reverse + (#.Item [self selfT]) + list.reversed (list\fold scopeA.with_local (analyse archive bodyC)) (typeA.with_type returnT) analysis.with_scope)] - (wrap [name privacy final? strict_floating_point? annotations method_tvars - self arguments returnJ exceptionsJ - bodyA]))))) + (in [name privacy final? strict_floating_point? annotations method_tvars + self arguments returnJ exceptionsJ + bodyA]))))) (def: (static_method_analysis archive method) (-> Archive (Static Code) (Operation (Static Analysis))) @@ -1115,13 +1115,13 @@ arguments) returnT (//A.boxed_reflection_return mapping returnJ) [_scope bodyA] (|> arguments' - list.reverse + list.reversed (list\fold scopeA.with_local (analyse archive bodyC)) (typeA.with_type returnT) analysis.with_scope)] - (wrap [name privacy strict_floating_point? annotations method_tvars - arguments returnJ exceptionsJ - bodyA]))))) + (in [name privacy strict_floating_point? annotations method_tvars + arguments returnJ exceptionsJ + bodyA]))))) (def: (method_analysis archive declaration supers method) (-> Archive Declaration (List (Type Class)) (Method Code) (Operation (Method Analysis))) @@ -1143,7 +1143,7 @@ (static_method_analysis archive method)) (#Abstract method) - (\ phase.monad wrap (#Abstract method)) + (\ phase.monad in (#Abstract method)) )) (template: (method_body ) @@ -1167,14 +1167,14 @@ (synthesise archive termA))) constructor_argumentsA) bodyS (synthesise archive (#analysis.Function (list) (//A.hide_method_body (list.size arguments) bodyA)))] - (wrap [privacy strict_floating_point? annotations method_tvars exceptions - self arguments constructor_argumentsS - (case bodyS - (^ (method_body bodyS)) - bodyS + (in [privacy strict_floating_point? annotations method_tvars exceptions + self arguments constructor_argumentsS + (case bodyS + (^ (method_body bodyS)) + bodyS - _ - bodyS)]))))) + _ + bodyS)]))))) (def: (override_method_synthesis archive method) (-> Archive (Override Analysis) (Operation (Override Synthesis))) @@ -1186,14 +1186,14 @@ (directive.lift_synthesis (do ! [bodyS (synthesise archive (#analysis.Function (list) (//A.hide_method_body (list.size arguments) bodyA)))] - (wrap [[super_name super_tvars] method_name strict_floating_point? annotations - method_tvars self arguments returnJ exceptionsJ - (case bodyS - (^ (method_body bodyS)) - bodyS + (in [[super_name super_tvars] method_name strict_floating_point? annotations + method_tvars self arguments returnJ exceptionsJ + (case bodyS + (^ (method_body bodyS)) + bodyS - _ - bodyS)]))))) + _ + bodyS)]))))) (def: (virtual_method_synthesis archive method) (-> Archive (Virtual Analysis) (Operation (Virtual Synthesis))) @@ -1205,14 +1205,14 @@ (directive.lift_synthesis (do ! [bodyS (synthesise archive (#analysis.Function (list) (//A.hide_method_body (list.size arguments) bodyA)))] - (wrap [name privacy final? strict_floating_point? annotations method_tvars - self arguments returnJ exceptionsJ - (case bodyS - (^ (method_body bodyS)) - bodyS + (in [name privacy final? strict_floating_point? annotations method_tvars + self arguments returnJ exceptionsJ + (case bodyS + (^ (method_body bodyS)) + bodyS - _ - bodyS)]))))) + _ + bodyS)]))))) (def: (static_method_synthesis archive method) (-> Archive (Static Analysis) (Operation (Static Synthesis))) @@ -1224,14 +1224,14 @@ (directive.lift_synthesis (do ! [bodyS (synthesise archive (#analysis.Function (list) (//A.hide_method_body (list.size arguments) bodyA)))] - (wrap [name privacy strict_floating_point? annotations method_tvars - arguments returnJ exceptionsJ - (case bodyS - (^ (method_body bodyS)) - bodyS + (in [name privacy strict_floating_point? annotations method_tvars + arguments returnJ exceptionsJ + (case bodyS + (^ (method_body bodyS)) + bodyS - _ - bodyS)]))))) + _ + bodyS)]))))) (def: (method_synthesis archive method) (-> Archive (Method Analysis) (Operation (Method Synthesis))) @@ -1253,7 +1253,7 @@ (static_method_synthesis archive method)) (#Abstract method) - (\ phase.monad wrap (#Abstract method)) + (\ phase.monad in (#Abstract method)) )) (def: (constructor_method_generation archive super_class method) @@ -1279,16 +1279,16 @@ (|>> (_.ALOAD 0) super_constructor_argument_values (_.INVOKESPECIAL super_class ..constructor_name super_constructorT)))]] - (wrap (def.method (..visibility privacy) - (if strict_floating_point? - jvm.strictM - jvm.noneM) - ..constructor_name - (/type.method [method_tvars argumentsT /type.void exceptions]) - (|>> initialize_object! - (//G.prepare_arguments 1 argumentsT) - bodyG - _.RETURN))))))) + (in (def.method (..visibility privacy) + (if strict_floating_point? + jvm.strictM + jvm.noneM) + ..constructor_name + (/type.method [method_tvars argumentsT /type.void exceptions]) + (|>> initialize_object! + (//G.prepare_arguments 1 argumentsT) + bodyG + _.RETURN))))))) (def: (override_method_generation archive method) (-> Archive (Override Synthesis) (Operation jvm.Def)) @@ -1301,15 +1301,15 @@ (do ! [bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS)) #let [argumentsT (list\map product.right arguments)]] - (wrap (def.method #jvm.Public - (if strict_floating_point? - jvm.strictM - jvm.noneM) - method_name - (/type.method [method_tvars argumentsT returnJ exceptionsJ]) - (|>> (//G.prepare_arguments 1 argumentsT) - bodyG - (//G.returnI returnJ)))))))) + (in (def.method #jvm.Public + (if strict_floating_point? + jvm.strictM + jvm.noneM) + method_name + (/type.method [method_tvars argumentsT returnJ exceptionsJ]) + (|>> (//G.prepare_arguments 1 argumentsT) + bodyG + (//G.returnI returnJ)))))))) (def: (virtual_method_generation archive method) (-> Archive (Virtual Synthesis) (Operation jvm.Def)) @@ -1322,19 +1322,19 @@ (do ! [bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS)) #let [argumentsT (list\map product.right arguments)]] - (wrap (def.method (..visibility privacy) - (|> jvm.noneM - (jvm.++M (if strict_floating_point? - jvm.strictM - jvm.noneM)) - (jvm.++M (if final? - jvm.finalM - jvm.noneM))) - method_name - (/type.method [method_tvars argumentsT returnJ exceptionsJ]) - (|>> (//G.prepare_arguments 1 argumentsT) - bodyG - (//G.returnI returnJ)))))))) + (in (def.method (..visibility privacy) + (|> jvm.noneM + (jvm.++M (if strict_floating_point? + jvm.strictM + jvm.noneM)) + (jvm.++M (if final? + jvm.finalM + jvm.noneM))) + method_name + (/type.method [method_tvars argumentsT returnJ exceptionsJ]) + (|>> (//G.prepare_arguments 1 argumentsT) + bodyG + (//G.returnI returnJ)))))))) (def: (static_method_generation archive method) (-> Archive (Static Synthesis) (Operation jvm.Def)) @@ -1347,16 +1347,16 @@ (do ! [bodyG (generate archive (//G.hidden_method_body (list.size arguments) bodyS)) #let [argumentsT (list\map product.right arguments)]] - (wrap (def.method (..visibility privacy) - (|> jvm.staticM - (jvm.++M (if strict_floating_point? - jvm.strictM - jvm.noneM))) - method_name - (/type.method [method_tvars argumentsT returnJ exceptionsJ]) - (|>> (//G.prepare_arguments 0 argumentsT) - bodyG - (//G.returnI returnJ)))))))) + (in (def.method (..visibility privacy) + (|> jvm.staticM + (jvm.++M (if strict_floating_point? + jvm.strictM + jvm.noneM))) + method_name + (/type.method [method_tvars argumentsT returnJ exceptionsJ]) + (|>> (//G.prepare_arguments 0 argumentsT) + bodyG + (//G.returnI returnJ)))))))) (def: (method_generation archive super_class method) (-> Archive (Type Class) (Method Synthesis) (Operation jvm.Def)) @@ -1374,7 +1374,7 @@ (..static_method_generation archive method) (#Abstract method) - (\ phase.monad wrap (..abstract_method_generation method)) + (\ phase.monad in (..abstract_method_generation method)) )) (import: java/lang/ClassLoader) @@ -1445,7 +1445,7 @@ _ (generation.execute! directive) _ (generation.save! artifact_id (#.Some class_name) directive) _ (generation.log! (format "JVM Class " (%.text class_name)))] - (wrap directive.no_requirements)))))])) + (in directive.no_requirements)))))])) (def: jvm::class::interface ..Handler @@ -1472,7 +1472,7 @@ _ (generation.execute! directive) _ (generation.save! artifact_id (#.Some class_name) directive) _ (generation.log! (format "JVM Interface " (%.text class_name)))] - (wrap directive.no_requirements)))))])) + (in directive.no_requirements)))))])) (def: #export (bundle class_loader extender) (-> java/lang/ClassLoader jvm.Extender (directive.Bundle jvm.Anchor jvm.Inst jvm.Definition)) diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux index 1c81be667..5c854d646 100644 --- a/lux-jvm/source/luxc/lang/host/jvm.lux +++ b/lux-jvm/source/luxc/lang/host/jvm.lux @@ -103,25 +103,25 @@ (|> (~ g!none) (set@ (~ (code.local_tag option)) #1))))) options)] - (wrap (list& (` (type: (~' #export) (~ g!type) - (~ (code.record (list/map (function (_ tag) - [tag (` .Bit)]) - g!tags+))))) - - (` (def: (~' #export) (~ g!none) - (~ g!type) - (~ (code.record (list/map (function (_ tag) - [tag (` #0)]) - g!tags+))))) - - (` (def: (~' #export) ((~ (code.local_identifier ++)) (~ g!_left) (~ g!_right)) - (-> (~ g!type) (~ g!type) (~ g!type)) - (~ (code.record (list/map (function (_ tag) - [tag (` (or (get@ (~ tag) (~ g!_left)) - (get@ (~ tag) (~ g!_right))))]) - g!tags+))))) - - g!options+)))) + (in (list& (` (type: (~' #export) (~ g!type) + (~ (code.record (list/map (function (_ tag) + [tag (` .Bit)]) + g!tags+))))) + + (` (def: (~' #export) (~ g!none) + (~ g!type) + (~ (code.record (list/map (function (_ tag) + [tag (` #0)]) + g!tags+))))) + + (` (def: (~' #export) ((~ (code.local_identifier ++)) (~ g!_left) (~ g!_right)) + (-> (~ g!type) (~ g!type) (~ g!type)) + (~ (code.record (list/map (function (_ tag) + [tag (` (or (get@ (~ tag) (~ g!_left)) + (get@ (~ tag) (~ g!_right))))]) + g!tags+))))) + + g!options+)))) (config: Class_Config noneC ++C [finalC]) (config: Method_Config noneM ++M [finalM staticM synchronizedM strictM]) diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux index 953dbf200..e1e60179f 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/def.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -293,11 +293,11 @@ (def: #export (fuse defs) (-> (List //.Def) //.Def) (case defs - #.Nil + #.End function.identity - (#.Cons singleton #.Nil) + (#.Item singleton #.End) singleton - (#.Cons head tail) + (#.Item head tail) (function.compose (fuse tail) head))) diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index e86504d60..ea68f2680 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -47,7 +47,7 @@ (syntax: (declare {codes (p.many s.local_identifier)}) (|> codes (list@map (function (_ code) (` ((~' #static) (~ (code.local_identifier code)) (~' int))))) - wrap)) + in)) (`` (import: org/objectweb/asm/Opcodes ["#::." @@ -375,7 +375,7 @@ labels_array (ffi.array org/objectweb/asm/Label array_size) _ (loop [idx 0] (if (n.< array_size idx) - (let [[key label] (maybe.assume (list.nth idx keys+labels))] + (let [[key label] (maybe.assume (list.item idx keys+labels))] (exec (ffi.array_write idx (ffi.long_to_int key) keys_array) (ffi.array_write idx label labels_array) @@ -392,7 +392,7 @@ _ (loop [idx 0] (if (n.< num_labels idx) (exec (ffi.array_write idx - (maybe.assume (list.nth idx labels)) + (maybe.assume (list.item idx labels)) labels_array) (recur (inc idx))) []))] @@ -459,11 +459,11 @@ (def: #export (fuse insts) (-> (List Inst) Inst) (case insts - #.Nil + #.End function.identity - (#.Cons singleton #.Nil) + (#.Item singleton #.End) singleton - (#.Cons head tail) + (#.Item head tail) (function.compose (fuse tail) head))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm.lux b/lux-jvm/source/luxc/lang/translation/jvm.lux index 1b916d925..4cf712a45 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm.lux @@ -88,13 +88,13 @@ (#try.Success value) #.None - (exception.throw ..invalid_value class_name)) + (exception.except ..invalid_value class_name)) (#try.Failure error) - (exception.throw ..cannot_load [class_name error])) + (exception.except ..cannot_load [class_name error])) (#try.Failure error) - (exception.throw ..invalid_field [class_name ..value_field error]))) + (exception.except ..invalid_field [class_name ..value_field error]))) (def: class_path_separator ".") @@ -129,9 +129,9 @@ (io.run (do (try.with io.monad) [_ (loader.store eval_class bytecode library) class (loader.load eval_class loader) - value (\ io.monad wrap (..class_value eval_class class))] - (wrap [value - [eval_class bytecode]]))))) + value (\ io.monad in (..class_value eval_class class))] + (in [value + [eval_class bytecode]]))))) (def: (execute! library loader [class_name class_bytecode]) (-> Library java/lang/ClassLoader Definition (Try Any)) @@ -142,7 +142,7 @@ (try.lifted io.monad) (: (IO (Try Bit)))) _ (if existing_class? - (wrap []) + (in []) (loader.store class_name class_bytecode library))] (loader.load class_name loader)))) @@ -150,9 +150,9 @@ (-> Library java/lang/ClassLoader generation.Context (Maybe Text) Inst (Try [Text Any Definition])) (do try.monad [[value definition] (evaluate! library loader context valueI)] - (wrap [(maybe.default (..class_name context) - custom) - value definition]))) + (in [(maybe.else (..class_name context) + custom) + value definition]))) (def: #export host (IO [java/lang/ClassLoader Host]) @@ -176,16 +176,16 @@ (def: (re_learn context custom [_ bytecode]) (io.run - (loader.store (maybe.default (..class_name context) custom) bytecode library))) + (loader.store (maybe.else (..class_name context) custom) bytecode library))) (def: (re_load context custom [directive_name bytecode]) (io.run (do (try.with io.monad) - [#let [class_name (maybe.default (..class_name context) - custom)] + [#let [class_name (maybe.else (..class_name context) + custom)] _ (loader.store class_name bytecode library) class (loader.load class_name loader)] - (\ io.monad wrap (..class_value class_name class)))))))]))) + (\ io.monad in (..class_value class_name class)))))))]))) (def: #export $Variant (type.array ..$Value)) 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 [ ] [( 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)) - (|>> - ( test) - - ( @else) - - thenG - (_.label @else) - elseG))))) + (in (<| _.with_label (function (_ @else)) + (|>> + ( test) + + ( @else) + + thenG + (_.label @else) + elseG))))) (|>> (_.GOTO @else)) - (#.Cons cons)))] - (wrap (|>> peekI - - forkG)))]) + (#.Item cons)))] + (in (|>> peekI + + 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 [ ] [(^ ( lefts)) - (operation@wrap (<| _.with_label (function (_ @success)) - _.with_label (function (_ @fail)) - (|>> peekI - (_.CHECKCAST //.$Variant) - (structure.tagI lefts ) - (structure.flagI ) - (_.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 ) + (structure.flagI ) + (_.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 [ ] [(^ ( lefts)) - (operation@wrap (|>> peekI - ( lefts) - pushI)) + (operation@in (|>> peekI + ( lefts) + pushI)) (^ (synthesis.path/seq ( lefts) (synthesis.!bind_top register thenP))) (do phase.monad [then! (path' stack_depth @else @end phase archive thenP)] - (wrap (|>> peekI - ( lefts) - (_.ASTORE register) - then!)))]) + (in (|>> peekI + ( 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 [ ] [(def: #export (Parser (Type )) - (.embed .text))] + (.then .text))] [var Var parser.var] [class Class parser.class] @@ -94,15 +94,15 @@ (def: #export object_array (Parser (Type Object)) (do <>.monad - [arrayJT (.embed parser.array .text)] + [arrayJT (.then parser.array .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 [ ] [(def: Inst - )] + (|>> _.L2I ))] - [L2S (|>> _.L2I _.I2S)] - [L2B (|>> _.L2I _.I2B)] - [L2C (|>> _.L2I _.I2C)] + [L2S _.I2S] + [L2B _.I2B] + [L2C _.I2C] ) (template [ ] @@ -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\= to)) - (wrap (|>> valueI (_.wrap ))) + (in (|>> valueI (_.wrap ))) (and (text\= from) (text\= (reflection.reflection (type.reflection )) to)) - (wrap (|>> valueI (_.unwrap )))] + (in (|>> valueI (_.unwrap )))] [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 [ ] [(def: @@ -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)) - ( 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)) + ( 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 "" (type.method [(list) (list\map product.left inputsTI) type.void (list)]))))))])) + (in (|>> (_.NEW class) + _.DUP + (_.fuse (list\map product.right inputsTI)) + (_.INVOKESPECIAL class "" (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 @@ .tuple (<>.after .any) .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 "" (anonymous_init_method env)))))) + (in (|>> (_.NEW class) + _.DUP + (_.fuse captureI+) + (_.INVOKESPECIAL class "" (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_method env arity)))))) + (in (|>> (_.NEW class) + _.DUP + (_.fuse captureI+) + argsI + (_.INVOKESPECIAL class "" (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 [ ] [ - (operation@wrap (|>> (_.wrap type.long)))]) + (operation@in (|>> (_.wrap type.long)))]) ([+0 _.LCONST_0] [+1 _.LCONST_1]) (^template [ ] [ - (operation@wrap (|>> _.I2L (_.wrap type.long)))]) + (operation@in (|>> _.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 [ ] [ - (operation@wrap (|>> (_.wrap type.double)))]) + (operation@in (|>> (_.wrap type.double)))]) ([+1.0 _.DCONST_1]) (^template [ ] [ - (operation@wrap (|>> _.F2D (_.wrap type.double)))]) + (operation@in (|>> _.F2D (_.wrap type.double)))]) ([+2.0 _.FCONST_2]) (^template [ ] [ - (operation@wrap (|>> _.I2D (_.wrap type.double)))]) + (operation@in (|>> _.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)])))))) diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index 60fb953aa..6442a87e7 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -212,19 +212,19 @@ (do phase.monad [instanceG (function.function' (#.Some [0 (.nat -1)]) expression.translate archive [(list) 4 ..how_to_wrap_a_phase]) phase_wrapper (generation.evaluate! [0 (.nat -2)] instanceG)] - (wrap (function (_ phase) - (<| try.assumed - (: (Try java/lang/Object)) - (do try.monad - [apply_method (|> phase_wrapper - (:as java/lang/Object) - (java/lang/Object::getClass) - (java/lang/Class::getMethod runtime.apply_method _apply1_args))] - (java/lang/reflect/Method::invoke - (:as java/lang/Object phase_wrapper) - (|> (ffi.array java/lang/Object 1) - (ffi.array_write 0 (:as java/lang/Object phase))) - apply_method))))))) + (in (function (_ phase) + (<| try.assumed + (: (Try java/lang/Object)) + (do try.monad + [apply_method (|> phase_wrapper + (:as java/lang/Object) + (java/lang/Object::getClass) + (java/lang/Class::getMethod runtime.apply_method _apply1_args))] + (java/lang/reflect/Method::invoke + (:as java/lang/Object phase_wrapper) + (|> (ffi.array java/lang/Object 1) + (ffi.array_write 0 (:as java/lang/Object phase))) + apply_method))))))) (def: #export platform ## (IO (Platform Anchor (Bytecode Any) Definition)) @@ -233,15 +233,15 @@ (do io.monad [## host jvm/host.host [loader host] jvm.host] - (wrap [loader - {#platform.&file_system (file.async file.default) - #platform.host host - ## #platform.phase jvm.generate - #platform.phase expression.translate - ## #platform.runtime runtime.generate - #platform.runtime runtime.translate - #platform.phase_wrapper ..phase_wrapper - #platform.write product.right}]))) + (in [loader + {#platform.&file_system (file.async file.default) + #platform.host host + ## #platform.phase jvm.generate + #platform.phase expression.translate + ## #platform.runtime runtime.generate + #platform.runtime runtime.translate + #platform.phase_wrapper ..phase_wrapper + #platform.write product.right}]))) (def: (extender phase_wrapper) (-> platform.Phase_Wrapper Extender) -- cgit v1.2.3