diff options
author | Eduardo Julian | 2015-10-07 01:04:55 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-10-07 01:04:55 -0400 |
commit | bce3a19e53036d760820e9f217d0243f17e4be51 (patch) | |
tree | 13db2a2fd660ebb150f03e671aae9bc1b0d39937 /src | |
parent | d0800f9fa043cce9e0bba299059cc6a8944c85f7 (diff) |
- The method-invocation analysers now take into consideration whether they must work for classes or interfaces & perform the appropriate checks.
- A default <init> method is added to the dummy class used during the analysis of anonymous classes.
- When adding the default invoke-special for anonymous classes, now using the one from the parent class, rather than the one from Object.
- The packaging for the uberjar is now a bit more specific regarding which elements to include or to exclude.
- Type errors when comparing JVM generic types are now a bit more specific.
Diffstat (limited to '')
-rw-r--r-- | src/lux/analyser.clj | 2 | ||||
-rw-r--r-- | src/lux/analyser/host.clj | 31 | ||||
-rw-r--r-- | src/lux/compiler/host.clj | 6 | ||||
-rw-r--r-- | src/lux/host.clj | 71 | ||||
-rw-r--r-- | src/lux/packager/program.clj | 4 | ||||
-rw-r--r-- | src/lux/type/host.clj | 9 |
6 files changed, 71 insertions, 52 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index 70a4a6ee9..ac1b5cb8e 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -117,7 +117,7 @@ (&&host/analyse-jvm-laload analyse exo-type ?array ?idx) _ - (assert false (str "Unknown syntax: " (prn-str (&/show-ast (&/T (&/T "" -1 -1) token))))))) + (assert false (str "[Analyser Error] Unknown syntax: " (prn-str (&/show-ast (&/T (&/T "" -1 -1) token))))))) (defn ^:private aba9 [analyse eval! compile-module compile-token exo-type token] (|case token diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 7e1f92d19..ab3cbf14e 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -7,7 +7,7 @@ (:require (clojure [template :refer [do-template]]) clojure.core.match clojure.core.match.array - (lux [base :as & :refer [|let |do return fail |case]] + (lux [base :as & :refer [|let |do return fail |case assert!]] [parser :as &parser] [type :as &type] [host :as &host]) @@ -281,9 +281,16 @@ )) (let [dummy-type-param (&type/Data$ "java.lang.Object" (&/|list))] - (do-template [<name> <tag>] + (do-template [<name> <tag> <only-interface?>] (defn <name> [analyse exo-type class method classes object args] (|do [class-loader &/loader + _ (try (assert! (let [=class (Class/forName class true class-loader)] + (= <only-interface?> (.isInterface =class))) + (if <only-interface?> + (str "[Analyser Error] Can only invoke method \"" method "\"" " on interface.") + (str "[Analyser Error] Can only invoke method \"" method "\"" " on class."))) + (catch Exception e + (fail (str "[Analyser Error] Unknown class: " class)))) [gret exceptions parent-gvars gvars gargs] (if (= "<init>" method) (return (&/T Void/TYPE &/Nil$ &/Nil$ &/Nil$ &/Nil$)) (&host/lookup-virtual-method class-loader class method classes)) @@ -301,9 +308,9 @@ (return (&/|list (&&/|meta exo-type _cursor (&/V <tag> (&/T class method classes =object =args output-type))))))) - analyse-jvm-invokevirtual &&/$jvm-invokevirtual - analyse-jvm-invokeinterface &&/$jvm-invokeinterface - analyse-jvm-invokespecial &&/$jvm-invokespecial + analyse-jvm-invokevirtual &&/$jvm-invokevirtual false + analyse-jvm-invokespecial &&/$jvm-invokespecial false + analyse-jvm-invokeinterface &&/$jvm-invokeinterface true )) (defn analyse-jvm-invokestatic [analyse exo-type class method classes args] @@ -690,6 +697,16 @@ :final? false :abstract? false :concurrency nil} + default-<init> {:name "<init>" + :modifiers {:visibility "public" + :static? false + :final? false + :abstract? false + :concurrency nil} + :anns (&/|list) + :exceptions (&/|list) + :inputs (&/|list) + :output "void"} captured-slot-type "java.lang.Object"] (defn analyse-jvm-anon-class [analyse compile-token exo-type super-class interfaces methods] (&/with-closure @@ -698,7 +715,9 @@ :let [name (&host/location (&/|tail scope)) anon-class (str module "." name)] =method-descs (&/map% dummy-method-desc methods) - _ (&host/use-dummy-class name super-class interfaces (&/|list) =method-descs) + _ (->> =method-descs + (&/Cons$ default-<init>) + (&host/use-dummy-class name super-class interfaces (&/|list))) =methods (&/map% (partial analyse-method analyse anon-class) methods) _ (check-method-completion (&/Cons$ super-class interfaces) =methods) =captured &&env/captured-vars diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index c364091ba..1cefef555 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -479,11 +479,11 @@ (str "(" (&/fold str "" (&/|repeat (&/|length env) clo-field-sig)) ")" <init>-return)) - (defn ^:private add-anon-class-<init> [^ClassWriter class-writer class-name env] + (defn ^:private add-anon-class-<init> [^ClassWriter class-writer class-name super-class env] (doto (.visitMethod class-writer Opcodes/ACC_PUBLIC "<init>" (anon-class-<init>-signature env) nil nil) (.visitCode) (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V") + (.visitMethodInsn Opcodes/INVOKESPECIAL (&host/->class super-class) "<init>" "()V") (-> (doto (.visitVarInsn Opcodes/ALOAD 0) (.visitVarInsn Opcodes/ALOAD (inc ?captured-id)) (.visitFieldInsn Opcodes/PUTFIELD class-name captured-name clo-field-sig)) @@ -510,7 +510,7 @@ ?fields)] _ (&/map% (partial compile-method compile =class) ?methods) :let [_ (when env - (add-anon-class-<init> =class full-name env))]] + (add-anon-class-<init> =class full-name ?super-class env))]] (&&/save-class! ?name (.toByteArray (doto =class .visitEnd))))) (defn compile-jvm-interface [compile ?name ?supers ?anns ?methods] diff --git a/src/lux/host.clj b/src/lux/host.clj index 916f94419..c58698bb3 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -178,43 +178,42 @@ ;; else 0))) -(let [object-real-class (->class "java.lang.Object")] - (defn ^:private dummy-return [^MethodVisitor writer name output] - (case output - "void" (if (= "<init>" name) - (doto writer - (.visitVarInsn Opcodes/ALOAD 0) - (.visitMethodInsn Opcodes/INVOKESPECIAL object-real-class "<init>" "()V") - (.visitInsn Opcodes/RETURN)) - (.visitInsn writer Opcodes/RETURN)) - "boolean" (doto writer - (.visitLdcInsn false) - (.visitInsn Opcodes/IRETURN)) - "byte" (doto writer - (.visitLdcInsn (byte 0)) - (.visitInsn Opcodes/IRETURN)) - "short" (doto writer - (.visitLdcInsn (short 0)) +(defn ^:private dummy-return [^MethodVisitor writer super-class name output] + (case output + "void" (if (= "<init>" name) + (doto writer + (.visitVarInsn Opcodes/ALOAD 0) + (.visitMethodInsn Opcodes/INVOKESPECIAL (->class super-class) "<init>" "()V") + (.visitInsn Opcodes/RETURN)) + (.visitInsn writer Opcodes/RETURN)) + "boolean" (doto writer + (.visitLdcInsn false) (.visitInsn Opcodes/IRETURN)) - "int" (doto writer - (.visitLdcInsn (int 0)) + "byte" (doto writer + (.visitLdcInsn (byte 0)) + (.visitInsn Opcodes/IRETURN)) + "short" (doto writer + (.visitLdcInsn (short 0)) (.visitInsn Opcodes/IRETURN)) - "long" (doto writer - (.visitLdcInsn (long 0)) - (.visitInsn Opcodes/LRETURN)) - "float" (doto writer - (.visitLdcInsn (float 0.0)) - (.visitInsn Opcodes/FRETURN)) - "double" (doto writer - (.visitLdcInsn (double 0.0)) - (.visitInsn Opcodes/DRETURN)) - "char" (doto writer - (.visitLdcInsn (char 0)) - (.visitInsn Opcodes/IRETURN)) - ;; else - (doto writer - (.visitInsn Opcodes/ACONST_NULL) - (.visitInsn Opcodes/ARETURN))))) + "int" (doto writer + (.visitLdcInsn (int 0)) + (.visitInsn Opcodes/IRETURN)) + "long" (doto writer + (.visitLdcInsn (long 0)) + (.visitInsn Opcodes/LRETURN)) + "float" (doto writer + (.visitLdcInsn (float 0.0)) + (.visitInsn Opcodes/FRETURN)) + "double" (doto writer + (.visitLdcInsn (double 0.0)) + (.visitInsn Opcodes/DRETURN)) + "char" (doto writer + (.visitLdcInsn (char 0)) + (.visitInsn Opcodes/IRETURN)) + ;; else + (doto writer + (.visitInsn Opcodes/ACONST_NULL) + (.visitInsn Opcodes/ARETURN)))) (defn use-dummy-class [name super-class interfaces fields methods] (|do [module &/get-module-name @@ -236,7 +235,7 @@ nil (->> (:exceptions method) (&/|map ->class) &/->seq (into-array java.lang.String))) .visitCode - (dummy-return (:name method) (:output method)) + (dummy-return super-class (:name method) (:output method)) (.visitMaxs 0 0) (.visitEnd)))) methods) diff --git a/src/lux/packager/program.clj b/src/lux/packager/program.clj index 0ff06a453..e1d9a1d2f 100644 --- a/src/lux/packager/program.clj +++ b/src/lux/packager/program.clj @@ -81,8 +81,8 @@ (if entry (let [entry-name (.getName entry)] (if (and (not (.isDirectory entry)) - (not (.startsWith entry-name "META-INF/")) - (.endsWith entry-name ".class") + (not (.startsWith entry-name "META-INF/maven/")) + ;; (.endsWith entry-name ".class") (not (contains? seen entry-name))) (let [;; _ (prn 'entry entry-name) entry-data (read-stream is)] diff --git a/src/lux/type/host.clj b/src/lux/type/host.clj index d4627b273..38acf8162 100644 --- a/src/lux/type/host.clj +++ b/src/lux/type/host.clj @@ -197,10 +197,11 @@ :else (let [e!name (as-obj e!name) a!name (as-obj a!name)] - (cond (and (.equals ^Object e!name a!name) - (= (&/|length e!params) (&/|length a!params))) - (|do [_ (&/map2% check e!params a!params)] - (return (&/T fixpoints nil))) + (cond (.equals ^Object e!name a!name) + (if (= (&/|length e!params) (&/|length a!params)) + (|do [_ (&/map2% check e!params a!params)] + (return (&/T fixpoints nil))) + (fail (str "[Type Error] Amounts of generic parameters don't match: " e!name "(" (&/|length e!params) ")" " vs " a!name "(" (&/|length a!params) ")"))) (not invariant??) (|do [actual* (->super-type existential class-loader e!name a!name a!params)] |