From 1e5f1afbd0f8b54350e552c110dead87b4b5dca0 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 12 Sep 2015 18:31:29 -0400 Subject: - Fixed some errors with JVM interop. --- src/lux/analyser.clj | 29 ++++++--- src/lux/analyser/host.clj | 156 +++++++++++++++++++++++----------------------- src/lux/host.clj | 43 ++++++++----- 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 [ ] (let [input-type (&type/Data$ (&/|list)) output-type (&type/Data$ (&/|list))] - (defn [analyse exo-type ?x ?y] - (|do [=x (&&/analyse-1 analyse input-type ?x) - =y (&&/analyse-1 analyse input-type ?y) + (defn [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 (&/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 [ ] - (defn [analyse exo-type ?class ?method ?classes ?object ?args] + (defn [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 (&/T ?class ?method =classes =object =args)) output-type))))) + (return (&/|list (&/T (&/V (&/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 (= "" ?method) + =return (if (= "" 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 [ ] (let [elem-type (&type/Data$ (&/|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 (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 (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 ""))) -- cgit v1.2.3