aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj139
-rw-r--r--src/lux/compiler.clj40
-rw-r--r--src/lux/parser.clj29
3 files changed, 146 insertions, 62 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 7cea2ef5c..4866ab04e 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -92,7 +92,7 @@
(defn ^:private with-scoped-name [name type body]
(fn [state]
(let [=return (body (update-in state [:env]
- #(cons (assoc-in (first %) [:mappings name] (annotated [::global (:name state) name] type))
+ #(cons (assoc-in (first %) [:mappings name] (annotated [::global-fn (:name state) name] type))
(rest %))))]
(match =return
[::&util/ok [?state ?value]]
@@ -368,7 +368,7 @@
:when (and (= method (.getName =method))
(case mode
:static (java.lang.reflect.Modifier/isStatic (.getModifiers =method))
- :dynamic (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method)))))]
+ :virtual (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method)))))]
[(.getDeclaringClass =method) =method]))]
(map-m (fn [[owner method]]
(exec [=method (&type/method->type method)]
@@ -376,42 +376,102 @@
methods)
(fail (str "Method does not exist: " target method mode))))
-(defanalyser analyse-access
- [::&parser/access ?object ?member]
- (match ?member
- [::&parser/ident ?field] ;; Field
- (try-all-m [(exec [?target (extract-ident ?object)
- =target (resolve ?target)
- ?class (extract-class (:form =target))
- [=owner =type] (lookup-field :static ?class ?field)
- ;; :let [_ (prn '=type =type)]
- ]
- (return (annotated [::static-field =owner ?field] =type)))
- (exec [=target (analyse-form* ?object)
- ?class (class-type (:type =target))
- [=owner =type] (lookup-field :dynamic ?class ?field)
- ;; :let [_ (prn '=type =type)]
+(defn lookup-static-field [target field]
+ (if-let [type* (first (for [=field (.getFields target)
+ :when (and (= target (.getDeclaringClass =field))
+ (= field (.getName =field))
+ (java.lang.reflect.Modifier/isStatic (.getModifiers =field)))]
+ (.getType =field)))]
+ (exec [=type (&type/class->type type*)]
+ (return =type))
+ (fail (str "Field does not exist: " target field))))
+
+(defn lookup-virtual-method [target method-name args]
+ (prn 'lookup-virtual-method target method-name args)
+ (if-let [method (first (for [=method (.getMethods target)
+ :when (and (= target (.getDeclaringClass =method))
+ (= method-name (.getName =method))
+ (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method))))]
+ =method))]
+ (do (prn 'lookup-virtual-method 'method method)
+ (exec [=method (&type/method->type method)]
+ (&type/return-type =method)))
+ (do (prn 'lookup-virtual-method (str "Virtual method does not exist: " target method-name))
+ (fail (str "Virtual method does not exist: " target method-name)))))
+
+(defn full-class-name [class]
+ ;; (prn 'full-class-name class)
+ (if (.contains class ".")
+ (return class)
+ (try-all-m [(exec [=class (resolve class)
+ ;; :let [_ (prn '=class =class)]
]
- (return (annotated [::dynamic-field =target =owner ?field] =type)))])
- [::&parser/fn-call [::&parser/ident ?method] ?args] ;; Method
- (exec [=args (map-m analyse-form* ?args)]
- (try-all-m [(exec [?target (extract-ident ?object)
- =target (resolve ?target)
- ?class (extract-class (:form =target))
- =methods (lookup-method :static ?class ?method (map :type =args))
- ;; :let [_ (prn '=methods =methods)]
- [=owner =method] (within :types (&type/pick-matches =methods (map :type =args)))
- ;; :let [_ (prn '=method =owner ?method =method)]
- ]
- (return (annotated [::static-method =owner ?method =method =args] (&type/return-type =method))))
- (exec [=target (analyse-form* ?object)
- ?class (class-type (:type =target))
- =methods (lookup-method :dynamic ?class ?method (map :type =args))
- ;; :let [_ (prn '=methods =methods)]
- [=owner =method] (within :types (&type/pick-matches =methods (map :type =args)))
- ;; :let [_ (prn '=method =owner ?method =method)]
- ]
- (return (annotated [::dynamic-method =target =owner ?method =method =args] (&type/return-type =method))))]))))
+ (match (:form =class)
+ [::class ?full-name]
+ (return ?full-name)
+ _
+ (fail "Unknown class.")))
+ (let [full-name* (str "java.lang." class)]
+ (if-let [full-name (try (Class/forName full-name*)
+ full-name*
+ (catch Exception e
+ nil))]
+ (return full-name)
+ (fail "Unknown class.")))])))
+
+(defanalyser analyse-jvm-getstatic
+ [::&parser/jvm-getstatic ?class ?field]
+ (exec [=class (full-class-name ?class)
+ =type (lookup-static-field (Class/forName =class) ?field)]
+ (return (annotated [::jvm-getstatic =class ?field] =type))))
+
+(defanalyser analyse-jvm-invokevirtual
+ [::&parser/jvm-invokevirtual ?class ?method ?classes ?object ?args]
+ (exec [=class (full-class-name ?class)
+ =classes (map-m full-class-name ?classes)
+ =return (lookup-virtual-method (Class/forName =class) ?method (map #(Class/forName %) =classes))
+ :let [_ (prn 'analyse-jvm-invokevirtual '=return =return)]
+ ;; =return =return
+ =object (analyse-form* ?object)
+ =args (map-m analyse-form* ?args)]
+ (return (annotated [::jvm-invokevirtual =class ?method =classes =object =args] =return))))
+
+;; (defanalyser analyse-access
+;; [::&parser/access ?object ?member]
+;; (match ?member
+;; [::&parser/ident ?field] ;; Field
+;; (try-all-m [(exec [?target (extract-ident ?object)
+;; =target (resolve ?target)
+;; ?class (extract-class (:form =target))
+;; [=owner =type] (lookup-field :static ?class ?field)
+;; ;; :let [_ (prn '=type =type)]
+;; ]
+;; (return (annotated [::static-field =owner ?field] =type)))
+;; (exec [=target (analyse-form* ?object)
+;; ?class (class-type (:type =target))
+;; [=owner =type] (lookup-field :dynamic ?class ?field)
+;; ;; :let [_ (prn '=type =type)]
+;; ]
+;; (return (annotated [::dynamic-field =target =owner ?field] =type)))])
+;; [::&parser/fn-call [::&parser/ident ?method] ?args] ;; Method
+;; (exec [=args (map-m analyse-form* ?args)]
+;; (try-all-m [(exec [?target (extract-ident ?object)
+;; =target (resolve ?target)
+;; ?class (extract-class (:form =target))
+;; =methods (lookup-method :static ?class ?method (map :type =args))
+;; ;; :let [_ (prn '=methods =methods)]
+;; [=owner =method] (within :types (&type/pick-matches =methods (map :type =args)))
+;; ;; :let [_ (prn '=method =owner ?method =method)]
+;; ]
+;; (return (annotated [::static-method =owner ?method =method =args] (&type/return-type =method))))
+;; (exec [=target (analyse-form* ?object)
+;; ?class (class-type (:type =target))
+;; =methods (lookup-method :dynamic ?class ?method (map :type =args))
+;; ;; :let [_ (prn '=methods =methods)]
+;; [=owner =method] (within :types (&type/pick-matches =methods (map :type =args)))
+;; ;; :let [_ (prn '=method =owner ?method =method)]
+;; ]
+;; (return (annotated [::dynamic-method =target =owner ?method =method =args] (&type/return-type =method))))]))))
(defn ->token [x]
;; (prn '->token x)
@@ -801,7 +861,6 @@
analyse-tuple
analyse-lambda
analyse-ident
- analyse-access
analyse-fn-call
analyse-if
analyse-do
@@ -817,7 +876,9 @@
analyse-jvm-i+
analyse-jvm-i-
analyse-jvm-i*
- analyse-jvm-idiv]))
+ analyse-jvm-idiv
+ analyse-jvm-getstatic
+ analyse-jvm-invokevirtual]))
;; [Interface]
(defn analyse [module-name tokens]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index e91e10f77..5db85d17f 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -75,6 +75,9 @@
(defn ^:private ->java-sig [type]
(match type
+ ::&type/nothing
+ "V"
+
::&type/any
(->java-sig [::&type/object "java.lang.Object" []])
@@ -218,8 +221,8 @@
))
)))
-(defcompiler ^:private compile-static-field
- [::&analyser/static-field ?owner ?field]
+(defcompiler ^:private compile-jvm-getstatic
+ [::&analyser/jvm-getstatic ?owner ?field]
(do ;; (prn 'compile-static-field ?owner ?field)
;; (assert false)
(doto *writer*
@@ -246,17 +249,22 @@
(.visitInsn Opcodes/ACONST_NULL)))
))
-(defcompiler ^:private compile-dynamic-method
- [::&analyser/dynamic-method ?target ?owner ?method-name ?method-type ?args]
- (do ;; (prn 'compile-dynamic-method ?target ?owner ?method-name ?method-type ?args)
- ;; (assert false)
- (do (compile-form (assoc *state* :form ?target))
- (doseq [arg ?args]
- (compile-form (assoc *state* :form arg)))
- (doto *writer*
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class ?owner) ?method-name (method->sig ?method-type))
- (.visitInsn Opcodes/ACONST_NULL)
- ))
+(defcompiler ^:private compile-jvm-invokevirtual
+ [::&analyser/jvm-invokevirtual ?class ?method ?classes ?object ?args]
+ (let [_ (prn 'compile-jvm-invokevirtual [?class ?method ?classes] '-> *type*)
+ method-sig (str "(" (reduce str "" (map ->type-signature ?classes)) ")" (->java-sig *type*))]
+ (compile-form (assoc *state* :form ?object))
+ (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class ?class))
+ (doseq [[class-name arg] (map vector ?classes ?args)]
+ (do (compile-form (assoc *state* :form arg))
+ (.visitTypeInsn *writer* Opcodes/CHECKCAST (->class class-name))))
+ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL (->class ?class) ?method method-sig)
+ (match *type*
+ ::&type/nothing
+ (.visitInsn *writer* Opcodes/ACONST_NULL)
+
+ [::&type/object ?oclass _]
+ nil)
))
(defcompiler ^:private compile-if
@@ -917,10 +925,8 @@
compile-global
compile-static-call
compile-call
- compile-static-field
compile-dynamic-field
compile-static-method
- compile-dynamic-method
compile-if
compile-do
compile-case
@@ -935,7 +941,9 @@
compile-jvm-i+
compile-jvm-i-
compile-jvm-i*
- compile-jvm-idiv]]
+ compile-jvm-idiv
+ compile-jvm-getstatic
+ compile-jvm-invokevirtual]]
(defn ^:private compile-form [state]
;; (prn 'compile-form/state state)
(or (some #(% state) +compilers+)
diff --git a/src/lux/parser.clj b/src/lux/parser.clj
index bfc23fef8..4de0b6896 100644
--- a/src/lux/parser.clj
+++ b/src/lux/parser.clj
@@ -163,16 +163,30 @@
=record (apply-m parse-form (list ?record))]
(return [::set ?tag =value =record])))
-(defparser ^:private parse-access
- [::&lexer/list ([[::&lexer/ident "::"] ?object ?call] :seq)]
- (exec [=object (apply-m parse-form (list ?object))
- =call (apply-m parse-form (list ?call))]
- (return [::access =object =call])))
-
(defparser ^:private parse-text
[::&lexer/text ?text]
(return [::text ?text]))
+;; (defparser ^:private parse-access
+;; [::&lexer/list ([[::&lexer/ident "::"] ?object ?call] :seq)]
+;; (exec [=object (apply-m parse-form (list ?object))
+;; =call (apply-m parse-form (list ?call))]
+;; (return [::access =object =call])))
+
+(defparser ^:private parse-jvm-getstatic
+ [::&lexer/list ([[::&lexer/ident "jvm/getstatic"] [::&lexer/ident ?class] [::&lexer/ident ?field]] :seq)]
+ (return [::jvm-getstatic ?class ?field]))
+
+(defparser ^:private parse-jvm-invokevirtual
+ [::&lexer/list ([[::&lexer/ident "jvm/invokevirtual"]
+ [::&lexer/ident ?class] [::&lexer/text ?method] [::&lexer/tuple ?classes]
+ ?object [::&lexer/tuple ?args]]
+ :seq)]
+ (exec [=object (apply-m parse-form (list ?object))
+ =args (map-m #(apply-m parse-form (list %))
+ ?args)]
+ (return [::jvm-invokevirtual ?class ?method (map ident->string ?classes) =object =args])))
+
(defparser ^:private parse-fn-call
[::&lexer/list ([?f & ?args] :seq)]
(exec [=f (apply-m parse-form (list ?f))
@@ -214,7 +228,6 @@
parse-get
parse-set
parse-remove
- parse-access
parse-defclass
parse-definterface
parse-import
@@ -223,6 +236,8 @@
parse-jvm-i-
parse-jvm-i*
parse-jvm-idiv
+ parse-jvm-getstatic
+ parse-jvm-invokevirtual
parse-fn-call]))
;; [Interface]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 12:50:35 +0000