aboutsummaryrefslogtreecommitdiff
path: root/src/lux/compiler/host.clj
diff options
context:
space:
mode:
Diffstat (limited to 'src/lux/compiler/host.clj')
-rw-r--r--src/lux/compiler/host.clj167
1 files changed, 116 insertions, 51 deletions
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index bcbed07c9..ffee3b095 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -26,6 +26,8 @@
AnnotationVisitor)))
;; [Utils]
+(def init-method "<init>")
+
(let [class+method+sig {"boolean" [(&host-generics/->bytecode-class-name "java.lang.Boolean") "booleanValue" "()Z"]
"byte" [(&host-generics/->bytecode-class-name "java.lang.Byte") "byteValue" "()B"]
"short" [(&host-generics/->bytecode-class-name "java.lang.Short") "shortValue" "()S"]
@@ -432,54 +434,118 @@
nil)))
(defn ^:private compile-method-return [^MethodVisitor writer output]
- (case output
- "void" (.visitInsn writer Opcodes/RETURN)
- "boolean" (doto writer
- &&/unwrap-boolean
- (.visitInsn Opcodes/IRETURN))
- "byte" (doto writer
- &&/unwrap-byte
- (.visitInsn Opcodes/IRETURN))
- "short" (doto writer
- &&/unwrap-short
- (.visitInsn Opcodes/IRETURN))
- "int" (doto writer
- &&/unwrap-int
- (.visitInsn Opcodes/IRETURN))
- "long" (doto writer
- &&/unwrap-long
- (.visitInsn Opcodes/LRETURN))
- "float" (doto writer
- &&/unwrap-float
- (.visitInsn Opcodes/FRETURN))
- "double" (doto writer
- &&/unwrap-double
- (.visitInsn Opcodes/DRETURN))
- "char" (doto writer
- &&/unwrap-char
- (.visitInsn Opcodes/IRETURN))
- ;; else
+ (|case output
+ (&/$GenericClass "void" (&/$Nil))
+ (.visitInsn writer Opcodes/RETURN)
+
+ (&/$GenericClass "boolean" (&/$Nil))
+ (doto writer
+ &&/unwrap-boolean
+ (.visitInsn Opcodes/IRETURN))
+
+ (&/$GenericClass "byte" (&/$Nil))
+ (doto writer
+ &&/unwrap-byte
+ (.visitInsn Opcodes/IRETURN))
+
+ (&/$GenericClass "short" (&/$Nil))
+ (doto writer
+ &&/unwrap-short
+ (.visitInsn Opcodes/IRETURN))
+
+ (&/$GenericClass "int" (&/$Nil))
+ (doto writer
+ &&/unwrap-int
+ (.visitInsn Opcodes/IRETURN))
+
+ (&/$GenericClass "long" (&/$Nil))
+ (doto writer
+ &&/unwrap-long
+ (.visitInsn Opcodes/LRETURN))
+
+ (&/$GenericClass "float" (&/$Nil))
+ (doto writer
+ &&/unwrap-float
+ (.visitInsn Opcodes/FRETURN))
+
+ (&/$GenericClass "double" (&/$Nil))
+ (doto writer
+ &&/unwrap-double
+ (.visitInsn Opcodes/DRETURN))
+
+ (&/$GenericClass "char" (&/$Nil))
+ (doto writer
+ &&/unwrap-char
+ (.visitInsn Opcodes/IRETURN))
+
+ _
(.visitInsn writer Opcodes/ARETURN)))
-(defn ^:private compile-method-def [compile ^ClassWriter class-writer method-def]
- (|let [[=method-decl =body] method-def
- [=name =anns =gvars =exceptions =inputs =output] =method-decl
- [simple-signature generic-signature] (&host-generics/method-signatures =method-decl)]
- (&/with-writer (.visitMethod class-writer
- Opcodes/ACC_PUBLIC
- =name
- simple-signature
- generic-signature
- (->> =exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
- (|do [^MethodVisitor =method &/get-writer
- :let [_ (&/|map (partial compile-annotation =method) =anns)
- _ (.visitCode =method)]
- _ (compile =body)
- :let [_ (doto =method
- (compile-method-return =output)
- (.visitMaxs 0 0)
- (.visitEnd))]]
- (return nil)))))
+(defn ^:private compile-method-def [compile ^ClassWriter class-writer ?super-class method-def]
+ (|case method-def
+ (&/$ConstructorMethodAnalysis ?anns ?gvars ?exceptions ?inputs ?ctor-args ?body)
+ (|let [?output (&/V &/$GenericClass (&/T "void" (&/|list)))
+ =method-decl (&/T init-method ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output)
+ [simple-signature generic-signature] (&host-generics/method-signatures =method-decl)]
+ (&/with-writer (.visitMethod class-writer
+ Opcodes/ACC_PUBLIC
+ init-method
+ simple-signature
+ generic-signature
+ (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+ (|do [^MethodVisitor =method &/get-writer
+ :let [[super-class-name super-class-params] ?super-class
+ init-types (->> ?ctor-args (&/|map (comp &host-generics/->type-signature &/|first)) (&/fold str ""))
+ init-sig (str "(" init-types ")" "V")
+ _ (&/|map (partial compile-annotation =method) ?anns)
+ _ (doto =method
+ (.visitCode)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name super-class-name) init-method init-sig))]
+ _ (compile ?body)
+ :let [_ (doto =method
+ (compile-method-return ?output)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil))))
+
+ (&/$VirtualMethodAnalysis ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
+ (|let [=method-decl (&/T ?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output)
+ [simple-signature generic-signature] (&host-generics/method-signatures =method-decl)]
+ (&/with-writer (.visitMethod class-writer
+ Opcodes/ACC_PUBLIC
+ ?name
+ simple-signature
+ generic-signature
+ (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+ (|do [^MethodVisitor =method &/get-writer
+ :let [_ (&/|map (partial compile-annotation =method) ?anns)
+ _ (.visitCode =method)]
+ _ (compile ?body)
+ :let [_ (doto =method
+ (compile-method-return ?output)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil))))
+
+ (&/$OverridenMethodAnalysis ?class-decl ?name ?anns ?gvars ?exceptions ?inputs ?output ?body)
+ (|let [=method-decl (&/T ?name ?anns ?gvars ?exceptions (&/|map &/|second ?inputs) ?output)
+ [simple-signature generic-signature] (&host-generics/method-signatures =method-decl)]
+ (&/with-writer (.visitMethod class-writer
+ Opcodes/ACC_PUBLIC
+ ?name
+ simple-signature
+ generic-signature
+ (->> ?exceptions (&/|map &host-generics/->bytecode-class-name) &/->seq (into-array java.lang.String)))
+ (|do [^MethodVisitor =method &/get-writer
+ :let [_ (&/|map (partial compile-annotation =method) ?anns)
+ _ (.visitCode =method)]
+ _ (compile ?body)
+ :let [_ (doto =method
+ (compile-method-return ?output)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (return nil))))
+ ))
(defn ^:private compile-method-decl [^ClassWriter class-writer =method-decl]
(|let [[=name =anns =gvars =exceptions =inputs =output] =method-decl
@@ -525,7 +591,6 @@
(.visitTypeInsn Opcodes/CHECKCAST (&host-generics/->bytecode-class-name type)))))
(let [clo-field-sig (&host-generics/->type-signature "java.lang.Object")
- init-method "<init>"
<init>-return "V"]
(defn ^:private anon-class-<init>-signature [env]
(str "(" (&/fold str "" (&/|repeat (&/|length env) clo-field-sig)) ")"
@@ -574,7 +639,7 @@
_ (&/|map (partial compile-annotation =class) ?anns)
_ (&/|map (partial compile-field =class)
?fields)]
- _ (&/map% (partial compile-method-def compile =class) ?methods)
+ _ (&/map% (partial compile-method-def compile =class ?super-class) ?methods)
_ (|case ??ctor-args
(&/$Some ctor-args)
(add-anon-class-<init> =class compile full-name ?super-class env ctor-args)
@@ -612,7 +677,7 @@
(&/|list)
(&/|list)
(&/|list)
- (&/|list (&/T "arg" object-class))
+ (&/|list object-class)
object-class))]
(compile-jvm-interface nil interface-decl ?supers ?anns ?methods))))))
@@ -695,7 +760,7 @@
(.visitTypeInsn Opcodes/CHECKCAST (&host-generics/->bytecode-class-name <from-class>))
(.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host-generics/->bytecode-class-name <from-class>) <from-method> <from-sig>)
(.visitInsn <op>)
- (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name <to-class>) "<init>" <to-sig>))]]
+ (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name <to-class>) init-method <to-sig>))]]
(return nil)))
compile-jvm-d2f Opcodes/D2F "java.lang.Double" "doubleValue" "()D" "java.lang.Float" "(F)V"
@@ -734,7 +799,7 @@
(.visitMethodInsn Opcodes/INVOKEVIRTUAL (&host-generics/->bytecode-class-name <from2-class>) <from2-method> <from2-sig>))]
:let [_ (doto *writer*
(.visitInsn <op>)
- (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name <to-class>) "<init>" <to-sig>))]]
+ (.visitMethodInsn Opcodes/INVOKESPECIAL (&host-generics/->bytecode-class-name <to-class>) init-method <to-sig>))]]
(return nil)))
compile-jvm-iand Opcodes/IAND "intValue" "()I" "java.lang.Integer" "intValue" "()I" "java.lang.Integer" "java.lang.Integer" "(I)V"