diff options
author | Eduardo Julian | 2015-12-19 01:40:13 -0400 |
---|---|---|
committer | Eduardo Julian | 2015-12-19 01:40:13 -0400 |
commit | 2116490ae82a29b1fd76bbbdf350cfa615c36c39 (patch) | |
tree | af35f5a81bd5ff47b605701f4b55e6b8eda0f5f0 | |
parent | 405a7efaf6ba2f20c5d3c5c654da964bda1451c6 (diff) |
- Fixed some bugs regarding JVM interface definition.
- Removed (unnecessary) logging.
Diffstat (limited to '')
-rw-r--r-- | src/lux/analyser/host.clj | 6 | ||||
-rw-r--r-- | src/lux/analyser/parser.clj | 22 | ||||
-rw-r--r-- | src/lux/compiler/host.clj | 4 | ||||
-rw-r--r-- | src/lux/host.clj | 33 | ||||
-rw-r--r-- | src/lux/host/generics.clj | 15 |
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)" |