diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/lang.clj | 1 | ||||
| -rw-r--r-- | src/lang/analyser.clj | 110 | ||||
| -rw-r--r-- | src/lang/compiler.clj | 64 | ||||
| -rw-r--r-- | src/lang/parser.clj | 13 | ||||
| -rw-r--r-- | src/lang/type.clj | 64 | ||||
| -rw-r--r-- | src/lang/util.clj | 5 |
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))) |