* Java interop is almost finished.

% _. and _.. syntax has been replaced with ::

5 files changed, 218 insertions, 38 deletions

diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index 4b1b95836..4436b0b61 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -131,7 +131,7 @@
 
 (defn ^:private import-class [long-name short-name]
   (fn [state]
-    (let [=class (annotated [::class long-name] ::&type/nothing)]
+    (let [=class (annotated [::class long-name] [::&type/object long-name []])]
       [::&util/ok [(update-in state [:imports] merge {long-name =class,
                                                       short-name =class})
                    nil]])))
@@ -246,22 +246,105 @@
          ]
     (return =ident)))
 
-(defanalyser analyse-static-access
+(defanalyser analyse-access
   [::&parser/static-access ?target ?member]
-  (exec [=target (resolve ?target)
-         ;; :let [_ (prn '=target ?target (:form =target))]
-         ]
+  (exec [=target (resolve ?target)]
     (match (:form =target)
       [::class ?class]
       (return (annotated [::static-access ?class ?member] ::&type/nothing)))))
 
-(defanalyser analyse-dynamic-access
-  [::&parser/dynamic-access ?object ?member]
-  (exec [=object (analyse-form* ?object)]
-    (match ?member
-      [::&parser/fn-call [::&parser/ident ?method] ?args]
-      (exec [=args (map-m analyse-form* ?args)]
-        (return (annotated [::dynamic-access =object [?method =args]] ::&type/nothing))))))
+(defn extract-ident [ident]
+  (match ident
+    [::&parser/ident ?ident]
+    (return ?ident)
+
+    _
+    (fail "")))
+
+(defn extract-class [x]
+  (match x
+    [::class ?class]
+    (return ?class)
+
+    _
+    (fail "")))
+
+(defn class-type [x]
+  (match x
+    [::&type/object ?class []]
+    (return ?class)
+
+    _
+    (fail "")))
+
+(defn lookup-field [mode target field]
+  ;; (prn 'lookup-field mode target field)
+  (if-let [[[owner type]] (seq (for [=field (.getFields (Class/forName target))
+                                     ;; :let [_ (prn target (.getName =field) (if (java.lang.reflect.Modifier/isStatic (.getModifiers =field))
+                                     ;;                                         :static
+                                     ;;                                         :dynamic))]
+                                     :when (and (= field (.getName =field))
+                                                (case mode
+                                                  :static (java.lang.reflect.Modifier/isStatic (.getModifiers =field))
+                                                  :dynamic (not (java.lang.reflect.Modifier/isStatic (.getModifiers =field)))))]
+                                 [(.getDeclaringClass =field) (.getType =field)]))]
+    (exec [=type (&type/class->type type)]
+      (return [(.getName owner) =type]))
+    (fail (str "Field does not exist: " target field mode))))
+
+(defn lookup-method [mode target method args]
+  ;; (prn 'lookup-method mode target method args)
+  (if-let [methods (seq (for [=method (.getMethods (Class/forName target))
+                              ;; :let [_ (prn target (.getName =method) (if (java.lang.reflect.Modifier/isStatic (.getModifiers =method))
+                              ;;                                          :static
+                              ;;                                          :dynamic))]
+                              :when (and (= method (.getName =method))
+                                         (case mode
+                                           :static (java.lang.reflect.Modifier/isStatic (.getModifiers =method))
+                                           :dynamic (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method)))))]
+                          [(.getDeclaringClass =method) =method]))]
+    (map-m (fn [[owner method]]
+             (exec [=method (&type/method->type method)]
+               (return [(.getName owner) =method])))
+           methods)
+    (fail (str "Method does not exist: " target method mode))))
+
+(defanalyser analyse-access
+  [::&parser/access ?object ?member]
+  (match ?member
+    [::&parser/ident ?field] ;; Field
+    (try-all-m [(exec [?target (extract-ident ?object)
+                       =target (resolve ?target)
+                       ?class (extract-class (:form =target))
+                       [=owner =type] (lookup-field :static ?class ?field)
+                       ;; :let [_ (prn '=type =type)]
+                       ]
+                  (return (annotated [::static-field =owner ?field] =type)))
+                (exec [=target (analyse-form* ?object)
+                       ?class (class-type (:type =target))
+                       [=owner =type] (lookup-field :dynamic ?class ?field)
+                       ;; :let [_ (prn '=type =type)]
+                       ]
+                  (return (annotated [::dynamic-field =target =owner ?field] =type)))])
+    [::&parser/fn-call [::&parser/ident ?method] ?args] ;; Method
+    (exec [=args (map-m analyse-form* ?args)]
+      (try-all-m [(exec [?target (extract-ident ?object)
+                         =target (resolve ?target)
+                         ?class (extract-class (:form =target))
+                         =methods (lookup-method :static ?class ?method (map :type =args))
+                         ;; :let [_ (prn '=methods =methods)]
+                         [=owner =method] (within :types (&type/pick-matches =methods (map :type =args)))
+                         ;; :let [_ (prn '=method =owner ?method =method)]
+                         ]
+                    (return (annotated [::static-method =owner ?method =method =args] (&type/return-type =method))))
+                  (exec [=target (analyse-form* ?object)
+                         ?class (class-type (:type =target))
+                         =methods (lookup-method :dynamic ?class ?method (map :type =args))
+                         ;; :let [_ (prn '=methods =methods)]
+                         [=owner =method] (within :types (&type/pick-matches =methods (map :type =args)))
+                         ;; :let [_ (prn '=method =owner ?method =method)]
+                         ]
+                    (return (annotated [::dynamic-method =target =owner ?method =method =args] (&type/return-type =method))))]))))
 
 (defanalyser analyse-fn-call
   [::&parser/fn-call ?fn ?args]
@@ -415,8 +498,7 @@
               analyse-tuple
               analyse-lambda
               analyse-ident
-              analyse-static-access
-              analyse-dynamic-access
+              analyse-access
               analyse-fn-call
               analyse-if
               analyse-do
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index 83aa14252..18343db1d 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -67,6 +67,14 @@
     [::&type/function ?args ?return]
     (->java-sig [::&type/object "test2/Function" []])))
 
+(defn ^:private method->sig [method]
+  (match method
+    [::&type/function ?args ?return]
+    (str "(" (apply str (map ->java-sig ?args)) ")"
+         (if (= ::&type/nothing ?return)
+           "V"
+           (->java-sig ?return)))))
+
 ;; [Utils/Compilers]
 (defcompiler ^:private compile-literal
   [::&analyser/literal ?literal]
@@ -180,19 +188,45 @@
               (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "test2/Function" "apply" apply-signature))))
         )))
 
-(defcompiler ^:private compile-static-access
-  [::&analyser/static-access ?class ?member]
-  (doto *writer*
-    (.visitFieldInsn Opcodes/GETSTATIC (->class ?class) ?member (->type-signature "java.io.PrintStream"))))
+(defcompiler ^:private compile-static-field
+  [::&analyser/static-field ?owner ?field]
+  (do ;; (prn 'compile-static-field ?owner ?field)
+      ;; (assert false)
+      (doto *writer*
+        (.visitFieldInsn Opcodes/GETSTATIC (->class ?owner) ?field (->java-sig *type*)))
+    ))
 
-(defcompiler ^:private compile-dynamic-access
-  [::&analyser/dynamic-access ?object [?method ?args]]
-  (do (compile-form (assoc *state* :form ?object))
-    (doseq [arg ?args]
-      (compile-form (assoc *state* :form arg)))
-    (doto *writer*
-      (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") ?method "(Ljava/lang/Object;)V")
-      (.visitInsn Opcodes/ACONST_NULL))))
+(defcompiler ^:private compile-dynamic-field
+  [::&analyser/dynamic-field ?target ?owner ?field]
+  (do ;; (prn 'compile-static-field ?owner ?field)
+      ;; (assert false)
+      (compile-form (assoc *state* :form ?target))
+      (doto *writer*
+        (.visitFieldInsn Opcodes/GETFIELD (->class ?owner) ?field (->java-sig *type*)))
+    ))
+
+(defcompiler ^:private compile-static-method
+  [::&analyser/static-method ?owner ?method-name ?method-type ?args]
+  (do ;; (prn 'compile-dynamic-access ?target ?owner ?method-name ?method-type ?args)
+      ;; (assert false)
+      (do (doseq [arg ?args]
+            (compile-form (assoc *state* :form arg)))
+        (doto *writer*
+          (.visitMethodInsn Opcodes/INVOKESTATIC (->class ?owner) ?method-name (method->sig ?method-type))
+          (.visitInsn Opcodes/ACONST_NULL)))
+    ))
+
+(defcompiler ^:private compile-dynamic-method
+  [::&analyser/dynamic-method ?target ?owner ?method-name ?method-type ?args]
+  (do ;; (prn 'compile-dynamic-access ?target ?owner ?method-name ?method-type ?args)
+    ;; (assert false)
+    (do (compile-form (assoc *state* :form ?target))
+      (doseq [arg ?args]
+        (compile-form (assoc *state* :form arg)))
+      (doto *writer*
+        (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class ?owner) ?method-name (method->sig ?method-type))
+        (.visitInsn Opcodes/ACONST_NULL)))
+    ))
 
 (defcompiler ^:private compile-if
   [::&analyser/if ?test ?then ?else]
@@ -595,8 +629,10 @@
                    compile-captured
                    compile-global
                    compile-call
-                   compile-static-access
-                   compile-dynamic-access
+                   compile-static-field
+                   compile-dynamic-field
+                   compile-static-method
+                   compile-dynamic-method
                    compile-if
                    compile-do
                    compile-case
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index ea3f518f5..376e376d6 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -158,15 +158,11 @@
          =record (apply-m parse-form (list ?record))]
     (return [::set ?tag =value =record])))
 
-(defparser ^:private parse-static-access
-  [::&lexer/list ([[::&lexer/ident "_.."] [::&lexer/ident ?class] [::&lexer/ident ?member]] :seq)]
-  (return [::static-access ?class ?member]))
-
-(defparser ^:private parse-dynamic-access
-  [::&lexer/list ([[::&lexer/ident "_."] ?object ?call] :seq)]
+(defparser ^:private parse-access
+  [::&lexer/list ([[::&lexer/ident "::"] ?object ?call] :seq)]
   (exec [=object (apply-m parse-form (list ?object))
          =call (apply-m parse-form (list ?call))]
-    (return [::dynamic-access =object =call])))
+    (return [::access =object =call])))
 
 (defparser ^:private parse-string
   [::&lexer/string ?string]
@@ -199,8 +195,7 @@
               parse-get
               parse-set
               parse-remove
-              parse-static-access
-              parse-dynamic-access
+              parse-access
               parse-defclass
               parse-definterface
               parse-import
diff --git a/src/lang/type.clj b/src/lang/type.clj
index 465f6e9fc..cfb404a21 100644
--- a/src/lang/type.clj
+++ b/src/lang/type.clj
@@ -3,7 +3,7 @@
   (:require [clojure.core.match :refer [match]]
             [lang.util :as &util :refer [exec return* return fail fail*
                                          repeat-m try-m try-all-m map-m
-                                         apply-m]]))
+                                         apply-m assert!]]))
 
 ;; [Util]
 (def ^:private success (return nil))
@@ -39,6 +39,7 @@
     (return [=function =args =return])))
 
 (defn solve [expected actual]
+  ;; (prn 'solve expected actual)
   (match [expected actual]
     [::any _]
     success
@@ -64,10 +65,35 @@
                          _ (update ?id =top actual)]
                     success)]))
 
+    [[::primitive ?prim] _]
+    (let [as-obj (case ?prim
+                   "boolean" [:lang.type/object "java.lang.Boolean" []]
+                   "int"     [:lang.type/object "java.lang.Integer" []]
+                   "long"    [:lang.type/object "java.lang.Long" []]
+                   "char"    [:lang.type/object "java.lang.Character" []]
+                   "float"   [:lang.type/object "java.lang.Float" []]
+                   "double"  [:lang.type/object "java.lang.Double" []])]
+      (solve as-obj actual))
+
+    [[::object ?eclass []] [::object ?aclass []]]
+    (if (.isAssignableFrom (Class/forName ?eclass) (Class/forName ?aclass))
+      success
+      (fail (str "Can't solve types: " (pr-str expected actual))))
+
     [_ _]
     (fail (str "Can't solve types: " (pr-str expected actual)))
     ))
 
+(defn pick-matches [methods args]
+  (if (empty? methods)
+    (fail "No matches.")
+    (try-all-m [(match (-> methods first second)
+                  [::function ?args ?return]
+                  (exec [_ (assert! (= (count ?args) (count args)) "Args-size doesn't match.")
+                         _ (map-m (fn [[e a]] (solve e a)) (map vector ?args args))]
+                    (return (first methods))))
+                (pick-matches (rest methods) args)])))
+
 (defn clean [type]
   (match type
     [::var ?id]
@@ -84,3 +110,39 @@
     
     _
     (return type)))
+
+;; Java Reflection
+(defn class->type [class]
+  (if-let [[_ base arr-level] (re-find #"^([^\[]+)(\[\])*$"
+                                       (str (if-let [pkg (.getPackage class)]
+                                              (str (.getName pkg) ".")
+                                              "")
+                                            (.getSimpleName class)))]
+    (if (= "void" base)
+      (return ::nothing)
+      (let [base* (case base
+                    ("boolean" "byte" "short" "int" "long" "float" "double" "char")
+                    [::primitive base]
+                    ;; else
+                    [::object base []])]
+        (if arr-level
+          (return (reduce (fn [inner _]
+                            [::array inner])
+                          base*
+                          (range (/ (count arr-level) 2.0))))
+          (return base*)))
+      
+      )))
+
+(defn method->type [method]
+  (exec [=args (map-m class->type (seq (.getParameterTypes method)))
+         =return (class->type (.getReturnType method))]
+    (return [::function (vec =args) =return])))
+
+(defn return-type [func]
+  (match func
+    [::function _ ?return]
+    (return ?return)
+
+    _
+    (fail (str "Type is not a function: " (pr-str func)))))
diff --git a/src/lang/util.clj b/src/lang/util.clj
index ec93ac27f..cdfa8555d 100644
--- a/src/lang/util.clj
+++ b/src/lang/util.clj
@@ -101,6 +101,11 @@
         [::failure _]
         output))))
 
+(defn assert! [test message]
+  (if test
+    (return nil)
+    (fail message)))
+
 (defn comp-m [f-m g-m]
   (exec [temp g-m]
     (f-m temp)))