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-bootstrapper/src/lux/compiler/jvm/rt.clj | 80 ++++++------ lux-jvm-function/dependency.jar | Bin 951 -> 951 bytes lux-jvm/project.clj | 2 +- lux-jvm/source/program.lux | 188 ++++++++++++++------------- lux-lein/src/leiningen/lux/builder.clj | 19 +-- lux-lein/src/leiningen/lux/utils.clj | 1 + stdlib/source/test/lux/extension.lux | 12 +- 7 files changed, 156 insertions(+), 146 deletions(-) diff --git a/lux-bootstrapper/src/lux/compiler/jvm/rt.clj b/lux-bootstrapper/src/lux/compiler/jvm/rt.clj index c8c3a522a..f01054dd9 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/rt.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/rt.clj @@ -32,45 +32,47 @@ ;; [Resources] ;; Functions -;; (def compile-Function-class -;; (|do [_ (return nil) -;; :let [super-class "java/lang/Object" -;; =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) -;; (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER -;; Opcodes/ACC_ABSTRACT -;; ;; Opcodes/ACC_INTERFACE -;; ) -;; &&/function-class nil super-class (into-array String [])) -;; (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL) &&/partials-field "I" nil nil) -;; (doto (.visitEnd)))) -;; =init-method (doto (.visitMethod =class Opcodes/ACC_PUBLIC init-method "(I)V" nil nil) -;; (.visitCode) -;; (.visitVarInsn Opcodes/ALOAD 0) -;; (.visitMethodInsn Opcodes/INVOKESPECIAL super-class init-method "()V") -;; (.visitVarInsn Opcodes/ALOAD 0) -;; (.visitVarInsn Opcodes/ILOAD 1) -;; (.visitFieldInsn Opcodes/PUTFIELD &&/function-class &&/partials-field "I") -;; (.visitInsn Opcodes/RETURN) -;; (.visitMaxs 0 0) -;; (.visitEnd)) -;; _ (dotimes [arity* &&/num-apply-variants] -;; (let [arity (inc arity*)] -;; (if (= 1 arity) -;; (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) &&/apply-method (&&/apply-signature arity) nil nil) -;; (.visitEnd)) -;; (doto (.visitMethod =class Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature arity) nil nil) -;; (.visitCode) -;; (-> (.visitVarInsn Opcodes/ALOAD idx) -;; (->> (dotimes [idx arity]))) -;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature (dec arity))) -;; (.visitTypeInsn Opcodes/CHECKCAST &&/function-class) -;; (.visitVarInsn Opcodes/ALOAD arity) -;; (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)) -;; (.visitInsn Opcodes/ARETURN) -;; (.visitMaxs 0 0) -;; (.visitEnd)))))]] -;; (&&/save-class! (-> &&/function-class (string/split #"/") (nth 2)) -;; (.toByteArray (doto =class .visitEnd))))) +;; NOT BEING USED ANYMORE... +;; But keeping it here just in case... +(def compile-Function-class + (|do [_ (return nil) + :let [super-class "java/lang/Object" + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER + Opcodes/ACC_ABSTRACT + ;; Opcodes/ACC_INTERFACE + ) + &&/function-class nil super-class (into-array String [])) + (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL) &&/partials-field "I" nil nil) + (doto (.visitEnd)))) + =init-method (doto (.visitMethod =class Opcodes/ACC_PUBLIC init-method "(I)V" nil nil) + (.visitCode) + (.visitVarInsn Opcodes/ALOAD 0) + (.visitMethodInsn Opcodes/INVOKESPECIAL super-class init-method "()V") + (.visitVarInsn Opcodes/ALOAD 0) + (.visitVarInsn Opcodes/ILOAD 1) + (.visitFieldInsn Opcodes/PUTFIELD &&/function-class &&/partials-field "I") + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd)) + _ (dotimes [arity* &&/num-apply-variants] + (let [arity (inc arity*)] + (if (= 1 arity) + (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) &&/apply-method (&&/apply-signature arity) nil nil) + (.visitEnd)) + (doto (.visitMethod =class Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature arity) nil nil) + (.visitCode) + (-> (.visitVarInsn Opcodes/ALOAD idx) + (->> (dotimes [idx arity]))) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature (dec arity))) + (.visitTypeInsn Opcodes/CHECKCAST &&/function-class) + (.visitVarInsn Opcodes/ALOAD arity) + (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)) + (.visitInsn Opcodes/ARETURN) + (.visitMaxs 0 0) + (.visitEnd)))))]] + (&&/save-class! (-> &&/function-class (string/split #"/") (nth 2)) + (.toByteArray (doto =class .visitEnd))))) (defmacro [& instructions] `(fn [^MethodVisitor writer#] diff --git a/lux-jvm-function/dependency.jar b/lux-jvm-function/dependency.jar index 500384906..3a8d5a4cd 100644 Binary files a/lux-jvm-function/dependency.jar and b/lux-jvm-function/dependency.jar differ diff --git a/lux-jvm/project.clj b/lux-jvm/project.clj index 5d9ae53d2..decc82785 100644 --- a/lux-jvm/project.clj +++ b/lux-jvm/project.clj @@ -21,8 +21,8 @@ :dependencies [[com.github.luxlang/lux-bootstrapper ~version] [com.github.luxlang/lux-jvm-function ~version] - ;; [com.github.luxlang/stdlib ~version] + ;; JVM Bytecode (TODO: Remove ASAP) [org.ow2.asm/asm "7.3.1"] [org.ow2.asm/asm-commons "7.3.1"] 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)) diff --git a/lux-lein/src/leiningen/lux/builder.clj b/lux-lein/src/leiningen/lux/builder.clj index 76e19b1e8..408af5c7b 100644 --- a/lux-lein/src/leiningen/lux/builder.clj +++ b/lux-lein/src/leiningen/lux/builder.clj @@ -5,17 +5,18 @@ (defn build [project] (if-let [program-module (get-in project [:lux :program])] - (if-let [command (&utils/build-jvm project program-module)] + ;; (if-let [command (&utils/build-jvm project program-module)] + ;; (when (time (&utils/run-process command + ;; nil + ;; "[COMPILATION BEGAN]" + ;; "[COMPILATION ENDED]")) + ;; true) + ;; ) + (let [command (&utils/compile-path project program-module (get project :source-paths (list)))] (when (time (&utils/run-process command nil "[COMPILATION BEGAN]" "[COMPILATION ENDED]")) - true) - (let [command (&utils/compile-path project program-module (get project :source-paths (list)))] - (when (time (&utils/run-process command - nil - "[COMPILATION BEGAN]" - "[COMPILATION ENDED]")) - (time (&packager/package project program-module (get project :resource-paths (list)))) - true))) + (time (&packager/package project program-module (get project :resource-paths (list)))) + true)) (println "Please provide a program main module in [:lux :program]"))) diff --git a/lux-lein/src/leiningen/lux/utils.clj b/lux-lein/src/leiningen/lux/utils.clj index 6ed549ae2..f18da2831 100644 --- a/lux-lein/src/leiningen/lux/utils.clj +++ b/lux-lein/src/leiningen/lux/utils.clj @@ -132,6 +132,7 @@ repl-path "repl" ) +;; DEPRECATED (defn build-jvm [project module] (let [raw-paths (project-jars project)] (when-let [compiler-path (find-jvm-compiler-path raw-paths)] diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 8a4d58f25..1fcec22de 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -143,11 +143,13 @@ (do ! [[module_id artifact_id] (generation.context archive) .let [commentary (format "Successfully installed directive " (%.text self) "!")] - _ (generation.save! artifact_id {.#None} - (for [@.js (js.comment commentary - (js.statement (js.string commentary))) - @.ruby (ruby.comment commentary - (ruby.statement (ruby.string commentary)))]))] + _ (for [@.jvm (in []) + @.js (generation.save! artifact_id {.#None} + (js.comment commentary + (js.statement (js.string commentary)))) + @.ruby (generation.save! artifact_id {.#None} + (ruby.comment commentary + (ruby.statement (ruby.string commentary))))])] (generation.log! commentary))))] (in directive.no_requirements))) -- cgit v1.2.3