aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser.clj29
-rw-r--r--src/lux/analyser/host.clj156
-rw-r--r--src/lux/host.clj43
3 files changed, 128 insertions, 100 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index bd0957bdf..e1c167ce6 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -43,6 +43,14 @@
_
(fail (str "[Analyser Error] Not a tag: " (&/show-ast ast)))))
+(defn ^:private extract-text [ast]
+ (|case ast
+ [_ (&/$TextS text)]
+ (return text)
+
+ _
+ (fail (str "[Analyser Error] Can't extract text: " (&/show-ast ast)))))
+
(defn analyse-variant+ [analyser exo-type ident values]
(|do [[module tag-name] (&/normalize ident)
idx (&&module/tag-index module tag-name)]
@@ -155,13 +163,15 @@
(&/$Cons [_ (&/$TupleS ?fields)]
(&/$Cons [_ (&/$TupleS ?methods)]
(&/$Nil))))))))
- (&&host/analyse-jvm-class analyse compile-token ?name ?super-class ?interfaces ?fields ?methods)
+ (|do [=interfaces (&/map% extract-text ?interfaces)]
+ (&&host/analyse-jvm-class analyse compile-token ?name ?super-class =interfaces ?fields ?methods))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_interface")]
(&/$Cons [_ (&/$TextS ?name)]
(&/$Cons [_ (&/$TupleS ?supers)]
?methods))))
- (&&host/analyse-jvm-interface analyse compile-token ?name ?supers ?methods)
+ (|do [=supers (&/map% extract-text ?supers)]
+ (&&host/analyse-jvm-interface analyse compile-token ?name =supers ?methods))
;; Programs
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_program")]
@@ -280,7 +290,8 @@
(&/$Cons [_ (&/$TupleS ?classes)]
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil))))))
- (&&host/analyse-jvm-new analyse exo-type ?class ?classes ?args)
+ (|do [=classes (&/map% extract-text ?classes)]
+ (&&host/analyse-jvm-new analyse exo-type ?class =classes ?args))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_getstatic")]
(&/$Cons [_ (&/$TextS ?class)]
@@ -316,7 +327,8 @@
(&/$Cons [_ (&/$TupleS ?classes)]
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil)))))))
- (&&host/analyse-jvm-invokestatic analyse exo-type ?class ?method ?classes ?args)
+ (|do [=classes (&/map% extract-text ?classes)]
+ (&&host/analyse-jvm-invokestatic analyse exo-type ?class ?method =classes ?args))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokevirtual")]
(&/$Cons [_ (&/$TextS ?class)]
@@ -325,7 +337,8 @@
(&/$Cons ?object
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil))))))))
- (&&host/analyse-jvm-invokevirtual analyse exo-type ?class ?method ?classes ?object ?args)
+ (|do [=classes (&/map% extract-text ?classes)]
+ (&&host/analyse-jvm-invokevirtual analyse exo-type ?class ?method =classes ?object ?args))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokeinterface")]
(&/$Cons [_ (&/$TextS ?class)]
@@ -334,7 +347,8 @@
(&/$Cons ?object
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil))))))))
- (&&host/analyse-jvm-invokeinterface analyse exo-type ?class ?method ?classes ?object ?args)
+ (|do [=classes (&/map% extract-text ?classes)]
+ (&&host/analyse-jvm-invokeinterface analyse exo-type ?class ?method =classes ?object ?args))
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_invokespecial")]
(&/$Cons [_ (&/$TextS ?class)]
@@ -343,7 +357,8 @@
(&/$Cons ?object
(&/$Cons [_ (&/$TupleS ?args)]
(&/$Nil))))))))
- (&&host/analyse-jvm-invokespecial analyse exo-type ?class ?method ?classes ?object ?args)
+ (|do [=classes (&/map% extract-text ?classes)]
+ (&&host/analyse-jvm-invokespecial analyse exo-type ?class ?method =classes ?object ?args))
;; Exceptions
(&/$FormS (&/$Cons [_ (&/$SymbolS _ "_jvm_try")]
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 4fbd67fdb..69e1ff47a 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -15,21 +15,21 @@
[env :as &&env])))
;; [Utils]
-(defn ^:private extract-text [text]
- (|case text
- [_ (&/$TextS ?text)]
- (return ?text)
+(defn ^:private extract-text [ast]
+ (|case ast
+ [_ (&/$TextS text)]
+ (return text)
_
- (fail "[Analyser Error] Can't extract Text.")))
+ (fail "[Analyser/Host Error] Can't extract text.")))
-(defn ^:private analyse-1+ [analyse ?token]
+(defn ^:private analyse-1+ [analyse token]
(&type/with-var
(fn [$var]
- (|do [=expr (&&/analyse-1 analyse $var ?token)
- :let [[?item ?type] =expr]
- =type (&type/clean $var ?type)]
- (return (&/T ?item =type))))))
+ (|do [=expr (&&/analyse-1 analyse $var token)
+ :let [[item type] =expr]
+ =type (&type/clean $var type)]
+ (return (&/T item =type))))))
(defn ^:private ensure-object [token]
"(-> Analysis (Lux (,)))"
@@ -76,9 +76,9 @@
(do-template [<name> <output-tag> <input-class> <output-class>]
(let [input-type (&type/Data$ <input-class> (&/|list))
output-type (&type/Data$ <output-class> (&/|list))]
- (defn <name> [analyse exo-type ?x ?y]
- (|do [=x (&&/analyse-1 analyse input-type ?x)
- =y (&&/analyse-1 analyse input-type ?y)
+ (defn <name> [analyse exo-type x y]
+ (|do [=x (&&/analyse-1 analyse input-type x)
+ =y (&&/analyse-1 analyse input-type y)
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V <output-tag> (&/T =x =y)) output-type))))))
@@ -123,92 +123,89 @@
analyse-jvm-dgt &&/$jvm-dgt "java.lang.Double" "java.lang.Boolean"
)
-(defn analyse-jvm-getstatic [analyse exo-type ?class ?field]
+(defn analyse-jvm-getstatic [analyse exo-type class field]
(|do [class-loader &/loader
- =type (&host/lookup-static-field class-loader ?class ?field)
+ =type (&host/lookup-static-field class-loader class field)
:let [output-type =type]
_ (&type/check exo-type output-type)]
- (return (&/|list (&/T (&/V &&/$jvm-getstatic (&/T ?class ?field)) output-type)))))
+ (return (&/|list (&/T (&/V &&/$jvm-getstatic (&/T class field)) output-type)))))
-(defn analyse-jvm-getfield [analyse exo-type ?class ?field ?object]
+(defn analyse-jvm-getfield [analyse exo-type class field object]
(|do [class-loader &/loader
- =type (&host/lookup-static-field class-loader ?class ?field)
- =object (&&/analyse-1 analyse ?object)
+ =type (&host/lookup-static-field class-loader class field)
+ =object (&&/analyse-1 analyse object)
:let [output-type =type]
_ (&type/check exo-type output-type)]
- (return (&/|list (&/T (&/V &&/$jvm-getfield (&/T ?class ?field =object)) output-type)))))
+ (return (&/|list (&/T (&/V &&/$jvm-getfield (&/T class field =object)) output-type)))))
-(defn analyse-jvm-putstatic [analyse exo-type ?class ?field ?value]
+(defn analyse-jvm-putstatic [analyse exo-type class field value]
(|do [class-loader &/loader
- =type (&host/lookup-static-field class-loader ?class ?field)
- =value (&&/analyse-1 analyse =type ?value)
+ =type (&host/lookup-static-field class-loader class field)
+ =value (&&/analyse-1 analyse =type value)
:let [output-type &type/Unit]
_ (&type/check exo-type output-type)]
- (return (&/|list (&/T (&/V &&/$jvm-putstatic (&/T ?class ?field =value)) output-type)))))
+ (return (&/|list (&/T (&/V &&/$jvm-putstatic (&/T class field =value)) output-type)))))
-(defn analyse-jvm-putfield [analyse exo-type ?class ?field ?object ?value]
+(defn analyse-jvm-putfield [analyse exo-type class field object value]
(|do [class-loader &/loader
- =type (&host/lookup-static-field class-loader ?class ?field)
- =object (&&/analyse-1 analyse ?object)
- =value (&&/analyse-1 analyse =type ?value)
+ =type (&host/lookup-static-field class-loader class field)
+ =object (&&/analyse-1 analyse object)
+ =value (&&/analyse-1 analyse =type value)
:let [output-type &type/Unit]
_ (&type/check exo-type output-type)]
- (return (&/|list (&/T (&/V &&/$jvm-putfield (&/T ?class ?field =object =value)) output-type)))))
+ (return (&/|list (&/T (&/V &&/$jvm-putfield (&/T class field =object =value)) output-type)))))
-(defn analyse-jvm-invokestatic [analyse exo-type ?class ?method ?classes ?args]
+(defn analyse-jvm-invokestatic [analyse exo-type class method classes args]
(|do [class-loader &/loader
- =classes (&/map% extract-text ?classes)
- =return (&host/lookup-static-method class-loader ?class ?method =classes)
+ =return (&host/lookup-static-method class-loader class method classes)
;; :let [_ (matchv ::M/objects [=return]
;; [[&/$DataT _return-class (&/|list)]]
- ;; (prn 'analyse-jvm-invokestatic ?class ?method _return-class))]
+ ;; (prn 'analyse-jvm-invokestatic class method _return-class))]
=args (&/map2% (fn [_class _arg]
(&&/analyse-1 analyse (&type/Data$ _class (&/|list)) _arg))
- =classes
- ?args)
+ classes
+ args)
:let [output-type =return]
_ (&type/check exo-type (as-otype+ output-type))]
- (return (&/|list (&/T (&/V &&/$jvm-invokestatic (&/T ?class ?method =classes =args)) output-type)))))
+ (return (&/|list (&/T (&/V &&/$jvm-invokestatic (&/T class method classes =args)) output-type)))))
-(defn analyse-jvm-instanceof [analyse exo-type ?class ?object]
- (|do [=object (analyse-1+ analyse ?object)
+(defn analyse-jvm-instanceof [analyse exo-type class object]
+ (|do [=object (analyse-1+ analyse object)
_ (ensure-object =object)
:let [output-type &type/Bool]
_ (&type/check exo-type output-type)]
- (return (&/|list (&/T (&/V &&/$jvm-instanceof (&/T ?class =object)) output-type)))))
+ (return (&/|list (&/T (&/V &&/$jvm-instanceof (&/T class =object)) output-type)))))
(do-template [<name> <tag>]
- (defn <name> [analyse exo-type ?class ?method ?classes ?object ?args]
+ (defn <name> [analyse exo-type class method classes object args]
(|do [class-loader &/loader
- =classes (&/map% extract-text ?classes)
- =return (&host/lookup-virtual-method class-loader ?class ?method =classes)
- =object (&&/analyse-1 analyse (&type/Data$ ?class (&/|list)) ?object)
- =args (&/map2% (fn [?c ?o] (&&/analyse-1 analyse (&type/Data$ ?c (&/|list)) ?o))
- =classes ?args)
+ =return (&host/lookup-virtual-method class-loader class method classes)
+ =object (&&/analyse-1 analyse (&type/Data$ class (&/|list)) object)
+ =args (&/map2% (fn [c o] (&&/analyse-1 analyse (&type/Data$ c (&/|list)) o))
+ classes args)
:let [output-type =return]
_ (&type/check exo-type (as-otype+ output-type))]
- (return (&/|list (&/T (&/V <tag> (&/T ?class ?method =classes =object =args)) output-type)))))
+ (return (&/|list (&/T (&/V <tag> (&/T class method classes =object =args)) output-type)))))
analyse-jvm-invokevirtual &&/$jvm-invokevirtual
analyse-jvm-invokeinterface &&/$jvm-invokeinterface
)
-(defn analyse-jvm-invokespecial [analyse exo-type ?class ?method ?classes ?object ?args]
+(defn analyse-jvm-invokespecial [analyse exo-type class method classes object args]
(|do [class-loader &/loader
- =classes (&/map% extract-text ?classes)
- =return (if (= "<init>" ?method)
+ =return (if (= "<init>" method)
(return &type/Unit)
- (&host/lookup-virtual-method class-loader ?class ?method =classes))
- =object (&&/analyse-1 analyse (&type/Data$ ?class (&/|list)) ?object)
- =args (&/map2% (fn [?c ?o]
- (&&/analyse-1 analyse (&type/Data$ ?c (&/|list)) ?o))
- =classes ?args)
+ (&host/lookup-virtual-method class-loader class method classes))
+ =object (&&/analyse-1 analyse (&type/Data$ class (&/|list)) object)
+ =args (&/map2% (fn [c o]
+ (&&/analyse-1 analyse (&type/Data$ c (&/|list)) o))
+ classes args)
:let [output-type =return]
_ (&type/check exo-type (as-otype+ output-type))]
- (return (&/|list (&/T (&/V &&/$jvm-invokespecial (&/T ?class ?method =classes =object =args)) output-type)))))
+ (return (&/|list (&/T (&/V &&/$jvm-invokespecial (&/T class method classes =object =args)) output-type)))))
-(defn analyse-jvm-null? [analyse exo-type ?object]
- (|do [=object (analyse-1+ analyse ?object)
+(defn analyse-jvm-null? [analyse exo-type object]
+ (|do [=object (analyse-1+ analyse object)
_ (ensure-object =object)
:let [output-type &type/Bool]
_ (&type/check exo-type output-type)]
@@ -219,12 +216,14 @@
_ (&type/check exo-type output-type)]
(return (&/|list (&/T (&/V &&/$jvm-null nil) output-type)))))
-(defn analyse-jvm-new [analyse exo-type ?class ?classes ?args]
- (|do [=classes (&/map% extract-text ?classes)
- =args (&/map% (partial analyse-1+ analyse) ?args)
- :let [output-type (&type/Data$ ?class (&/|list))]
+(defn analyse-jvm-new [analyse exo-type class classes args]
+ (|do [class-loader &/loader
+ =return (&host/lookup-constructor class-loader class classes)
+ =args (&/map2% (fn [c o] (&&/analyse-1 analyse (&type/Data$ c (&/|list)) o))
+ classes args)
+ :let [output-type (&type/Data$ class (&/|list))]
_ (&type/check exo-type output-type)]
- (return (&/|list (&/T (&/V &&/$jvm-new (&/T ?class =classes =args)) output-type)))))
+ (return (&/|list (&/T (&/V &&/$jvm-new (&/T class classes =args)) output-type)))))
(do-template [<class> <new-name> <new-tag> <load-name> <load-tag> <store-name> <store-tag>]
(let [elem-type (&type/Data$ <class> (&/|list))
@@ -316,8 +315,7 @@
modifiers))
(defn analyse-jvm-class [analyse compile-token ?name ?super-class ?interfaces ?fields ?methods]
- (|do [=interfaces (&/map% extract-text ?interfaces)
- =fields (&/map% (fn [?field]
+ (|do [=fields (&/map% (fn [?field]
(|case ?field
[_ (&/$FormS (&/$Cons [_ (&/$TextS ?field-name)]
(&/$Cons [_ (&/$TextS ?field-type)]
@@ -360,7 +358,7 @@
(&&/analyse-1 analyse (&type/Data$ (as-otype ?method-output) (&/|list)) ?method-body))
(&/|reverse (if (:static? =method-modifiers)
=method-inputs
- (&/Cons$ (&/T ";this" ?super-class)
+ (&/Cons$ (&/T "this" ?super-class)
=method-inputs)))))]
(return {:name ?method-name
:modifiers =method-modifiers
@@ -371,29 +369,29 @@
_
(fail "[Analyser Error] Wrong syntax for method.")))
(&/enumerate ?methods))
- _ (compile-token (&/V &&/$jvm-class (&/T ?name ?super-class =interfaces =fields =methods)))]
+ _ (compile-token (&/V &&/$jvm-class (&/T ?name ?super-class ?interfaces =fields =methods)))
+ :let [_ (prn 'analyse-jvm-class ?name ?super-class)]]
(return (&/|list))))
-(defn analyse-jvm-interface [analyse compile-token ?name ?supers ?methods]
- (|do [=supers (&/map% extract-text ?supers)
- =methods (&/map% (fn [method]
+(defn analyse-jvm-interface [analyse compile-token name supers methods]
+ (|do [=methods (&/map% (fn [method]
(|case method
- [_ (&/$FormS (&/$Cons [_ (&/$TextS ?method-name)]
- (&/$Cons [_ (&/$TupleS ?inputs)]
- (&/$Cons [_ (&/$TextS ?output)]
- (&/$Cons [_ (&/$TupleS ?modifiers)]
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
+ (&/$Cons [_ (&/$TupleS inputs)]
+ (&/$Cons [_ (&/$TextS output)]
+ (&/$Cons [_ (&/$TupleS modifiers)]
(&/$Nil))))))]
- (|do [=inputs (&/map% extract-text ?inputs)
- =modifiers (analyse-modifiers ?modifiers)]
- (return {:name ?method-name
+ (|do [=inputs (&/map% extract-text inputs)
+ =modifiers (analyse-modifiers modifiers)]
+ (return {:name method-name
:modifiers =modifiers
:inputs =inputs
- :output ?output}))
+ :output output}))
_
(fail (str "[Analyser Error] Invalid method signature: " (&/show-ast method)))))
- ?methods)
- _ (compile-token (&/V &&/$jvm-interface (&/T ?name =supers =methods)))]
+ methods)
+ _ (compile-token (&/V &&/$jvm-interface (&/T name supers =methods)))]
(return (&/|list))))
(defn analyse-jvm-try [analyse exo-type ?body ?catches+?finally]
diff --git a/src/lux/host.clj b/src/lux/host.clj
index 0936d90eb..81323b1d8 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -10,7 +10,7 @@
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)
+ (:import (java.lang.reflect Field Method Constructor Modifier)
java.util.regex.Pattern))
;; [Constants]
@@ -22,19 +22,21 @@
;; [Utils]
(defn ^:private class->type [^Class class]
+ "(-> Class Type)"
(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 (&type/Data$ (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
- base)
- (&/|list)))
+ &type/Unit
+ (&type/Data$ (str (reduce str "" (repeat (int (/ (count arr-level) 2)) "["))
+ base)
+ (&/|list))
)))
(defn ^:private method->type [^Method method]
+ "(-> Method Type)"
(class->type (.getReturnType method)))
;; [Resources]
@@ -93,9 +95,8 @@
: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))))
+ (return (class->type type*))
+ (fail (str "[Host Error] Field does not exist: " target "." field))))
lookup-static-field true
lookup-field false
@@ -107,17 +108,31 @@
(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))))))]
+ (let [param-types (&/->list (seq (.getParameterTypes =method)))]
+ (and (= (&/|length args) (&/|length param-types))
+ (&/fold2 #(and %1 (.equals ^Object %2 %3))
+ true
+ args
+ (&/|map #(.getName ^Class %) param-types)))))]
=method))]
- (method->type method)
- (fail (str "[Analyser Error] Method does not exist: " target "." method-name))))
+ (return (method->type method))
+ (fail (str "[Host Error] Method does not exist: " target "." method-name))))
lookup-static-method true
lookup-virtual-method false
)
+(defn lookup-constructor [class-loader target args]
+ (if-let [ctor (first (for [^Constructor =method (.getDeclaredConstructors (Class/forName (&type/as-obj target) true class-loader))
+ :when (let [param-types (&/->list (seq (.getParameterTypes =method)))]
+ (and (= (&/|length args) (&/|length param-types))
+ (&/fold2 #(and %1 (.equals ^Object %2 %3))
+ true
+ args
+ (&/|map #(.getName ^Class %) param-types))))]
+ =method))]
+ (return &type/Unit)
+ (fail (str "[Host Error] Constructor does not exist: " target))))
+
(defn location [scope]
(->> scope (&/|map &/normalize-name) (&/|interpose "$") (&/fold str "")))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 06:39:39 +0000