Used new Function interface to fix directives bug in JVM compiler.

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 <bytecode> [& instructions]
   `(fn [^MethodVisitor writer#]
diff --git a/lux-jvm-function/dependency.jar b/lux-jvm-function/dependency.jar
index 500384906..3a8d5a4cd 100644
--- a/lux-jvm-function/dependency.jar
+++ b/lux-jvm-function/dependency.jar
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))
-        <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))
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)))