aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/base.clj9
-rw-r--r--src/lux/compiler.clj2
-rw-r--r--src/lux/compiler/base.clj4
-rw-r--r--src/lux/compiler/host.clj109
-rw-r--r--src/lux/compiler/lambda.clj102
-rw-r--r--src/lux/compiler/lux.clj19
6 files changed, 176 insertions, 69 deletions
diff --git a/src/lux/base.clj b/src/lux/base.clj
index b921fa86c..02bd55112 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -716,12 +716,6 @@
(.invoke define-class this (to-array [class-name bytecode (int 0) (int (alength bytecode))]))
(throw (IllegalStateException. (str "[Class Loader] Unknown class: " class-name))))))))
-;; (deftype Host
-;; (& #writer (^ org.objectweb.asm.ClassWriter)
-;; #loader (^ java.net.URLClassLoader)
-;; #classes (^ clojure.lang.Atom)
-;; #catching (List Text)
-;; #module-states (List (, Text ModuleState))))
(defn host [_]
(let [store (atom {})]
(T [;; "lux;writer"
@@ -1212,3 +1206,6 @@
_
(assert false (adt->text xs))))
+
+(defn |partition [n xs]
+ (->> xs ->seq (partition-all n) (map ->list) ->list))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 657d681c8..89a608ad0 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -90,7 +90,7 @@
;; Must get rid of this one...
(&o/$ann ?value-ex ?type-ex ?value-type)
- (&&lux/compile-ann compile-expression ?value-ex ?type-ex ?value-type)
+ (compile-expression ?value-ex)
(&o/$proc [?proc-category ?proc-name] ?args special-args)
(&&host/compile-host compile-expression ?proc-category ?proc-name ?args special-args)
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 9663e692e..19d918ef9 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -35,7 +35,9 @@
(def ^String local-prefix "l")
(def ^String partial-prefix "p")
(def ^String closure-prefix "c")
-(def ^String apply-signature "(Ljava/lang/Object;)Ljava/lang/Object;")
+(def ^String apply-method "apply")
+(defn ^String apply-signature [n]
+ (str "(" (apply str (repeat n "Ljava/lang/Object;")) ")Ljava/lang/Object;"))
(def exported-separator " ")
(def def-separator "\t")
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index d56c67715..54def6b76 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -346,7 +346,7 @@
(|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 Opcodes/ACC_ABSTRACT
+ (+ Opcodes/ACC_ABSTRACT
(&host/privacy-modifier->flag ?privacy-modifier))
?name
simple-signature
@@ -521,17 +521,62 @@
(&&/save-class! interface-name (.toByteArray =interface))))
(def compile-Function-class
- (let [object-class (&/$GenericClass "java.lang.Object" (&/|list))
- interface-decl (&/T [(second (string/split &&/function-class #"/")) (&/|list)])
- ?supers (&/|list)
- ?anns (&/|list)
- ?methods (&/|list (&/T ["apply"
- (&/|list)
- (&/|list)
- (&/|list)
- (&/|list object-class)
- object-class]))]
- (compile-jvm-interface interface-decl ?supers ?anns ?methods)))
+ (|do [_ (return nil)
+ :let [super-class "java/lang/Object"
+ =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER
+ Opcodes/ACC_ABSTRACT
+ ;; Opcodes/ACC_INTERFACE
+ )
+ &&/function-class nil super-class (into-array String [])))
+ =init-method (doto (.visitMethod =class Opcodes/ACC_PUBLIC init-method "()V" nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL super-class init-method "()V")
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ =apply1 (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_ABSTRACT) &&/apply-method (&&/apply-signature 1) nil nil)
+ (.visitEnd))
+ =apply2 (doto (.visitMethod =class Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature 2) nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ALOAD 1)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1))
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
+ (.visitVarInsn Opcodes/ALOAD 2)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1))
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ =apply3 (doto (.visitMethod =class Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature 3) nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ALOAD 1)
+ (.visitVarInsn Opcodes/ALOAD 2)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 2))
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
+ (.visitVarInsn Opcodes/ALOAD 3)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1))
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ =apply4 (doto (.visitMethod =class Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature 4) nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ALOAD 1)
+ (.visitVarInsn Opcodes/ALOAD 2)
+ (.visitVarInsn Opcodes/ALOAD 3)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 3))
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
+ (.visitVarInsn Opcodes/ALOAD 4)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1))
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ ]]
+ (&&/save-class! (second (string/split &&/function-class #"/"))
+ (.toByteArray (doto =class .visitEnd)))))
(def compile-LuxUtils-class
(|do [_ (return nil)
@@ -916,7 +961,8 @@
(do-template [<prim-type> <array-type> <new-name> <load-name> <load-op> <store-name> <store-op> <wrapper> <unwrapper>]
(do (defn <new-name> [compile ?values special-args]
(|do [:let [(&/$Cons ?length (&/$Nil)) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
_ (compile ?length)
:let [_ (doto *writer*
@@ -927,7 +973,8 @@
(defn <load-name> [compile ?values special-args]
(|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Nil))) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
_ (compile ?array)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST <array-type>)]
@@ -942,7 +989,8 @@
(defn <store-name> [compile ?values special-args]
(|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil)))) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
_ (compile ?array)
:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST <array-type>)]
@@ -981,7 +1029,8 @@
(defn ^:private compile-jvm-aaload [compile ?values special-args]
(|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Nil))) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
array-type (&host/->java-sig (&a/expr-type* ?array))
_ (compile ?array)
@@ -995,7 +1044,8 @@
(defn ^:private compile-jvm-aastore [compile ?values special-args]
(|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Cons ?elem (&/$Nil)))) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
array-type (&host/->java-sig (&a/expr-type* ?array))
_ (compile ?array)
@@ -1011,7 +1061,8 @@
(defn ^:private compile-jvm-arraylength [compile ?values special-args]
(|do [:let [(&/$Cons ?array (&/$Nil)) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
array-type (&host/->java-sig (&a/expr-type* ?array))
_ (compile ?array)
@@ -1023,7 +1074,7 @@
(return nil)))
(defn ^:private compile-jvm-null [compile ?values special-args]
- (|do [:let [(&/$Nil) ?values
+ (|do [:let [;; (&/$Nil) ?values
(&/$Nil) special-args]
^MethodVisitor *writer* &/get-writer
:let [_ (.visitInsn *writer* Opcodes/ACONST_NULL)]]
@@ -1031,7 +1082,8 @@
(defn ^:private compile-jvm-null? [compile ?values special-args]
(|do [:let [(&/$Cons ?object (&/$Nil)) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
_ (compile ?object)
:let [$then (new Label)
@@ -1048,7 +1100,8 @@
(do-template [<name> <op>]
(defn <name> [compile ?values special-args]
(|do [:let [(&/$Cons ?monitor (&/$Nil)) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
_ (compile ?monitor)
:let [_ (doto *writer*
@@ -1062,14 +1115,15 @@
(defn ^:private compile-jvm-throw [compile ?values special-args]
(|do [:let [(&/$Cons ?ex (&/$Nil)) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
_ (compile ?ex)
:let [_ (.visitInsn *writer* Opcodes/ATHROW)]]
(return nil)))
(defn ^:private compile-jvm-getstatic [compile ?values special-args]
- (|do [:let [(&/$Nil) ?values
+ (|do [:let [;; (&/$Nil) ?values
(&/$Cons ?class (&/$Cons ?field (&/$Cons ?output-type (&/$Nil)))) special-args]
^MethodVisitor *writer* &/get-writer
=output-type (&host/->java-sig ?output-type)
@@ -1181,7 +1235,8 @@
(defn ^:private compile-jvm-try [compile ?values special-args]
(|do [:let [(&/$Cons ?body (&/$Cons ?catch (&/$Nil))) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
:let [$from (new Label)
$to (new Label)
@@ -1197,8 +1252,9 @@
(.visitLabel $handler))]
_ (compile ?catch)
:let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
(.visitInsn Opcodes/SWAP)
- (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature))]
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)))]
:let [_ (.visitLabel *writer* $end)]]
(return nil)))
@@ -1215,7 +1271,8 @@
(defn ^:private compile-array-get [compile ?values special-args]
(|do [:let [(&/$Cons ?array (&/$Cons ?idx (&/$Nil))) ?values
- (&/$Nil) special-args]
+ ;; (&/$Nil) special-args
+ ]
^MethodVisitor *writer* &/get-writer
array-type (&host/->java-sig (&a/expr-type* ?array))
_ (compile ?array)
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 987928db6..f1f6ec35a 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -58,6 +58,37 @@
(-> (.visitInsn Opcodes/ACONST_NULL)
(->> (dotimes [_ amount])))))
+(defn ^:private ^MethodVisitor consecutive-args [^MethodVisitor method-writer start amount]
+ (doto method-writer
+ (-> (.visitVarInsn Opcodes/ALOAD (+ start idx))
+ (->> (dotimes [idx amount])))))
+
+(defn ^:private ^MethodVisitor consecutive-applys [^MethodVisitor method-writer start amount]
+ (case amount
+ 1 (doto method-writer
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
+ (consecutive-args start 1)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)))
+ 2 (doto method-writer
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
+ (consecutive-args start 2)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 2)))
+ 3 (doto method-writer
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
+ (consecutive-args start 3)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 3)))
+ 4 (doto method-writer
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
+ (consecutive-args start 4)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 4)))
+ ;; > 4
+ (doto method-writer
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
+ (consecutive-args start 4)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 4))
+ (consecutive-applys (+ start 4) (- amount 4)))
+ ))
+
(defn ^:private lambda-impl-signature [level]
(str "(" (&/fold str "" (&/|repeat level field-sig)) ")" lambda-return-sig))
@@ -74,7 +105,7 @@
(.visitCode)
;; Do normal object initialization
(.visitVarInsn Opcodes/ALOAD 0)
- (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" "<init>" "()V")
+ (.visitMethodInsn Opcodes/INVOKESPECIAL &&/function-class "<init>" "()V")
;; Add all of the closure variables
(-> (put-field! class-name (str &&/closure-prefix ?captured-id) field-sig #(.visitVarInsn % Opcodes/ALOAD (inc ?captured-id)))
(->> (|let [[?name [_ (&o/$captured _ ?captured-id ?source)]] ?name+?captured])
@@ -140,63 +171,78 @@
(.visitMaxs 0 0)
(.visitEnd))))
-(defn ^:private add-lambda-apply [class-writer class-name level env]
+(defn ^:private add-lambda-apply-n [class-writer +degree+ class-name level env]
(if (> level 1)
(let [$default (new Label)
$labels* (map (fn [_] (new Label)) (repeat (dec level) nil))
$labels (vec (concat $labels* (list $default)))
$end (new Label)
- method-writer (.visitMethod ^ClassWriter class-writer Opcodes/ACC_PUBLIC "apply" &&/apply-signature nil nil)]
+ method-writer (.visitMethod ^ClassWriter class-writer Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature +degree+) nil nil)
+ frame-locals (to-array (list class-name "java/lang/Object" "java/lang/Object"))
+ frame-stack (to-array [Opcodes/INTEGER])]
(doto method-writer
(.visitCode)
(get-num-args! class-name)
(.visitFrame Opcodes/F_NEW
- (int 2)
- (to-array (list class-name "java/lang/Object"))
- (int 1)
- (to-array [Opcodes/INTEGER]))
- (.visitTableSwitchInsn 0 (- level 2) $default (into-array $labels*))
+ (int (alength frame-locals)) frame-locals
+ (int (alength frame-stack)) frame-stack)
+ (.visitTableSwitchInsn 0 (- level 2) $default (into-array Label $labels*))
+ ;; (< stage (- level +degree+))
(-> (doto (.visitLabel $label)
(.visitFrame Opcodes/F_NEW
- (int 2)
- (to-array (list class-name "java/lang/Object"))
- (int 0)
- (to-array []))
+ (int (alength frame-locals)) frame-locals
+ (int (alength frame-stack)) frame-stack)
(.visitTypeInsn Opcodes/NEW class-name)
(.visitInsn Opcodes/DUP)
(-> (get-field! class-name (str &&/closure-prefix cidx))
(->> (dotimes [cidx (&/|length env)])))
(get-num-args! class-name)
- (inc-int! 1)
+ (inc-int! +degree+)
(-> (get-field! class-name (str &&/partial-prefix idx))
(->> (dotimes [idx stage])))
- (.visitVarInsn Opcodes/ALOAD 1)
- (fill-nulls! (dec (- (dec level) stage)))
+ (consecutive-args 1 +degree+)
+ (fill-nulls! (dec (- (- level +degree+) stage)))
(.visitMethodInsn Opcodes/INVOKESPECIAL class-name "<init>" (lambda-<init>-signature env level))
(.visitJumpInsn Opcodes/GOTO $end))
- (->> (cond (= stage (dec level))
+ (->> (cond (= stage (- level +degree+))
(doto method-writer
(.visitLabel $label)
(.visitFrame Opcodes/F_NEW
- (int 2)
- (to-array (list class-name "java/lang/Object"))
- (int 0)
- (to-array []))
+ (int (alength frame-locals)) frame-locals
+ (int (alength frame-stack)) frame-stack)
(.visitVarInsn Opcodes/ALOAD 0)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "reset" (reset-signature class-name))
(-> (get-field! class-name (str &&/partial-prefix idx))
(->> (dotimes [idx stage])))
- (.visitVarInsn Opcodes/ALOAD 1)
+ (consecutive-args 1 +degree+)
(.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (lambda-impl-signature level))
(.visitJumpInsn Opcodes/GOTO $end))
+ (> stage (- level +degree+))
+ (let [base 1
+ args-to-completion (- level stage)
+ args-left (- +degree+ args-to-completion)]
+ (doto method-writer
+ (.visitLabel $label)
+ (.visitFrame Opcodes/F_NEW
+ (int (alength frame-locals)) frame-locals
+ (int (alength frame-stack)) frame-stack)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "reset" (reset-signature class-name))
+ (-> (get-field! class-name (str &&/partial-prefix idx))
+ (->> (dotimes [idx stage])))
+ (consecutive-args base args-to-completion)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL class-name "impl" (lambda-impl-signature level))
+ (consecutive-applys (+ base args-to-completion) args-left)
+ (.visitJumpInsn Opcodes/GOTO $end)))
+
:else)
(doseq [[stage $label] (map vector (range level) $labels)])))
(.visitLabel $end)
(.visitInsn Opcodes/ARETURN)
(.visitMaxs 0 0)
(.visitEnd)))
- (doto (.visitMethod ^ClassWriter class-writer Opcodes/ACC_PUBLIC "apply" &&/apply-signature nil nil)
+ (doto (.visitMethod ^ClassWriter class-writer Opcodes/ACC_PUBLIC &&/apply-method (&&/apply-signature 1) nil nil)
(.visitCode)
(.visitVarInsn Opcodes/ALOAD 0)
(.visitVarInsn Opcodes/ALOAD 1)
@@ -214,7 +260,7 @@
class-name (str (&host/->module-class (&/|head ?scope)) "/" name)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit &host/bytecode-version lambda-flags
- class-name nil "java/lang/Object" (into-array [&&/function-class]))
+ class-name nil &&/function-class (into-array String []))
(-> (doto (.visitField datum-flags captured-name field-sig nil nil)
(.visitEnd))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
@@ -228,9 +274,15 @@
(->> (dotimes [idx (dec level)]))))
(->> (when (> level 1))))
(.visitSource file-name nil)
- (add-lambda-reset class-name level ?env)
- (add-lambda-apply class-name level ?env)
(add-lambda-<init> class-name level ?env)
+ (add-lambda-reset class-name level ?env)
+ (add-lambda-apply-n 1 class-name level ?env)
+ (-> (add-lambda-apply-n 2 class-name level ?env)
+ (->> (when (>= level 2))))
+ (-> (add-lambda-apply-n 3 class-name level ?env)
+ (->> (when (>= level 3))))
+ (-> (add-lambda-apply-n 4 class-name level ?env)
+ (->> (when (>= level 4))))
)]
_ (add-lambda-impl =class class-name compile level ?body)
:let [_ (.visitEnd =class)]
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index c45452c7a..e1af775f7 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -111,11 +111,12 @@
(defn compile-apply [compile ?fn ?args]
(|do [^MethodVisitor *writer* &/get-writer
_ (compile ?fn)
- _ (&/map% (fn [?arg]
- (|do [=arg (compile ?arg)
- :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature)]]
- (return =arg)))
- ?args)]
+ _ (&/map% (fn [?args]
+ (|do [:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST &&/function-class)]
+ _ (&/map% compile ?args)
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature (&/|length ?args)))]]
+ (return nil)))
+ (&/|partition 4 ?args))]
(return nil)))
(defn ^:private compile-def-type [compile ?body]
@@ -163,7 +164,7 @@
current-class (str (&host/->module-class module-name) "/" def-name)
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit &host/bytecode-version class-flags
- current-class nil "java/lang/Object" (into-array [&&/function-class]))
+ current-class nil "java/lang/Object" (into-array String []))
(-> (.visitField field-flags &/name-field "Ljava/lang/String;" nil ?name)
(doto (.visitEnd)))
(-> (.visitField field-flags &/type-field datum-sig nil nil)
@@ -235,9 +236,6 @@
:let [_ (println 'DEF (str module-name ";" ?name))]]
(return nil))))))
-(defn compile-ann [compile ?value-ex ?type-ex ?value-type]
- (compile ?value-ex))
-
(defn compile-program [compile ?body]
(|do [module-name &/get-module-name
^ClassWriter *writer* &/get-writer]
@@ -303,8 +301,9 @@
]
_ (compile ?body)
:let [_ (doto main-writer
+ (.visitTypeInsn Opcodes/CHECKCAST &&/function-class)
(.visitInsn Opcodes/ACONST_NULL)
- (.visitMethodInsn Opcodes/INVOKEINTERFACE &&/function-class "apply" &&/apply-signature))]
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL &&/function-class &&/apply-method (&&/apply-signature 1)))]
:let [_ (doto main-writer
(.visitInsn Opcodes/POP)
(.visitInsn Opcodes/RETURN)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 01:42:20 +0000