blob: dfd4df23dae6e4b50dee89d74251b5eb49db0cf5 (
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
|
;; Copyright (c) Eduardo Julian. All rights reserved.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file epl-v10.html at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.
(ns lux.host
(:require (clojure [string :as string]
[template :refer [do-template]])
clojure.core.match
clojure.core.match.array
(lux [base :as & :refer [|do return* return fail fail* |let |case]]
[type :as &type]))
(:import (java.lang.reflect Field Method Modifier)))
;; [Constants]
(def prefix "lux.")
(def function-class (str prefix "Function"))
(def module-separator "_")
;; [Utils]
(defn ^:private class->type [^Class class]
(if-let [[_ base arr-level] (re-find #"^([^\[]+)(\[\])*$"
(str (if-let [pkg (.getPackage class)]
(str (.getName pkg) ".")
"")
(.getSimpleName class)))]
(if (.equals "void" base)
(return &type/Unit)
(return (&/V &/$DataT (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
base)))
)))
(defn ^:private method->type [^Method method]
(class->type (.getReturnType method)))
;; [Resources]
(defn ^String ->class [class]
(string/replace class #"\." "/"))
(defn ^String ->class-name [module]
(string/replace module #"/" "."))
(defn ^String ->module-class [module-name]
(string/replace module-name #"/" module-separator))
(def ->package ->module-class)
(defn ->type-signature [class]
;; (assert (string? 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 [^objects type]
"(-> Type Text)"
(|case type
(&/$DataT ?name)
(->type-signature ?name)
(&/$LambdaT _ _)
(->type-signature function-class)
(&/$TupleT (&/$Nil))
"V"
(&/$NamedT ?name ?type)
(->java-sig ?type)
_
(assert false (str '->java-sig " " (&type/show-type type)))
))
(do-template [<name> <static?>]
(defn <name> [class-loader target field]
(if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName (&type/as-obj target) true class-loader))
:when (and (.equals ^Object field (.getName =field))
(.equals ^Object <static?> (Modifier/isStatic (.getModifiers =field))))]
(.getType =field)))]
(|do [=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> [class-loader target method-name args]
;; (prn '<name> target method-name)
(if-let [method (first (for [^Method =method (.getDeclaredMethods (Class/forName (&type/as-obj target) true class-loader))
:when (and (.equals ^Object method-name (.getName =method))
(.equals ^Object <static?> (Modifier/isStatic (.getModifiers =method)))
(&/fold2 #(and %1 (.equals ^Object %2 %3))
true
args
(&/|map #(.getName ^Class %) (&/->list (seq (.getParameterTypes =method))))))]
=method))]
(method->type 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-name) (&/|interpose "$") (&/fold str "")))
|
