From e00ba096c8837abe85d366e0c1293c09dbe84d81 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 18 Aug 2021 03:29:15 -0400 Subject: Some bug fixes. --- lux-jvm/source/luxc/lang/directive/jvm.lux | 2 +- lux-jvm/source/luxc/lang/host/jvm.lux | 6 +-- lux-jvm/source/luxc/lang/host/jvm/def.lux | 20 ++++---- lux-jvm/source/luxc/lang/host/jvm/inst.lux | 14 +++--- lux-jvm/source/luxc/lang/translation/jvm/case.lux | 2 +- .../source/luxc/lang/translation/jvm/common.lux | 10 ++-- .../luxc/lang/translation/jvm/extension/host.lux | 2 +- .../source/luxc/lang/translation/jvm/function.lux | 34 ++++++------- .../source/luxc/lang/translation/jvm/program.lux | 4 +- .../source/luxc/lang/translation/jvm/runtime.lux | 4 +- .../source/luxc/lang/translation/jvm/structure.lux | 2 +- lux-jvm/source/program.lux | 58 +++++++++++----------- 12 files changed, 79 insertions(+), 79 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 99ac39c78..a7314b0dc 100644 --- a/lux-jvm/source/luxc/lang/directive/jvm.lux +++ b/lux-jvm/source/luxc/lang/directive/jvm.lux @@ -517,7 +517,7 @@ (Re_labeler (/.Bytecode Inst)) (row\fold (function (_ input [mapping output]) (let [[mapping input'] (..relabel_instruction [mapping input])] - [mapping (row.add input' output)])) + [mapping (row.suffix input' output)])) [mapping (row.row)] bytecode)) diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux index 6ce7badc5..e24922771 100644 --- a/lux-jvm/source/luxc/lang/host/jvm.lux +++ b/lux-jvm/source/luxc/lang/host/jvm.lux @@ -101,7 +101,7 @@ (` (def: .public (~ (code.local_identifier option)) (~ g!type) (|> (~ g!none) - (set@ (~ (code.local_tag option)) #1))))) + (with@ (~ (code.local_tag option)) #1))))) options)] (in (list& (` (type: .public (~ g!type) (~ (code.record (list/map (function (_ tag) @@ -117,8 +117,8 @@ (` (def: .public ((~ (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))))]) + [tag (` (or (value@ (~ tag) (~ g!_left)) + (value@ (~ tag) (~ g!_right))))]) g!tags+))))) g!options+)))) diff --git a/lux-jvm/source/luxc/lang/host/jvm/def.lux b/lux-jvm/source/luxc/lang/host/jvm/def.lux index f8233222d..130e0bb56 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/def.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/def.lux @@ -83,7 +83,7 @@ (-> (List Text) (Array Text)) (let [output (ffi.array java/lang/String (list.size values))] (exec (list@map (function (_ [idx value]) - (ffi.array_write idx value output)) + (ffi.write! idx value output)) (list.enumeration values)) output))) @@ -110,23 +110,23 @@ (def: (class_flags config) (-> //.Class_Config Int) ($_ i.+ - (if (get@ #//.finalC config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0))) + (if (value@ #//.finalC config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0))) (def: (method_flags config) (-> //.Method_Config Int) ($_ i.+ - (if (get@ #//.staticM config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) - (if (get@ #//.finalM config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) - (if (get@ #//.synchronizedM config) (org/objectweb/asm/Opcodes::ACC_SYNCHRONIZED) +0) - (if (get@ #//.strictM config) (org/objectweb/asm/Opcodes::ACC_STRICT) +0))) + (if (value@ #//.staticM config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) + (if (value@ #//.finalM config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) + (if (value@ #//.synchronizedM config) (org/objectweb/asm/Opcodes::ACC_SYNCHRONIZED) +0) + (if (value@ #//.strictM config) (org/objectweb/asm/Opcodes::ACC_STRICT) +0))) (def: (field_flags config) (-> //.Field_Config Int) ($_ i.+ - (if (get@ #//.staticF config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) - (if (get@ #//.finalF config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) - (if (get@ #//.transientF config) (org/objectweb/asm/Opcodes::ACC_TRANSIENT) +0) - (if (get@ #//.volatileF config) (org/objectweb/asm/Opcodes::ACC_VOLATILE) +0))) + (if (value@ #//.staticF config) (org/objectweb/asm/Opcodes::ACC_STATIC) +0) + (if (value@ #//.finalF config) (org/objectweb/asm/Opcodes::ACC_FINAL) +0) + (if (value@ #//.transientF config) (org/objectweb/asm/Opcodes::ACC_TRANSIENT) +0) + (if (value@ #//.volatileF config) (org/objectweb/asm/Opcodes::ACC_VOLATILE) +0))) (def: param_signature (-> (Type Class) Text) diff --git a/lux-jvm/source/luxc/lang/host/jvm/inst.lux b/lux-jvm/source/luxc/lang/host/jvm/inst.lux index 0c724ca87..e0402d924 100644 --- a/lux-jvm/source/luxc/lang/host/jvm/inst.lux +++ b/lux-jvm/source/luxc/lang/host/jvm/inst.lux @@ -377,9 +377,9 @@ (if (n.< array_size idx) (let [[key label] (maybe.trusted (list.item idx keys+labels))] (exec - (ffi.array_write idx (ffi.long_to_int key) keys_array) - (ffi.array_write idx label labels_array) - (recur (inc idx)))) + (ffi.write! idx (ffi.long_to_int key) keys_array) + (ffi.write! idx label labels_array) + (recur (++ idx)))) []))] (do_to visitor (org/objectweb/asm/MethodVisitor::visitLookupSwitchInsn default keys_array labels_array))))) @@ -391,10 +391,10 @@ labels_array (ffi.array org/objectweb/asm/Label num_labels) _ (loop [idx 0] (if (n.< num_labels idx) - (exec (ffi.array_write idx - (maybe.trusted (list.item idx labels)) - labels_array) - (recur (inc idx))) + (exec (ffi.write! idx + (maybe.trusted (list.item idx labels)) + labels_array) + (recur (++ idx))) []))] (do_to visitor (org/objectweb/asm/MethodVisitor::visitTableSwitchInsn min max default labels_array))))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux index d3f6a29c1..3a6291036 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux @@ -212,7 +212,7 @@ (#synthesis.Alt leftP rightP) (do phase.monad [@alt_else _.make_label - leftI (path' (inc stack_depth) @alt_else @end phase archive leftP) + leftI (path' (++ stack_depth) @alt_else @end phase archive leftP) rightI (path' stack_depth @else @end phase archive rightP)] (in (|>> _.DUP leftI diff --git a/lux-jvm/source/luxc/lang/translation/jvm/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/common.lux index b6bba249f..cfdadecb5 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/common.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/common.lux @@ -31,18 +31,18 @@ ... (def: .public (with-artifacts action) ... (All [a] (-> (Meta a) (Meta [Artifacts a]))) ... (function (_ state) -... (case (action (update@ #.host +... (case (action (revised@ #.host ... (|>> (:coerce Host) -... (set@ #artifacts (dictionary.new text.hash)) +... (with@ #artifacts (dictionary.new text.hash)) ... (:coerce Nothing)) ... state)) ... (#try.Success [state' output]) -... (#try.Success [(update@ #.host +... (#try.Success [(revised@ #.host ... (|>> (:coerce Host) -... (set@ #artifacts (|> (get@ #.host state) (:coerce Host) (get@ #artifacts))) +... (with@ #artifacts (|> (value@ #.host state) (:coerce Host) (value@ #artifacts))) ... (:coerce Nothing)) ... state') -... [(|> state' (get@ #.host) (:coerce Host) (get@ #artifacts)) +... [(|> state' (value@ #.host) (:coerce Host) (value@ #artifacts)) ... output]]) ... (#try.Failure error) 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 20962c13d..31538a0bd 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux @@ -977,7 +977,7 @@ list.indices (list\map (.function (_ register) (|>> (_.ALOAD 0) - (_.ALOAD (inc register)) + (_.ALOAD (++ register)) (_.PUTFIELD class (///reference.foreign_name register) $Object)))) _.fuse)] (_def.method #$.Public $.noneM "" (anonymous_init_method env) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux index 9af108496..0508e9c62 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux @@ -58,9 +58,9 @@ (-> (Environment Synthesis) Arity (Type Method)) (if (poly_arg? arity) (type.method [(list) - (list.joined (list (captured_args env) - (list type.int) - (list.repeated (dec arity) //.$Value))) + (list.together (list (captured_args env) + (list type.int) + (list.repeated (-- arity) //.$Value))) type.void (list)]) (type.method [(list) (captured_args env) type.void (list)]))) @@ -80,7 +80,7 @@ (def: (inputsI start amount) (-> Register Nat Inst) - (|> (enum.range n.enum start (n.+ start (dec amount))) + (|> (enum.range n.enum start (n.+ start (-- amount))) (list@map _.ALOAD) _.fuse)) @@ -111,7 +111,7 @@ (do {@ phase.monad} [captureI+ (monad.map @ (generate archive) env) .let [argsI (if (poly_arg? arity) - (|> (nullsI (dec arity)) + (|> (nullsI (-- arity)) (list (_.int +0)) _.fuse) function.identity)]] @@ -132,12 +132,12 @@ (let [env_size (list.size env) captureI (|> (case env_size 0 (list) - _ (enum.range n.enum 0 (dec env_size))) + _ (enum.range n.enum 0 (-- env_size))) (list@map (.function (_ source) (|>> (_.ALOAD 0) (_.GETFIELD class (reference.foreign_name source) //.$Value)))) _.fuse) - argsI (|> (nullsI (dec arity)) + argsI (|> (nullsI (-- arity)) (list (_.int +0)) _.fuse)] (|>> (_.NEW class) @@ -164,20 +164,20 @@ (if (n.= 1 arity) (|>> (_.int +0) (_.INVOKESPECIAL //.$Function "" function_init_method)) - (|>> (_.ILOAD (inc env_size)) + (|>> (_.ILOAD (++ env_size)) (_.INVOKESPECIAL //.$Function "" function_init_method)))) (def: (with_init class env arity) (-> (Type Class) (Environment Synthesis) Arity Def) (let [env_size (list.size env) offset_partial (: (-> Nat Nat) - (|>> inc (n.+ env_size))) + (|>> ++ (n.+ env_size))) store_capturedI (|> (case env_size 0 (list) - _ (enum.range n.enum 0 (dec env_size))) + _ (enum.range n.enum 0 (-- env_size))) (list@map (.function (_ register) (|>> (_.ALOAD 0) - (_.ALOAD (inc register)) + (_.ALOAD (++ register)) (_.PUTFIELD class (reference.foreign_name register) //.$Value)))) _.fuse) store_partialI (if (poly_arg? arity) @@ -185,7 +185,7 @@ (list@map (.function (_ idx) (let [register (offset_partial idx)] (|>> (_.ALOAD 0) - (_.ALOAD (inc register)) + (_.ALOAD (++ register)) (_.PUTFIELD class (reference.partial_name idx) //.$Value))))) _.fuse) function.identity)] @@ -199,7 +199,7 @@ (def: (with_apply class env function_arity @begin bodyI apply_arity) (-> (Type Class) (Environment Synthesis) Arity Label Inst Arity Def) - (let [num_partials (dec function_arity) + (let [num_partials (-- function_arity) @default ($.new_label []) @labels (list@map $.new_label (list.repeated num_partials [])) over_extent (|> (.int function_arity) (i.- (.int apply_arity))) @@ -207,7 +207,7 @@ (list.zipped/2 (enum.range n.enum 0 num_partials)) (list@map (.function (_ [stage @label]) (let [load_partialsI (if (n.> 0 stage) - (|> (enum.range n.enum 0 (dec stage)) + (|> (enum.range n.enum 0 (-- stage)) (list@map (|>> reference.partial_name (load_fieldI class))) _.fuse) function.identity)] @@ -230,14 +230,14 @@ load_partialsI (inputsI 1 args_to_completion) (_.INVOKEVIRTUAL class "impl" (implementation_method function_arity)) - (applysI (inc args_to_completion) args_left) + (applysI (++ args_to_completion) args_left) _.ARETURN)) ... (i.< over_extent (.int stage)) (let [env_size (list.size env) load_capturedI (|> (case env_size 0 (list) - _ (enum.range n.enum 0 (dec env_size))) + _ (enum.range n.enum 0 (-- env_size))) (list@map (|>> reference.foreign_name (load_fieldI class))) _.fuse)] (|>> (_.label @label) @@ -255,7 +255,7 @@ _.fuse)] (def.method #$.Public $.noneM //runtime.apply_method (//runtime.apply_signature apply_arity) (|>> get_amount_of_partialsI - (_.TABLESWITCH +0 (|> num_partials dec .int) + (_.TABLESWITCH +0 (|> num_partials -- .int) @default @labels) casesI )))) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/program.lux b/lux-jvm/source/luxc/lang/translation/jvm/program.lux index 8d95becc1..ab36835da 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/program.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/program.lux @@ -29,7 +29,7 @@ (-> (-> Context Text) (Program _.Inst _.Definition)) (let [nilI runtime.noneI num_inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH) - decI (|>> ($i.int +1) $i.ISUB) + --I (|>> ($i.int +1) $i.ISUB) headI (|>> $i.DUP ($i.ALOAD 0) $i.SWAP @@ -59,7 +59,7 @@ (|>> nilI num_inputsI ($i.label @loop) - decI + --I $i.DUP ($i.IFLT @end) headI diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux index 2808065c6..23d59b8f4 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux @@ -361,11 +361,11 @@ (let [applyI (|> (enum.range n.enum 2 num_apply_variants) (list@map (function (_ arity) ($d.method #$.Public $.noneM apply_method (apply_signature arity) - (let [preI (|> (enum.range n.enum 0 (dec arity)) + (let [preI (|> (enum.range n.enum 0 (-- arity)) (list@map _.ALOAD) _.fuse)] (|>> preI - (_.INVOKEVIRTUAL //.$Function apply_method (apply_signature (dec arity))) + (_.INVOKEVIRTUAL //.$Function apply_method (apply_signature (-- arity))) (_.CHECKCAST //.$Function) (_.ALOAD arity) (_.INVOKEVIRTUAL //.$Function apply_method (apply_signature 1)) diff --git a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux index ce9c56aed..71e9c514f 100644 --- a/lux-jvm/source/luxc/lang/translation/jvm/structure.lux +++ b/lux-jvm/source/luxc/lang/translation/jvm/structure.lux @@ -75,7 +75,7 @@ (def: .public (tagI lefts right?) (-> Nat Bit Inst) (case (if right? - (.inc lefts) + (.++ lefts) lefts) 0 _.ICONST_0 1 _.ICONST_1 diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index 767101102..deef09f36 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -95,22 +95,22 @@ (def: _apply1_args (Array (java/lang/Class java/lang/Object)) (|> (ffi.array (java/lang/Class java/lang/Object) 1) - (ffi.array_write 0 _object_class))) + (ffi.write! 0 _object_class))) (def: _apply2_args (Array (java/lang/Class java/lang/Object)) (|> (ffi.array (java/lang/Class java/lang/Object) 2) - (ffi.array_write 0 _object_class) - (ffi.array_write 1 _object_class))) + (ffi.write! 0 _object_class) + (ffi.write! 1 _object_class))) (def: _apply5_args (Array (java/lang/Class java/lang/Object)) (|> (ffi.array (java/lang/Class java/lang/Object) 5) - (ffi.array_write 0 _object_class) - (ffi.array_write 1 _object_class) - (ffi.array_write 2 _object_class) - (ffi.array_write 3 _object_class) - (ffi.array_write 4 _object_class))) + (ffi.write! 0 _object_class) + (ffi.write! 1 _object_class) + (ffi.write! 2 _object_class) + (ffi.write! 3 _object_class) + (ffi.write! 4 _object_class))) (def: .public (expander macro inputs lux) Expander @@ -123,8 +123,8 @@ (java/lang/reflect/Method::invoke (:as java/lang/Object macro) (|> (ffi.array java/lang/Object 2) - (ffi.array_write 0 (:as java/lang/Object inputs)) - (ffi.array_write 1 (:as java/lang/Object lux))) + (ffi.write! 0 (:as java/lang/Object inputs)) + (ffi.write! 1 (:as java/lang/Object lux))) apply_method)))) (def: how_to_wrap_a_phase @@ -150,13 +150,13 @@ (#$.Extension "jvm conversion long-to-int"))) literal_nat (: (-> Nat Synthesis) (|>> .i64 $.i64 unwrap_long long_to_int)) - array_write (: (-> Text Nat Synthesis Synthesis Synthesis) - (function (_ element_class index value array) - ((#$.Extension "jvm array write object" - (list (jvm_type (jvm/type.array (jvm/type.class element_class (list)))) - (literal_nat index) - value - array))))) + write! (: (-> Text Nat Synthesis Synthesis Synthesis) + (function (_ element_class index value array) + ((#$.Extension "jvm array write object" + (list (jvm_type (jvm/type.array (jvm/type.class element_class (list)))) + (literal_nat index) + value + array))))) object_array (: (-> Text Nat Synthesis) (function (_ class_name size) (#$.Extension "jvm array new object" @@ -191,9 +191,9 @@ ($.text runtime.apply_method)) (input (|> (object_array "java.lang.Class" phase_arity) - (array_write "java.lang.Class" 0 (class_of example_object)) - (array_write "java.lang.Class" 1 (class_of example_object)) - (array_write "java.lang.Class" 2 (class_of example_object)))))))] + (write! "java.lang.Class" 0 (class_of example_object)) + (write! "java.lang.Class" 1 (class_of example_object)) + (write! "java.lang.Class" 2 (class_of example_object)))))))] (#$.Extension "jvm member invoke virtual" (list& (class_type "java.lang.reflect.Method") ($.text "invoke") @@ -203,9 +203,9 @@ $phase) (input (|> (object_array "java.lang.Object" phase_arity) - (array_write "java.lang.Object" 0 $archive) - (array_write "java.lang.Object" 1 $input) - (array_write "java.lang.Object" 2 $state)))))))) + (write! "java.lang.Object" 0 $archive) + (write! "java.lang.Object" 1 $input) + (write! "java.lang.Object" 2 $state)))))))) (def: (phase_wrapper archive) (-> Archive (generation.Operation _.Anchor _.Inst _.Definition platform.Phase_Wrapper)) @@ -223,7 +223,7 @@ (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))) + (ffi.write! 0 (:as java/lang/Object phase))) apply_method))))))) (def: .public platform @@ -265,11 +265,11 @@ (java/lang/reflect/Method::invoke (:as java/lang/Object handler) (|> (ffi.array java/lang/Object 5) - (ffi.array_write 0 (:as java/lang/Object name)) - (ffi.array_write 1 (:as java/lang/Object (phase_wrapper phase))) - (ffi.array_write 2 (:as java/lang/Object archive)) - (ffi.array_write 3 (:as java/lang/Object parameters)) - (ffi.array_write 4 (:as java/lang/Object state))) + (ffi.write! 0 (:as java/lang/Object name)) + (ffi.write! 1 (:as java/lang/Object (phase_wrapper phase))) + (ffi.write! 2 (:as java/lang/Object archive)) + (ffi.write! 3 (:as java/lang/Object parameters)) + (ffi.write! 4 (:as java/lang/Object state))) method)))) (def: (declare_success! _) -- cgit v1.2.3