From 651c7afff45f7f6c6b16d873d699ef0f7c890246 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 8 Nov 2021 03:21:42 -0400 Subject: Used new Function interface to fix directives bug in JVM compiler. --- lux-jvm/source/program.lux | 188 +++++++++++++++++++++++---------------------- 1 file changed, 96 insertions(+), 92 deletions(-) (limited to 'lux-jvm/source/program.lux') diff --git a/lux-jvm/source/program.lux b/lux-jvm/source/program.lux index b4710d116..61593c215 100644 --- a/lux-jvm/source/program.lux +++ b/lux-jvm/source/program.lux @@ -127,104 +127,108 @@ (ffi.write! 1 (:as java/lang/Object lux))) apply_method)))) -(def: how_to_wrap_a_phase - Synthesis - (let [java/lang/String (jvm/type.class "java.lang.String" (list)) - (jvm/type.array (jvm/type.class "java.lang.Class" (list))) - java/lang/Object (jvm/type.class "java.lang.Object" (list)) - (jvm/type.array java/lang/Object) +... DEPRECATED +... (def: how_to_wrap_a_phase +... Synthesis +... (let [java/lang/String (jvm/type.class "java.lang.String" (list)) +... (jvm/type.array (jvm/type.class "java.lang.Class" (list))) +... java/lang/Object (jvm/type.class "java.lang.Object" (list)) +... (jvm/type.array java/lang/Object) - jvm_type (: (All (_ c) (-> (jvm/type.Type c) Synthesis)) - (|>> jvm/type.format - $.text)) - class_type (: (-> Text Synthesis) - (function (_ name) - (|> (jvm/type.class name (list)) - jvm_type))) - unwrap_long (: (-> Synthesis Synthesis) - (|>> (list ($.text jvm/type/box.long) - ($.text "long")) - {$.#Extension "jvm object cast"})) - long_to_int (: (-> Synthesis Synthesis) - (|>> (list) - {$.#Extension "jvm conversion long-to-int"})) - literal_nat (: (-> Nat Synthesis) - (|>> .i64 $.i64 unwrap_long long_to_int)) - 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" - (list (class_type class_name) - (literal_nat size))})) - class_of (: (-> Synthesis Synthesis) - (function (_ object) - {$.#Extension "jvm member invoke virtual" - (list& (class_type "java.lang.Object") - ($.text "getClass") - (class_type "java.lang.Class") - object - (list))})) - input (: (All (_ c) (-> (jvm/type.Type c) Synthesis Synthesis)) - (function (_ value_type value) - ($.tuple (list (jvm_type value_type) value)))) +... jvm_type (: (All (_ c) (-> (jvm/type.Type c) Synthesis)) +... (|>> jvm/type.format +... $.text)) +... class_type (: (-> Text Synthesis) +... (function (_ name) +... (|> (jvm/type.class name (list)) +... jvm_type))) +... unwrap_long (: (-> Synthesis Synthesis) +... (|>> (list ($.text jvm/type/box.long) +... ($.text "long")) +... {$.#Extension "jvm object cast"})) +... long_to_int (: (-> Synthesis Synthesis) +... (|>> (list) +... {$.#Extension "jvm conversion long-to-int"})) +... literal_nat (: (-> Nat Synthesis) +... (|>> .i64 $.i64 unwrap_long long_to_int)) +... 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" +... (list (class_type class_name) +... (literal_nat size))})) +... class_of (: (-> Synthesis Synthesis) +... (function (_ object) +... {$.#Extension "jvm member invoke virtual" +... (list& (class_type "java.lang.Object") +... ($.text "getClass") +... (class_type "java.lang.Class") +... object +... (list))})) +... input (: (All (_ c) (-> (jvm/type.Type c) Synthesis Synthesis)) +... (function (_ value_type value) +... ($.tuple (list (jvm_type value_type) value)))) - example_object {$.#Extension "jvm member invoke constructor" - (list& (class_type "java.lang.Object") - (list))} - phase_arity 3 - $phase ($.variable/local 1) - $archive ($.variable/local 2) - $input ($.variable/local 3) - $state ($.variable/local 4) - apply_method {$.#Extension "jvm member invoke virtual" - (list& (class_type "java.lang.Class") - ($.text "getMethod") - (class_type "java.lang.reflect.Method") - (class_of $phase) - (list (input java/lang/String - ($.text runtime.apply_method)) - (input - (|> (object_array "java.lang.Class" phase_arity) - (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") - (class_type "java.lang.Object") - apply_method - (list (input java/lang/Object - $phase) - (input - (|> (object_array "java.lang.Object" phase_arity) - (write! "java.lang.Object" 0 $archive) - (write! "java.lang.Object" 1 $input) - (write! "java.lang.Object" 2 $state)))))})) +... example_object {$.#Extension "jvm member invoke constructor" +... (list& (class_type "java.lang.Object") +... (list))} +... phase_arity 3 +... $phase ($.variable/local 1) +... $archive ($.variable/local 2) +... $input ($.variable/local 3) +... $state ($.variable/local 4) +... apply_method {$.#Extension "jvm member invoke virtual" +... (list& (class_type "java.lang.Class") +... ($.text "getMethod") +... (class_type "java.lang.reflect.Method") +... (class_of $phase) +... (list (input java/lang/String +... ($.text runtime.apply_method)) +... (input +... (|> (object_array "java.lang.Class" phase_arity) +... (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") +... (class_type "java.lang.Object") +... apply_method +... (list (input java/lang/Object +... $phase) +... (input +... (|> (object_array "java.lang.Object" phase_arity) +... (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 phase.Wrapper)) (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)] - (in (function (_ phase) - (<| try.trusted - (: (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.write! 0 (:as java/lang/Object phase))) - apply_method))))))) + [... 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) + ] + (in (|>>) + ... (function (_ phase) + ... (<| try.trusted + ... (: (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.write! 0 (:as java/lang/Object phase))) + ... apply_method)))) + ))) (def: .public platform ... (IO (Platform Anchor (Bytecode Any) Definition)) -- cgit v1.2.3