diff options
Diffstat (limited to '')
| -rw-r--r-- | lux-bootstrapper/src/lux/analyser/proc/jvm.clj | 26 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj | 2 | ||||
| -rw-r--r-- | lux-bootstrapper/src/lux/host.clj | 54 |
3 files changed, 60 insertions, 22 deletions
diff --git a/lux-bootstrapper/src/lux/analyser/proc/jvm.clj b/lux-bootstrapper/src/lux/analyser/proc/jvm.clj index cc77bf72c..78362601d 100644 --- a/lux-bootstrapper/src/lux/analyser/proc/jvm.clj +++ b/lux-bootstrapper/src/lux/analyser/proc/jvm.clj @@ -854,7 +854,8 @@ =fields (&/map% (partial analyse-field analyse class-env) ?fields) _ (&host/use-dummy-class class-decl super-class interfaces &/$None =fields methods) =methods (&/map% (partial analyse-method analyse class-decl* class-env all-supers) methods) - _ (check-method-completion all-supers =methods) + ;; TODO: Uncomment + ;; _ (check-method-completion all-supers =methods) _ (compile-class class-decl super-class interfaces =inheritance-modifier =anns =fields =methods &/$Nil &/$None) _ &/pop-dummy-name :let [_ (println 'CLASS full-name)] @@ -869,7 +870,8 @@ (defn- analyse-methods [analyse class-decl all-supers methods] (|do [=methods (&/map% (partial analyse-method analyse class-decl &/$Nil all-supers) methods) - _ (check-method-completion all-supers =methods) + ;; TODO: Uncomment + ;; _ (check-method-completion all-supers =methods) =captured &&env/captured-vars] (return (&/T [=methods =captured])))) @@ -878,14 +880,16 @@ scope &/get-scope-name] (return (&/T [module scope])))) -(let [default-<init> (&/$ConstructorMethodSyntax (&/T [&/$PublicPM - false - &/$Nil - &/$Nil - &/$Nil - &/$Nil - &/$Nil - (&/$Tuple &/$Nil)])) +(let [default-<init> (fn [ctor-args] + (&/$ConstructorMethodSyntax (&/T [&/$PublicPM ;; privacy-modifier + false ;; strict + &/$Nil ;; anns + &/$Nil ;; gvars + &/$Nil ;; exceptions + &/$Nil ;; inputs + ctor-args ;; ctor-args + (&/$Tuple &/$Nil) ;; body + ]))) captured-slot-class "java.lang.Object" captured-slot-type (&/$GenericClass captured-slot-class &/$Nil)] (defn- analyse-jvm-anon-class [analyse compile-class exo-type super-class interfaces ctor-args methods] @@ -902,7 +906,7 @@ (return (&/T [arg-type =arg-term]))))) ctor-args) _ (->> methods - (&/$Cons default-<init>) + (&/$Cons (default-<init> =ctor-args)) (&host/use-dummy-class class-decl super-class interfaces (&/$Some =ctor-args) &/$Nil)) [=methods =captured] (let [all-supers (&/$Cons super-class interfaces)] (analyse-methods analyse class-type-decl all-supers methods)) diff --git a/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj b/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj index 034d503a7..a1039f0b3 100644 --- a/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj +++ b/lux-bootstrapper/src/lux/compiler/jvm/proc/host.clj @@ -407,7 +407,7 @@ (let [clo-field-sig (&host-generics/->type-signature "java.lang.Object") <init>-return "V"] (defn ^:private anon-class-<init>-signature [env] - (str "(" (&/fold str "" (&/|repeat (&/|length env) clo-field-sig)) ")" + (str "(" (->> clo-field-sig (&/|repeat (&/|length env)) (&/fold str "")) ")" <init>-return)) (defn ^:private add-anon-class-<init> [^ClassWriter class-writer compile class-name super-class env ctor-args] diff --git a/lux-bootstrapper/src/lux/host.clj b/lux-bootstrapper/src/lux/host.clj index 562d582f6..4da818db2 100644 --- a/lux-bootstrapper/src/lux/host.clj +++ b/lux-bootstrapper/src/lux/host.clj @@ -273,15 +273,19 @@ (def init-method-name "<init>") (defn ^:private dummy-ctor [^MethodVisitor writer real-name store-name super-class ctor-args] - (|let [ctor-arg-types (->> ctor-args (&/|map (comp &host-generics/->type-signature (comp (partial ->dummy-type real-name store-name) &/|first))) (&/fold str ""))] + (|let [ctor-arg-types (->> ctor-args + (&/|map (comp &host-generics/gclass->signature (comp (partial ->dummy-type real-name store-name) &/|first))) + (&/fold str ""))] (doto writer (.visitVarInsn Opcodes/ALOAD 0) (-> (doto (dummy-value arg-type) - (-> (.visitTypeInsn Opcodes/CHECKCAST (&host-generics/->bytecode-class-name arg-type)) + (-> (.visitTypeInsn Opcodes/CHECKCAST arg-type) (->> (when (not (primitive-jvm-type? arg-type)))))) (->> (doseq [ctor-arg (&/->seq ctor-args) - :let [;; arg-term (&/|first ctor-arg) - arg-type (->dummy-type real-name store-name (&/|first ctor-arg))]]))) + :let [arg-type (->> ctor-arg + &/|first + (->dummy-type real-name store-name) + &host-generics/gclass->class-name)]]))) (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name (&host-generics/super-class-name super-class)) init-method-name (str "(" ctor-arg-types ")V")) (.visitInsn Opcodes/RETURN)))) @@ -289,7 +293,12 @@ (|case method-def (&/$ConstructorMethodSyntax =privacy-modifier ?strict =anns =gvars =exceptions =inputs =ctor-args body) (|let [=output (&/$GenericClass "void" (&/|list)) - method-decl [init-method-name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)] + method-decl [init-method-name + =anns + =gvars + (&/|map (partial ->dummy-type real-name store-name) =exceptions) + (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) + (->dummy-type real-name store-name =output)] [simple-signature generic-signature] (&host-generics/method-signatures method-decl)] (doto (.visitMethod =class Opcodes/ACC_PUBLIC init-method-name @@ -302,7 +311,12 @@ (.visitEnd))) (&/$VirtualMethodSyntax =name =privacy-modifier =final? ?strict =anns =gvars =exceptions =inputs =output body) - (|let [method-decl [=name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)] + (|let [method-decl [=name + =anns + =gvars + (&/|map (partial ->dummy-type real-name store-name) =exceptions) + (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) + (->dummy-type real-name store-name =output)] [simple-signature generic-signature] (&host-generics/method-signatures method-decl)] (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC (if =final? Opcodes/ACC_FINAL 0)) @@ -316,7 +330,12 @@ (.visitEnd))) (&/$OverridenMethodSyntax =class-decl =name ?strict =anns =gvars =exceptions =inputs =output body) - (|let [method-decl [=name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)] + (|let [method-decl [=name + =anns + =gvars + (&/|map (partial ->dummy-type real-name store-name) =exceptions) + (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) + (->dummy-type real-name store-name =output)] [simple-signature generic-signature] (&host-generics/method-signatures method-decl)] (doto (.visitMethod =class Opcodes/ACC_PUBLIC =name @@ -329,7 +348,12 @@ (.visitEnd))) (&/$StaticMethodSyntax =name =privacy-modifier ?strict =anns =gvars =exceptions =inputs =output body) - (|let [method-decl [=name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)] + (|let [method-decl [=name + =anns + =gvars + (&/|map (partial ->dummy-type real-name store-name) =exceptions) + (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) + (->dummy-type real-name store-name =output)] [simple-signature generic-signature] (&host-generics/method-signatures method-decl)] (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) =name @@ -342,7 +366,12 @@ (.visitEnd))) (&/$AbstractMethodSyntax =name =privacy-modifier =anns =gvars =exceptions =inputs =output) - (|let [method-decl [=name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)] + (|let [method-decl [=name + =anns + =gvars + (&/|map (partial ->dummy-type real-name store-name) =exceptions) + (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) + (->dummy-type real-name store-name =output)] [simple-signature generic-signature] (&host-generics/method-signatures method-decl)] (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) =name @@ -352,7 +381,12 @@ (.visitEnd))) (&/$NativeMethodSyntax =name =privacy-modifier =anns =gvars =exceptions =inputs =output) - (|let [method-decl [=name =anns =gvars (&/|map (partial ->dummy-type real-name store-name) =exceptions) (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) (->dummy-type real-name store-name =output)] + (|let [method-decl [=name + =anns + =gvars + (&/|map (partial ->dummy-type real-name store-name) =exceptions) + (&/|map (comp (partial ->dummy-type real-name store-name) &/|second) =inputs) + (->dummy-type real-name store-name =output)] [simple-signature generic-signature] (&host-generics/method-signatures method-decl)] (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_NATIVE) =name |