blob: cfb404a210da845327f06d5abdef7019505f3257 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
(ns lang.type
(:refer-clojure :exclude [resolve])
(: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 assert!]]))
;; [Util]
(def ^:private success (return nil))
(defn ^:private resolve [id]
(fn [state]
(if-let [top+bottom (get-in state [::mappings id])]
[::&util/ok [state top+bottom]]
[::&util/failure (str "Unknown type-var: " id)])))
(defn ^:private update [id top bottom]
(fn [state]
(if-let [top+bottom (get-in state [::mappings id])]
[::&util/ok [(assoc-in state [::mappings id] [top bottom]) nil]]
[::&util/failure (str "Unknown type-var: " id)])))
;; [Interface]
(def +init+ {::counter 0
::mappings {}})
(def fresh-var
(fn [state]
(let [id (::counter state)]
[::&util/ok [(-> state
(update-in [::counter] inc)
(assoc-in [::mappings id] [::any ::nothing]))
[::var id]]])))
(defn fresh-function [num-args]
(exec [=args (map-m (constantly fresh-var) (range num-args))
=return fresh-var
:let [=function [::function =args =return]]]
(return [=function =args =return])))
(defn solve [expected actual]
;; (prn 'solve expected actual)
(match [expected actual]
[::any _]
success
[_ ::nothing]
success
[_ [::var ?id]]
(exec [[=top =bottom] (resolve ?id)]
(try-all-m [(exec [_ (solve expected =top)]
success)
(exec [_ (solve =top expected)
_ (solve expected =bottom)
_ (update ?id expected =bottom)]
success)]))
[[::var ?id] _]
(exec [[=top =bottom] (resolve ?id)]
(try-all-m [(exec [_ (solve =bottom actual)]
success)
(exec [_ (solve actual =bottom)
_ (solve =top actual)
_ (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]
(exec [[=top =bottom] (resolve ?id)]
(clean =top))
[::function ?args ?return]
(exec [=args (map-m clean ?args)
=return (clean ?return)]
(return [::function =args =return]))
;; ::any
;; (return [::object "java.lang.Object" []])
_
(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)))))
|
