blob: b21ed03dc51612468b381eb94f65a23b669eb638 (
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
|
(ns lux.host
(:require (clojure [string :as string]
[template :refer [do-template]])
[clojure.core.match :refer [match]]
(lux [util :as &util :refer [exec return* return fail fail*
repeat-m try-all-m map-m mapcat-m reduce-m
normalize-ident]]
[parser :as &parser]
[type :as &type])))
;; [Constants]
(def prefix "lux.")
(def variant-class (str prefix "Variant"))
(def tuple-class (str prefix "Tuple"))
(def function-class (str prefix "Function"))
;; [Utils]
(defn ^:private 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 [::&type/Nothing])
(let [base* [::&type/Data base]]
(if arr-level
(return (reduce (fn [inner _]
[::&type/Array inner])
base*
(range (/ (count arr-level) 2.0))))
(return base*)))
)))
(defn ^:private method->type [method]
(exec [=args (map-m class->type (seq (.getParameterTypes method)))
=return (class->type (.getReturnType method))]
(return [=args =return])))
;; [Resources]
(defn full-class [class-name]
(case class
"boolean" (return Boolean/TYPE)
"byte" (return Byte/TYPE)
"short" (return Short/TYPE)
"int" (return Integer/TYPE)
"long" (return Long/TYPE)
"float" (return Float/TYPE)
"double" (return Double/TYPE)
"char" (return Character/TYPE)
;; else
(try (return (Class/forName class-name))
(catch Exception e
(fail "[Analyser Error] Unknown class.")))))
(defn full-class-name [class-name]
(exec [=class (full-class class-name)]
(.getName class-name)))
(defn ->class [class]
(string/replace class #"\." "/"))
(def ->package ->class)
(defn ->type-signature [class]
(case class
"void" "V"
"boolean" "Z"
"byte" "B"
"short" "S"
"int" "I"
"long" "J"
"float" "F"
"double" "D"
"char" "C"
;; else
(let [class* (->class class)]
(if (.startsWith class* "[")
class*
(str "L" class* ";")))
))
(defn ->java-sig [type]
(match type
::&type/Any
(->type-signature "java.lang.Object")
[::&type/Data ?name]
(->type-signature ?name)
[::&type/Array ?elem]
(str "[" (->java-sig ?elem))
[::&type/Lambda _ _]
(->type-signature function-class)))
(defn extract-jvm-param [token]
(match token
[::&parser/ident ?ident]
(full-class-name ?ident)
[::&parser/form ([[::&parser/ident "Array"] [::&parser/ident ?inner]] :seq)]
(exec [=inner (full-class-name ?inner)]
(return (str "[L" (->class =inner) ";")))
_
(fail "")))
(do-template [<name> <static?>]
(defn <name> [target field]
(if-let [type* (first (for [=field (.getFields target)
:when (and (= target (.getDeclaringClass =field))
(= field (.getName =field))
(= <static?> (java.lang.reflect.Modifier/isStatic (.getModifiers =field))))]
(.getType =field)))]
(exec [=type (class->type type*)]
(return =type))
(fail (str "[Analyser Error] Field does not exist: " target field))))
lookup-static-field true
lookup-field false
)
(do-template [<name> <static?>]
(defn <name> [target method-name args]
(if-let [method (first (for [=method (.getMethods target)
:when (and (= target (.getDeclaringClass =method))
(= method-name (.getName =method))
(= <static?> (java.lang.reflect.Modifier/isStatic (.getModifiers =method))))]
=method))]
(exec [=method (method->type method)]
(return =method))
(fail (str "[Analyser Error] Method does not exist: " target method-name))))
lookup-static-method true
lookup-virtual-method false
)
(defn location [scope]
(->> scope (map normalize-ident) (interpose "$") (reduce str "")))
|
