blob: 77687dbef605c124a37d924296205b012c0ba572 (
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
|
(ns lux.host
(:require (clojure [string :as string]
[template :refer [do-template]])
[clojure.core.match :as M :refer [match matchv]]
clojure.core.match.array
(lux [base :as & :refer [|do return* return fail fail* |let]]
[type :as &type]))
(:import (java.lang.reflect Field Method Modifier)))
;; [Constants]
(def prefix "lux.")
(def function-class (str prefix "Function"))
;; [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 (= "void" base)
(return &type/$Void)
(return (&/V "lux;DataT" (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
base)))
)))
(defn ^:private method->type [^Method method]
(|do [=return (class->type (.getReturnType method))]
(return =return)))
;; [Resources]
(defn ^String ->class [class]
(string/replace class #"\." "/"))
(def ->package ->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]
(matchv ::M/objects [type]
[["lux;DataT" ?name]]
(->type-signature ?name)
[["lux;LambdaT" [_ _]]]
(->type-signature function-class)
[["lux;VariantT" ["lux;Nil" _]]]
"V"
[_]
(assert false (prn-str '->java-sig (aget type 0)))))
(defn extract-jvm-param [token]
(matchv ::M/objects [token]
[["lux;Meta" [_ ["lux;SymbolS" [_ ?ident]]]]]
(return ?ident)
[_]
(fail (str "[Host] Unknown JVM param: " (pr-str token)))))
(do-template [<name> <static?>]
(defn <name> [target field]
(if-let [type* (first (for [^Field =field (.getDeclaredFields (Class/forName target))
:when (and (= field (.getName =field))
(= <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> [target method-name args]
(if-let [method (first (for [^Method =method (.getDeclaredMethods (Class/forName target))
:when (and (= method-name (.getName =method))
(= <static?> (Modifier/isStatic (.getModifiers =method)))
(&/fold2 #(and %1 (= %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-ident) (&/|interpose "$") (&/fold str "")))
|