-
Notifications
You must be signed in to change notification settings - Fork 0
/
jni-method-selection.scm
192 lines (182 loc) · 8.55 KB
/
jni-method-selection.scm
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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
;; jni-method-selection.scm : utilities functions to mock java overloading rules for methods
;;
;; -this functions are used by jlambda-methods
;;
;; [Hugo] I found two edge cases that I don't think can be easily resolved:
;;
;; 1) Let's suppose two overloaded methods with the following signatures:
;;
;; int bar(short)
;; int bar(int)
;;
;; My first attempt to build the selection, was to choose the more accurate
;; type, so for example if I invoke bar as:
;;
;; bar(1)
;;
;; then bar(short) should be called. But, if I try the same example into java code
;; bar(int) is invoked instead. This happens simply because java haven't a short
;; (or byte) literal, so by default a number is an integer.
;;
;; There are two alternatives for invoking the short variant:
;;
;; bar((short) 1) // casting
;;
;; short n = 1;
;; bar(n); // use a short variable
;;
;; With this information I'm not sure what is the best option: if try to mimic
;; java behavior, and start looking from int or if simple look after the most
;; specific type. Let's move to item (2) first.
;;
;; 2) Now suppose another schema:
;;
;; class N1 {};
;; class N2 extends N1 {};
;;
;; int foo(N1);
;; int foo(N2);
;;
;; Here we can use the most specific type: if we invoke foo with N1, N1 variant will
;; be invoked, and the same for N2. However, as N2 is a subclass of N1, should be
;; possible to invoke N1 variant with N2 (similar to (1)). The java alternatives are
;; the same than before: casting or a N1 variable.
;;
;; For this two reason I think we can mimic java overloading rules and then
;; have a type specifier for specific invocations (of course, this could be
;; resolved simply defining a jlambda-method for the particular conflicting
;; variants, but I think is very ugly from the library user perspective).
;;
;; Having all this in mind, this implementation works as follow:
;;
;; jlambda-methods keep a list of available methods and signatures. When is
;; invoked look up for the best signature match, having this rules:
;;
;; - if numeric =>
;; fixnum => choose the first fit in this order: (int long
;; float double java.lang.Integer java.lang.Long java.lang.Float
;; java.lang.Double)
;; not fixnum => choose the first fit in this order: (float double java.lang.Float java.lang.Double)
;; - if boolean => boolean
;; - if jobject => choose the most close (close in the inheritance sense) class available.
;;
;; For the edge cases described above a new syntax is added:
;;
;; so we can invoke the previous cases this way:
;;
;; (foo (type: N1 n2))
;; (bar (type: short 1))
(define prefered-fixnum-types '(int long float double java.lang.Integer java.lang.Long java.lang.Float java.lang.Double))
(define prefered-flonum-types '(float double java.lang.Float java.lang.Double))
(define (generate-method is-static return-type class-name method-name args-type)
(if (eq? method-name 'new)
(jlambda-constructor-imple class-name args-type)
(catch (lambda () (jlambda-method-imple is-static return-type class-name method-name args-type)) #f)))
;; generate a list of the form ((is-static parameter-signature . jlambda-method) ...)
(define (generate-methods class-name method-name signatures)
(fold (lambda (signature methods)
(let* ((is-static (car signature))
(return-type (cadr signature))
(args-type (cddr signature))
(method (generate-method is-static return-type class-name method-name args-type)))
(if method
(cons (cons* is-static args-type method) methods)
methods)))
'()
signatures))
(define (find-method-match method-name methods args)
(fold (lambda (method best)
(if (match-arg-types method-name args (car method) (cadr method))
(if best
(best-method method best)
method)
best))
#f
methods))
(define (get-matching-args method-name is-static args)
(if (or (null? args)
(eq? method-name 'new)
is-static)
args
(cdr args)))
(define FLOAT_MAX_VALUE (jlambda-constant float java.lang.Float MAX_VALUE))
(define FLOAT_MIN_VALUE (jlambda-constant float java.lang.Float MIN_VALUE))
(define INT_MAX_VALUE (jlambda-constant int java.lang.Integer MAX_VALUE))
(define INT_MIN_VALUE (jlambda-constant int java.lang.Integer MIN_VALUE))
(define LONG_MAX_VALUE (jlambda-constant long java.lang.Long MAX_VALUE))
(define LONG_MIN_VALUE (jlambda-constant long java.lang.Long MIN_VALUE))
;; check if the args match the type signature
(define (match-arg-types method-name args is-static types)
(let ((args (get-matching-args method-name is-static args)))
(and (= (length args) (length types))
(every (lambda (arg type)
(if (pair? arg)
(eq? (car arg) type)
(type-case arg
(boolean
(or (and (eq? arg #f) ; #f is also used for null
(not (primitive? type)))
(eq? 'boolean type)))
(number
(if (fixnum? arg)
(or (and (member type '(java.lang.Integer int))
(< arg (INT_MAX_VALUE))
(>= arg (INT_MIN_VALUE)))
(and (member type '(java.lang.Long long))
(< arg (LONG_MAX_VALUE))
(>= arg (LONG_MIN_VALUE)))
(and (member type '(java.lang.Float float))
(< arg (FLOAT_MAX_VALUE))
(> arg (FLOAT_MIN_VALUE)))
(member type '(java.lang.Double double)))
(or (and (member type '(java.lang.Float float))
(fp<= arg (FLOAT_MAX_VALUE))
(fp>= arg (FLOAT_MIN_VALUE)))
(member type '(java.lang.Double double)))))
(string
(and-let* ((type-class (find-class (mangle-class-name type))))
(assignable-from? (find-class "java/lang/String") type-class)))
(jobject
(if (not (primitive? type))
(let ((type-class (find-class (mangle-class-name type))))
(and type-class
(instance-of? arg type-class)))
#f))
(char (eq? type 'char))
(else (assert #f method-name)))))
args types))))
(define (integer-compare n1 n2)
(cond ((= n1 n2) 0)
((< n1 n2) -1)
(#t 1)))
;; compare two types returns -1 if type1 is better than type2, 0 if they are
;; equals, and 1 if type2 is better than type1
(define (type-compare type1 type2)
(cond ((eq? type1 type2)
0)
((and (member type1 prefered-fixnum-types)
(member type2 prefered-fixnum-types))
(integer-compare (list-index (cut eq? <> type1) prefered-fixnum-types)
(list-index (cut eq? <> type2) prefered-fixnum-types)))
((and (member type1 prefered-flonum-types)
(member type2 prefered-flonum-types))
(integer-compare (list-index (cut eq? <> type1) prefered-flonum-types)
(list-index (cut eq? <> type2) prefered-flonum-types)))
(#t
(let ((type1-class (find-class (mangle-class-name type1)))
(type2-class (find-class (mangle-class-name type2))))
(assert (and type1-class type2-class))
(if (assignable-from? type1-class type2-class) -1 1)))))
(define (best-method m1 m2)
(let loop ((args-1 (cadr m1))
(args-2 (cadr m2))
(w1 0)
(w2 0))
(if (null? args-1)
(cond ((= w1 w2) (error 'jlambda-method "Ambiguous method information: " m1 m2))
((> w1 w2) m1)
(else m2))
(let* ((r (type-compare (car args-1) (car args-2)))
(w1 (if (< r 0) (+ w1 1) w1))
(w2 (if (> r 0) (+ w2 1) w2)))
(loop (cdr args-1) (cdr args-2) w1 w2)))))