aboutsummaryrefslogtreecommitdiff
path: root/lux-jvm/source/program.lux
diff options
context:
space:
mode:
Diffstat (limited to 'lux-jvm/source/program.lux')
-rw-r--r--lux-jvm/source/program.lux188
1 files changed, 96 insertions, 92 deletions
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))
- <java/lang/Class> (jvm/type.array (jvm/type.class "java.lang.Class" (list)))
- java/lang/Object (jvm/type.class "java.lang.Object" (list))
- <java/lang/Object> (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))
+... <java/lang/Class> (jvm/type.array (jvm/type.class "java.lang.Class" (list)))
+... java/lang/Object (jvm/type.class "java.lang.Object" (list))
+... <java/lang/Object> (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 <java/lang/Class>
- (|> (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 <java/lang/Object>
- (|> (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 <java/lang/Class>
+... (|> (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 <java/lang/Object>
+... (|> (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))
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-01 07:58:43 +0000