aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser/host.clj9
-rw-r--r--src/lux/compiler/host.clj21
-rw-r--r--src/lux/host.clj64
-rw-r--r--src/lux/type.clj2
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")
<init>-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)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 07:01:54 +0000