aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/lux/analyser/host.clj6
-rw-r--r--src/lux/analyser/parser.clj22
-rw-r--r--src/lux/compiler/host.clj4
-rw-r--r--src/lux/host.clj33
-rw-r--r--src/lux/host/generics.clj15
5 files changed, 37 insertions, 43 deletions
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 482e6c723..ecd2edc36 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -616,7 +616,6 @@
"(-> (List SuperClassDecl) (List (, MethodDecl Analysis)) (Lux (,)))"
(|do [abstract-methods (mandatory-methods supers)
:let [methods-map (&/fold (fn [mmap mentry]
- (prn 'methods-map (count mentry) mentry)
(|case mentry
(&/$ConstructorMethodAnalysis _)
mmap
@@ -637,8 +636,7 @@
(if (and (= (&/|length =inputs) (&/|length am-inputs))
(&/fold2 (fn [prev mi ai]
(|let [[iname itype] mi]
- (do (prn '[iname itype] [iname itype])
- (and prev (= (generic-class->simple-class itype) ai)))))
+ (and prev (= (generic-class->simple-class itype) ai))))
true
=inputs am-inputs))
nil
@@ -695,8 +693,6 @@
:let [name (&host/location (&/|tail scope))
class-decl (&/T name (&/|list))
anon-class (str module "." name)
- _ (prn 'analyse-jvm-anon-class/_0 anon-class)
- _ (prn 'analyse-jvm-anon-class/_1 class-decl)
anon-class-type (&type/Data$ anon-class (&/|list))]
=ctor-args (&/map% (fn [ctor-arg]
(|let [[arg-type arg-term] ctor-arg]
diff --git a/src/lux/analyser/parser.clj b/src/lux/analyser/parser.clj
index a0b83a9e9..5aca6feb8 100644
--- a/src/lux/analyser/parser.clj
+++ b/src/lux/analyser/parser.clj
@@ -124,25 +124,23 @@
_
(fail (str "[Analyser Error] Invalid argument declaration: " (&/show-ast ast)))))
-(defn parse-method-decl [asts]
- (|case asts
- (&/$Cons [_ (&/$TextS method-name)]
- (&/$Cons [_ (&/$TupleS anns)]
- (&/$Cons [_ (&/$TupleS gvars)]
- (&/$Cons [_ (&/$TupleS exceptions)]
- (&/$Cons [_ (&/$TupleS inputs)]
- (&/$Cons output
- *tail*))))))
+(defn parse-method-decl [ast]
+ (|case ast
+ [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)]
+ (&/$Cons [_ (&/$TupleS anns)]
+ (&/$Cons [_ (&/$TupleS gvars)]
+ (&/$Cons [_ (&/$TupleS exceptions)]
+ (&/$Cons [_ (&/$TupleS inputs)]
+ (&/$Cons output (&/$Nil))))))))]
(|do [=anns (&/map% parse-ann anns)
=gvars (&/map% parse-text gvars)
=exceptions (&/map% parse-gclass exceptions)
=inputs (&/map% parse-gclass inputs)
=output (parse-gclass output)]
- (return (&/T (&/T method-name =anns =gvars =exceptions =inputs =output)
- *tail*)))
+ (return (&/T method-name =anns =gvars =exceptions =inputs =output)))
_
- (fail (str "[Analyser Error] Invalid method declaration: " (->> asts (&/|map &/show-ast) (&/|interpose " ") (&/fold str ""))))))
+ (fail (str "[Analyser Error] Invalid method declaration: " (&/show-ast ast)))))
(defn parse-method-def [ast]
(|case ast
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index ffee3b095..c260a36fd 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -555,7 +555,7 @@
=name
simple-signature
generic-signature
- (->> =exceptions (&/|map &host-generics/gclass->simple-signature) &/->seq (into-array java.lang.String)))
+ (->> =exceptions (&/|map &host-generics/gclass->class-name) &/->seq (into-array java.lang.String)))
_ (&/|map (partial compile-annotation =method) =anns)
_ (.visitEnd =method)]
nil))
@@ -627,10 +627,8 @@
(|do [module &/get-module-name
[file-name _ _] &/cursor
:let [[?name ?params] class-decl
- _ (prn 'compile-jvm-class/_0 class-decl ?name)
class-signature (&host-generics/gclass-decl->signature class-decl (&/Cons$ ?super-class ?interfaces))
full-name (str module "/" ?name)
- _ (prn 'compile-jvm-class/_1 full-name class-signature)
super-class* (&host-generics/->bytecode-class-name (&host-generics/super-class-name ?super-class))
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
diff --git a/src/lux/host.clj b/src/lux/host.clj
index c196496ab..fed7c449b 100644
--- a/src/lux/host.clj
+++ b/src/lux/host.clj
@@ -238,20 +238,15 @@
(|let [=output (&/V &/$GenericClass (&/T "void" (&/|list)))
method-decl [init-method-name =anns =gvars =exceptions (&/|map &/|second =inputs) =output]
[simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
- (do (println 'compile-dummy-method
- (&/adt->text =exceptions)
- (->> =exceptions (&/|map &host-generics/gclass->bytecode-class-name) &/->seq)
- simple-signature
- generic-signature)
- (doto (.visitMethod =class Opcodes/ACC_PUBLIC
- init-method-name
- simple-signature
- generic-signature
- (->> =exceptions (&/|map &host-generics/gclass->bytecode-class-name) &/->seq (into-array java.lang.String)))
- .visitCode
- (dummy-ctor super-class =ctor-args)
- (.visitMaxs 0 0)
- (.visitEnd))))
+ (doto (.visitMethod =class Opcodes/ACC_PUBLIC
+ init-method-name
+ simple-signature
+ generic-signature
+ (->> =exceptions (&/|map &host-generics/gclass->bytecode-class-name) &/->seq (into-array java.lang.String)))
+ .visitCode
+ (dummy-ctor super-class =ctor-args)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
(&/$VirtualMethodSyntax =name =anns =gvars =exceptions =inputs =output body)
(|let [method-decl [=name =anns =gvars =exceptions (&/|map &/|second =inputs) =output]
@@ -268,11 +263,7 @@
(&/$OverridenMethodSyntax =class-decl =name =anns =gvars =exceptions =inputs =output body)
(|let [method-decl [=name =anns =gvars =exceptions (&/|map &/|second =inputs) =output]
- [simple-signature generic-signature] (&host-generics/method-signatures method-decl)
- _ (prn 'OverridenMethodSyntax =name
- simple-signature
- generic-signature
- (->> =exceptions (&/|map &host-generics/gclass->bytecode-class-name) &/->seq))]
+ [simple-signature generic-signature] (&host-generics/method-signatures method-decl)]
(doto (.visitMethod =class Opcodes/ACC_PUBLIC
=name
simple-signature
@@ -291,9 +282,6 @@
(|do [module &/get-module-name
:let [[?name ?params] class-decl
full-name (str module "/" ?name)
- _ (println 'use-dummy-class full-name ;; (&/adt->text methods)
- (&host-generics/->bytecode-class-name (&host-generics/super-class-name super-class))
- (->> interfaces (&/|map (comp &host-generics/->bytecode-class-name &host-generics/super-class-name)) &/->seq))
class-signature (&host-generics/gclass-decl->signature class-decl interfaces)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
@@ -313,7 +301,6 @@
^ClassLoader loader &/loader
!classes &/classes
:let [real-name (str (&host-generics/->class-name module) "." ?name)
- _ (prn 'use-dummy-class/_0 ?name real-name)
_ (swap! !classes assoc real-name bytecode)
;; _ (with-open [stream (java.io.BufferedOutputStream. (java.io.FileOutputStream. (str "target/jvm/" full-name ".class")))]
;; (.write stream bytecode))
diff --git a/src/lux/host/generics.clj b/src/lux/host/generics.clj
index ccedf70ae..70ed9ecab 100644
--- a/src/lux/host/generics.clj
+++ b/src/lux/host/generics.clj
@@ -101,6 +101,21 @@
_
(assert false (str 'gclass->simple-signature " " (&/adt->text gclass))))))
+(defn gclass->class-name [gclass]
+ "(-> GenericClass Text)"
+ (|case gclass
+ (&/$GenericTypeVar name)
+ (gclass->class-name "java.lang.Object")
+
+ (&/$GenericClass name params)
+ (->bytecode-class-name name)
+
+ (&/$GenericArray param)
+ (str "[" (gclass->class-name param))
+
+ _
+ (assert false (str 'gclass->class-name " " (&/adt->text gclass)))))
+
(let [object-bc-name (->bytecode-class-name "java.lang.Object")]
(defn gclass->bytecode-class-name [gclass]
"(-> GenericClass Text)"
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 20:08:37 +0000