From ceff2a8a5fc4cb701a114071f75367c8b1004887 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 16 Sep 2015 21:10:41 -0400 Subject: - Did a trick to make sure "this" always had the type of the class being defined, instead of the type of the super-class. --- src/lux/analyser/host.clj | 9 ++++--- src/lux/compiler/host.clj | 21 +++------------- src/lux/host.clj | 64 +++++++++++++++++++++++++++++++++++++---------- src/lux/type.clj | 2 -- 4 files changed, 60 insertions(+), 36 deletions(-) diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj index 292d3d4b1..6c15c8bbc 100644 --- a/src/lux/analyser/host.clj +++ b/src/lux/analyser/host.clj @@ -425,7 +425,7 @@ _ (fail "[Analyser Error] Wrong syntax for field."))) -(defn ^:private analyse-method [analyse name owner-class method] +(defn ^:private analyse-method [analyse owner-class method] (|case method [idx [_ (&/$FormS (&/$Cons [_ (&/$TextS method-name)] (&/$Cons [_ (&/$TupleS method-inputs)] @@ -511,10 +511,12 @@ (defn analyse-jvm-class [analyse compile-token name super-class interfaces fields methods] (&/with-closure (|do [module &/get-module-name + :let [full-name (str module "." name)] ;; :let [_ (prn 'analyse-jvm-class/_0)] =fields (&/map% analyse-field fields) ;; :let [_ (prn 'analyse-jvm-class/_1)] - =methods (&/map% (partial analyse-method analyse name super-class) (&/enumerate methods)) + _ (&host/use-dummy-class name super-class interfaces =fields) + =methods (&/map% (partial analyse-method analyse full-name) (&/enumerate methods)) ;; :let [_ (prn 'analyse-jvm-class/_2)] _ (check-method-completion (&/Cons$ super-class interfaces) =methods) ;; :let [_ (prn 'analyse-jvm-class/_3)] @@ -549,7 +551,8 @@ :let [name (&host/location (&/|tail scope)) anon-class (str module "." name)] ;; :let [_ (prn 'analyse-jvm-anon-class/_2 name anon-class)] - =methods (&/map% (partial analyse-method analyse name super-class) (&/enumerate methods)) + _ (&host/use-dummy-class name super-class interfaces (&/|list)) + =methods (&/map% (partial analyse-method analyse anon-class) (&/enumerate methods)) ;; :let [_ (prn 'analyse-jvm-anon-class/_3 name anon-class)] _ (check-method-completion (&/Cons$ super-class interfaces) =methods) ;; :let [_ (prn 'analyse-jvm-anon-class/_4 name anon-class)] diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj index 179b5423c..89f830561 100644 --- a/src/lux/compiler/host.clj +++ b/src/lux/compiler/host.clj @@ -401,21 +401,6 @@ :let [_ (.visitFieldInsn *writer* Opcodes/PUTFIELD class* ?field (&host/->java-sig ?output-type))]] (return nil))) -(defn ^:private modifiers->int [mods] - (+ (case (:visibility mods) - "default" 0 - "public" Opcodes/ACC_PUBLIC - "private" Opcodes/ACC_PRIVATE - "protected" Opcodes/ACC_PROTECTED) - (if (:static? mods) Opcodes/ACC_STATIC 0) - (if (:final? mods) Opcodes/ACC_FINAL 0) - (if (:abstract? mods) Opcodes/ACC_ABSTRACT 0) - (case (:concurrency mods) - "synchronized" Opcodes/ACC_SYNCHRONIZED - "volatile" Opcodes/ACC_VOLATILE - ;; else - 0))) - (defn compile-jvm-instanceof [compile class object] (|do [:let [class* (&host/->class class)] ^MethodVisitor *writer* &/get-writer @@ -432,7 +417,7 @@ ;; (prn 'compile-method/_3 (&/adt->text (:body method))) (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" (&host/->type-signature (:output method)))] - (&/with-writer (.visitMethod class-writer (modifiers->int (:modifiers method)) + (&/with-writer (.visitMethod class-writer (&host/modifiers->int (:modifiers method)) (:name method) signature nil nil) (|do [^MethodVisitor =method &/get-writer @@ -447,7 +432,7 @@ (defn ^:private compile-method-decl [class-writer method] (|let [signature (str "(" (&/fold str "" (&/|map &host/->type-signature (:inputs method))) ")" (&host/->type-signature (:output method)))] - (.visitMethod class-writer (modifiers->int (:modifiers method)) (:name method) signature nil nil))) + (.visitMethod class-writer (&host/modifiers->int (:modifiers method)) (:name method) signature nil nil))) (let [clo-field-sig (&host/->type-signature "java.lang.Object") -return "V"] @@ -484,7 +469,7 @@ full-name nil super-class* (->> ?interfaces (&/|map &host/->class) &/->seq (into-array String))) (.visitSource file-name nil)) _ (&/|map (fn [field] - (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field) + (doto (.visitField =class (&host/modifiers->int (:modifiers field)) (:name field) (&host/->type-signature (:type field)) nil nil) (.visitEnd))) ?fields)] diff --git a/src/lux/host.clj b/src/lux/host.clj index 6be162bf7..d2ade63c7 100644 --- a/src/lux/host.clj +++ b/src/lux/host.clj @@ -11,7 +11,11 @@ (lux [base :as & :refer [|do return* return fail fail* |let |case]] [type :as &type])) (:import (java.lang.reflect Field Method Constructor Modifier) - java.util.regex.Pattern)) + java.util.regex.Pattern + (org.objectweb.asm Opcodes + Label + ClassWriter + MethodVisitor))) ;; [Constants] (def prefix "lux.") @@ -46,18 +50,18 @@ (defn ^:private class->type [^Class class] "(-> Class Type)" (do ;; (prn 'class->type/_0 class (.getSimpleName class) (.getName class)) - (if-let [[_ _ arr-brackets arr-base simple-base] (re-find class-name-re (.getName class))] - (let [base (or arr-base simple-base)] - ;; (prn 'class->type/_1 class base arr-brackets) - (let [output-type (if (.equals "void" base) - &type/Unit - (reduce (fn [inner _] (&type/Data$ array-data-tag (&/|list inner))) - (&type/Data$ base &/Nil$) - (range (count (or arr-brackets "")))) - )] - ;; (prn 'class->type/_2 class (&type/show-type output-type)) - output-type) - )))) + (if-let [[_ _ arr-brackets arr-base simple-base] (re-find class-name-re (.getName class))] + (let [base (or arr-base simple-base)] + ;; (prn 'class->type/_1 class base arr-brackets) + (let [output-type (if (.equals "void" base) + &type/Unit + (reduce (fn [inner _] (&type/Data$ array-data-tag (&/|list inner))) + (&type/Data$ base &/Nil$) + (range (count (or arr-brackets "")))) + )] + ;; (prn 'class->type/_2 class (&type/show-type output-type)) + output-type) + )))) (defn ^:private method->type [^Method method] "(-> Method Type)" @@ -186,3 +190,37 @@ (defn location [scope] (->> scope (&/|map &/normalize-name) (&/|interpose "$") (&/fold str ""))) + +(defn modifiers->int [mods] + (+ (case (:visibility mods) + "default" 0 + "public" Opcodes/ACC_PUBLIC + "private" Opcodes/ACC_PRIVATE + "protected" Opcodes/ACC_PROTECTED) + (if (:static? mods) Opcodes/ACC_STATIC 0) + (if (:final? mods) Opcodes/ACC_FINAL 0) + (if (:abstract? mods) Opcodes/ACC_ABSTRACT 0) + (case (:concurrency mods) + "synchronized" Opcodes/ACC_SYNCHRONIZED + "volatile" Opcodes/ACC_VOLATILE + ;; else + 0))) + +(defn use-dummy-class [name super-class interfaces fields] + (|do [module &/get-module-name + :let [full-name (str module "/" name) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER) + full-name nil (->class super-class) (->> interfaces (&/|map ->class) &/->seq (into-array String)))) + _ (&/|map (fn [field] + (doto (.visitField =class (modifiers->int (:modifiers field)) (:name field) + (->type-signature (:type field)) nil nil) + (.visitEnd))) + fields) + bytecode (.toByteArray (doto =class .visitEnd))] + loader &/loader + !classes &/classes + :let [real-name (str (->class-name module) "." name) + _ (swap! !classes assoc real-name bytecode) + _ (.loadClass loader real-name)]] + (return nil))) diff --git a/src/lux/type.clj b/src/lux/type.clj index bc28dbde0..24486c85a 100644 --- a/src/lux/type.clj +++ b/src/lux/type.clj @@ -404,8 +404,6 @@ "\n\nActual: " (show-type actual) "\n")) -;; (def !flag (atom false)) - (defn beta-reduce [env type] ;; (when @!flag ;; (prn 'beta-reduce (show-type type))) -- cgit v1.2.3