From a315700f4fb7b981fff3bab0a29de0ec53fc1e6b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 11 Jan 2015 15:36:10 -0400 Subject: - Fixed a small bug regarding functions calling themselves recursively. - Getting static fields and calling virtual methods has now been decomplected into their own special forms. --- src/lux/analyser.clj | 139 ++++++++++++++++++++++++++++++++++++--------------- src/lux/compiler.clj | 40 +++++++++------ src/lux/parser.clj | 29 ++++++++--- 3 files changed, 146 insertions(+), 62 deletions(-) (limited to 'src') 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] -- cgit v1.2.3