aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lang.clj1
-rw-r--r--src/lang/analyser.clj110
-rw-r--r--src/lang/compiler.clj64
-rw-r--r--src/lang/parser.clj13
-rw-r--r--src/lang/type.clj64
-rw-r--r--src/lang/util.clj5
6 files changed, 218 insertions, 39 deletions
diff --git a/src/lang.clj b/src/lang.clj
index 84535356e..f4ef4a9fc 100644
--- a/src/lang.clj
+++ b/src/lang.clj
@@ -11,7 +11,6 @@
(.write stream data)))
(comment
- ;; TODO: Add Java-interop.
;; TODO: Allow loading classes/modules at runtime.
;; TODO: Add macros.
;; TODO: Re-implement compiler in language.
diff --git a/src/lang/analyser.clj b/src/lang/analyser.clj
index 4b1b95836..4436b0b61 100644
--- a/src/lang/analyser.clj
+++ b/src/lang/analyser.clj
@@ -131,7 +131,7 @@
(defn ^:private import-class [long-name short-name]
(fn [state]
- (let [=class (annotated [::class long-name] ::&type/nothing)]
+ (let [=class (annotated [::class long-name] [::&type/object long-name []])]
[::&util/ok [(update-in state [:imports] merge {long-name =class,
short-name =class})
nil]])))
@@ -246,22 +246,105 @@
]
(return =ident)))
-(defanalyser analyse-static-access
+(defanalyser analyse-access
[::&parser/static-access ?target ?member]
- (exec [=target (resolve ?target)
- ;; :let [_ (prn '=target ?target (:form =target))]
- ]
+ (exec [=target (resolve ?target)]
(match (:form =target)
[::class ?class]
(return (annotated [::static-access ?class ?member] ::&type/nothing)))))
-(defanalyser analyse-dynamic-access
- [::&parser/dynamic-access ?object ?member]
- (exec [=object (analyse-form* ?object)]
- (match ?member
- [::&parser/fn-call [::&parser/ident ?method] ?args]
- (exec [=args (map-m analyse-form* ?args)]
- (return (annotated [::dynamic-access =object [?method =args]] ::&type/nothing))))))
+(defn extract-ident [ident]
+ (match ident
+ [::&parser/ident ?ident]
+ (return ?ident)
+
+ _
+ (fail "")))
+
+(defn extract-class [x]
+ (match x
+ [::class ?class]
+ (return ?class)
+
+ _
+ (fail "")))
+
+(defn class-type [x]
+ (match x
+ [::&type/object ?class []]
+ (return ?class)
+
+ _
+ (fail "")))
+
+(defn lookup-field [mode target field]
+ ;; (prn 'lookup-field mode target field)
+ (if-let [[[owner type]] (seq (for [=field (.getFields (Class/forName target))
+ ;; :let [_ (prn target (.getName =field) (if (java.lang.reflect.Modifier/isStatic (.getModifiers =field))
+ ;; :static
+ ;; :dynamic))]
+ :when (and (= field (.getName =field))
+ (case mode
+ :static (java.lang.reflect.Modifier/isStatic (.getModifiers =field))
+ :dynamic (not (java.lang.reflect.Modifier/isStatic (.getModifiers =field)))))]
+ [(.getDeclaringClass =field) (.getType =field)]))]
+ (exec [=type (&type/class->type type)]
+ (return [(.getName owner) =type]))
+ (fail (str "Field does not exist: " target field mode))))
+
+(defn lookup-method [mode target method args]
+ ;; (prn 'lookup-method mode target method args)
+ (if-let [methods (seq (for [=method (.getMethods (Class/forName target))
+ ;; :let [_ (prn target (.getName =method) (if (java.lang.reflect.Modifier/isStatic (.getModifiers =method))
+ ;; :static
+ ;; :dynamic))]
+ :when (and (= method (.getName =method))
+ (case mode
+ :static (java.lang.reflect.Modifier/isStatic (.getModifiers =method))
+ :dynamic (not (java.lang.reflect.Modifier/isStatic (.getModifiers =method)))))]
+ [(.getDeclaringClass =method) =method]))]
+ (map-m (fn [[owner method]]
+ (exec [=method (&type/method->type method)]
+ (return [(.getName owner) =method])))
+ 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)]
+ ]
+ (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))))]))))
(defanalyser analyse-fn-call
[::&parser/fn-call ?fn ?args]
@@ -415,8 +498,7 @@
analyse-tuple
analyse-lambda
analyse-ident
- analyse-static-access
- analyse-dynamic-access
+ analyse-access
analyse-fn-call
analyse-if
analyse-do
diff --git a/src/lang/compiler.clj b/src/lang/compiler.clj
index 83aa14252..18343db1d 100644
--- a/src/lang/compiler.clj
+++ b/src/lang/compiler.clj
@@ -67,6 +67,14 @@
[::&type/function ?args ?return]
(->java-sig [::&type/object "test2/Function" []])))
+(defn ^:private method->sig [method]
+ (match method
+ [::&type/function ?args ?return]
+ (str "(" (apply str (map ->java-sig ?args)) ")"
+ (if (= ::&type/nothing ?return)
+ "V"
+ (->java-sig ?return)))))
+
;; [Utils/Compilers]
(defcompiler ^:private compile-literal
[::&analyser/literal ?literal]
@@ -180,19 +188,45 @@
(.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE "test2/Function" "apply" apply-signature))))
)))
-(defcompiler ^:private compile-static-access
- [::&analyser/static-access ?class ?member]
- (doto *writer*
- (.visitFieldInsn Opcodes/GETSTATIC (->class ?class) ?member (->type-signature "java.io.PrintStream"))))
+(defcompiler ^:private compile-static-field
+ [::&analyser/static-field ?owner ?field]
+ (do ;; (prn 'compile-static-field ?owner ?field)
+ ;; (assert false)
+ (doto *writer*
+ (.visitFieldInsn Opcodes/GETSTATIC (->class ?owner) ?field (->java-sig *type*)))
+ ))
-(defcompiler ^:private compile-dynamic-access
- [::&analyser/dynamic-access ?object [?method ?args]]
- (do (compile-form (assoc *state* :form ?object))
- (doseq [arg ?args]
- (compile-form (assoc *state* :form arg)))
- (doto *writer*
- (.visitMethodInsn Opcodes/INVOKEVIRTUAL (->class "java.io.PrintStream") ?method "(Ljava/lang/Object;)V")
- (.visitInsn Opcodes/ACONST_NULL))))
+(defcompiler ^:private compile-dynamic-field
+ [::&analyser/dynamic-field ?target ?owner ?field]
+ (do ;; (prn 'compile-static-field ?owner ?field)
+ ;; (assert false)
+ (compile-form (assoc *state* :form ?target))
+ (doto *writer*
+ (.visitFieldInsn Opcodes/GETFIELD (->class ?owner) ?field (->java-sig *type*)))
+ ))
+
+(defcompiler ^:private compile-static-method
+ [::&analyser/static-method ?owner ?method-name ?method-type ?args]
+ (do ;; (prn 'compile-dynamic-access ?target ?owner ?method-name ?method-type ?args)
+ ;; (assert false)
+ (do (doseq [arg ?args]
+ (compile-form (assoc *state* :form arg)))
+ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESTATIC (->class ?owner) ?method-name (method->sig ?method-type))
+ (.visitInsn Opcodes/ACONST_NULL)))
+ ))
+
+(defcompiler ^:private compile-dynamic-method
+ [::&analyser/dynamic-method ?target ?owner ?method-name ?method-type ?args]
+ (do ;; (prn 'compile-dynamic-access ?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-if
[::&analyser/if ?test ?then ?else]
@@ -595,8 +629,10 @@
compile-captured
compile-global
compile-call
- compile-static-access
- compile-dynamic-access
+ compile-static-field
+ compile-dynamic-field
+ compile-static-method
+ compile-dynamic-method
compile-if
compile-do
compile-case
diff --git a/src/lang/parser.clj b/src/lang/parser.clj
index ea3f518f5..376e376d6 100644
--- a/src/lang/parser.clj
+++ b/src/lang/parser.clj
@@ -158,15 +158,11 @@
=record (apply-m parse-form (list ?record))]
(return [::set ?tag =value =record])))
-(defparser ^:private parse-static-access
- [::&lexer/list ([[::&lexer/ident "_.."] [::&lexer/ident ?class] [::&lexer/ident ?member]] :seq)]
- (return [::static-access ?class ?member]))
-
-(defparser ^:private parse-dynamic-access
- [::&lexer/list ([[::&lexer/ident "_."] ?object ?call] :seq)]
+(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 [::dynamic-access =object =call])))
+ (return [::access =object =call])))
(defparser ^:private parse-string
[::&lexer/string ?string]
@@ -199,8 +195,7 @@
parse-get
parse-set
parse-remove
- parse-static-access
- parse-dynamic-access
+ parse-access
parse-defclass
parse-definterface
parse-import
diff --git a/src/lang/type.clj b/src/lang/type.clj
index 465f6e9fc..cfb404a21 100644
--- a/src/lang/type.clj
+++ b/src/lang/type.clj
@@ -3,7 +3,7 @@
(:require [clojure.core.match :refer [match]]
[lang.util :as &util :refer [exec return* return fail fail*
repeat-m try-m try-all-m map-m
- apply-m]]))
+ apply-m assert!]]))
;; [Util]
(def ^:private success (return nil))
@@ -39,6 +39,7 @@
(return [=function =args =return])))
(defn solve [expected actual]
+ ;; (prn 'solve expected actual)
(match [expected actual]
[::any _]
success
@@ -64,10 +65,35 @@
_ (update ?id =top actual)]
success)]))
+ [[::primitive ?prim] _]
+ (let [as-obj (case ?prim
+ "boolean" [:lang.type/object "java.lang.Boolean" []]
+ "int" [:lang.type/object "java.lang.Integer" []]
+ "long" [:lang.type/object "java.lang.Long" []]
+ "char" [:lang.type/object "java.lang.Character" []]
+ "float" [:lang.type/object "java.lang.Float" []]
+ "double" [:lang.type/object "java.lang.Double" []])]
+ (solve as-obj actual))
+
+ [[::object ?eclass []] [::object ?aclass []]]
+ (if (.isAssignableFrom (Class/forName ?eclass) (Class/forName ?aclass))
+ success
+ (fail (str "Can't solve types: " (pr-str expected actual))))
+
[_ _]
(fail (str "Can't solve types: " (pr-str expected actual)))
))
+(defn pick-matches [methods args]
+ (if (empty? methods)
+ (fail "No matches.")
+ (try-all-m [(match (-> methods first second)
+ [::function ?args ?return]
+ (exec [_ (assert! (= (count ?args) (count args)) "Args-size doesn't match.")
+ _ (map-m (fn [[e a]] (solve e a)) (map vector ?args args))]
+ (return (first methods))))
+ (pick-matches (rest methods) args)])))
+
(defn clean [type]
(match type
[::var ?id]
@@ -84,3 +110,39 @@
_
(return type)))
+
+;; Java Reflection
+(defn 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 ::nothing)
+ (let [base* (case base
+ ("boolean" "byte" "short" "int" "long" "float" "double" "char")
+ [::primitive base]
+ ;; else
+ [::object base []])]
+ (if arr-level
+ (return (reduce (fn [inner _]
+ [::array inner])
+ base*
+ (range (/ (count arr-level) 2.0))))
+ (return base*)))
+
+ )))
+
+(defn method->type [method]
+ (exec [=args (map-m class->type (seq (.getParameterTypes method)))
+ =return (class->type (.getReturnType method))]
+ (return [::function (vec =args) =return])))
+
+(defn return-type [func]
+ (match func
+ [::function _ ?return]
+ (return ?return)
+
+ _
+ (fail (str "Type is not a function: " (pr-str func)))))
diff --git a/src/lang/util.clj b/src/lang/util.clj
index ec93ac27f..cdfa8555d 100644
--- a/src/lang/util.clj
+++ b/src/lang/util.clj
@@ -101,6 +101,11 @@
[::failure _]
output))))
+(defn assert! [test message]
+ (if test
+ (return nil)
+ (fail message)))
+
(defn comp-m [f-m g-m]
(exec [temp g-m]
(f-m temp)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 01:01:07 +0000