aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj2
-rw-r--r--src/lux/analyser/host.clj31
-rw-r--r--src/lux/compiler/host.clj6
-rw-r--r--src/lux/host.clj71
-rw-r--r--src/lux/packager/program.clj4
-rw-r--r--src/lux/type/host.clj9
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)]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 06:07:57 +0000