From 74d3233f7d7984ebcef0d4e6778f0596e867de6c Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 20 Dec 2014 23:25:40 -0400
Subject: * Java interop is almost finished. % _. and _.. syntax has been
 replaced with ::

---
 src/lang/type.clj | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 63 insertions(+), 1 deletion(-)

(limited to 'src/lang/type.clj')

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)))))
-- 
cgit v1.2.3