aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/base.clj8
-rw-r--r--src/lux/compiler/base.clj2
-rw-r--r--src/lux/compiler/host.clj9
-rw-r--r--src/lux/compiler/lambda.clj42
-rw-r--r--src/lux/compiler/lux.clj38
5 files changed, 72 insertions, 27 deletions
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 622b5b1fc..89f9bb36a 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -266,9 +266,11 @@
;; else
(mapv transform-pattern pattern))
- (seq? pattern) [(-> (ns-resolve *ns* (first pattern))
- meta
- ::idx)
+ (seq? pattern) [(if-let [tag-var (ns-resolve *ns* (first pattern))]
+ (-> tag-var
+ meta
+ ::idx)
+ (assert false (str "Unknown var: " (first pattern))))
'_
(transform-pattern (vec (rest pattern)))]
:else pattern
diff --git a/src/lux/compiler/base.clj b/src/lux/compiler/base.clj
index 1c5301a68..1cc310564 100644
--- a/src/lux/compiler/base.clj
+++ b/src/lux/compiler/base.clj
@@ -39,6 +39,8 @@
(defn ^String apply-signature [n]
(str "(" (apply str (repeat n "Ljava/lang/Object;")) ")Ljava/lang/Object;"))
(def num-apply-variants 8)
+(def arity-field "_arity_")
+(def partials-field "_partials_")
(def exported-separator " ")
(def def-separator "\t")
diff --git a/src/lux/compiler/host.clj b/src/lux/compiler/host.clj
index 0726e1ecf..da0d6f788 100644
--- a/src/lux/compiler/host.clj
+++ b/src/lux/compiler/host.clj
@@ -528,11 +528,16 @@
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)
+ &&/function-class nil super-class (into-array String []))
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL) &&/partials-field "I" nil nil)
+ (doto (.visitEnd))))
+ =init-method (doto (.visitMethod =class Opcodes/ACC_PUBLIC init-method "(I)V" nil nil)
(.visitCode)
(.visitVarInsn Opcodes/ALOAD 0)
(.visitMethodInsn Opcodes/INVOKESPECIAL super-class init-method "()V")
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ILOAD 1)
+ (.visitFieldInsn Opcodes/PUTFIELD &&/function-class &&/partials-field "I")
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
(.visitEnd))
diff --git a/src/lux/compiler/lambda.clj b/src/lux/compiler/lambda.clj
index 7ef4e439d..2bc0c29eb 100644
--- a/src/lux/compiler/lambda.clj
+++ b/src/lux/compiler/lambda.clj
@@ -28,14 +28,14 @@
(def ^:private field-sig (&host-generics/->type-signature "java.lang.Object"))
(def ^:private lambda-return-sig (&host-generics/->type-signature "java.lang.Object"))
(def ^:private <init>-return "V")
-(def ^:private num-args-field "_num_args_")
+
(defn ^:private ^String reset-signature [function-class]
(str "()" (&host-generics/->type-signature function-class)))
-(defn ^:private ^MethodVisitor get-num-args! [^MethodVisitor method-writer class-name]
+(defn ^:private ^MethodVisitor get-num-partials! [^MethodVisitor method-writer]
(doto method-writer
(.visitVarInsn Opcodes/ALOAD 0)
- (.visitFieldInsn Opcodes/GETFIELD class-name num-args-field "I")))
+ (.visitFieldInsn Opcodes/GETFIELD &&/function-class &&/partials-field "I")))
(defn ^:private ^MethodVisitor inc-int! [^MethodVisitor method-writer by]
(doto method-writer
@@ -82,23 +82,30 @@
(str "(" (&/fold str "" (&/|repeat (&/|length env) field-sig)) ")"
<init>-return)))
+(defn ^:private init-function [method-writer arity closure-length]
+ (if (= 1 arity)
+ (doto method-writer
+ (.visitLdcInsn (int 0))
+ (.visitMethodInsn Opcodes/INVOKESPECIAL &&/function-class "<init>" "(I)V"))
+ (doto method-writer
+ (.visitVarInsn Opcodes/ILOAD (inc closure-length))
+ (.visitMethodInsn Opcodes/INVOKESPECIAL &&/function-class "<init>" "(I)V"))))
+
(defn ^:private add-lambda-<init> [class class-name arity env]
(let [closure-length (&/|length env)]
(doto (.visitMethod ^ClassWriter class Opcodes/ACC_PUBLIC "<init>" (lambda-<init>-signature env arity) nil nil)
(.visitCode)
;; Do normal object initialization
(.visitVarInsn Opcodes/ALOAD 0)
- (.visitMethodInsn Opcodes/INVOKESPECIAL &&/function-class "<init>" "()V")
+ (init-function arity closure-length)
;; 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])
(doseq [?name+?captured (&/->seq env)])))
- (-> (doto (put-field! class-name num-args-field "I" #(.visitVarInsn % Opcodes/ILOAD (inc closure-length))) ;; Add the counter
- ;; Add all the partial arguments
- (-> (put-field! class-name (str &&/partial-prefix idx*) field-sig #(.visitVarInsn % Opcodes/ALOAD partial-register))
- (->> (|let [partial-register (+ (inc idx*) (inc closure-length))])
- (dotimes [idx* (dec arity)]))))
- (->> (when (> arity 1))))
+ ;; Add all the partial arguments
+ (-> (put-field! class-name (str &&/partial-prefix idx*) field-sig #(.visitVarInsn % Opcodes/ALOAD partial-register))
+ (->> (|let [partial-register (+ (inc idx*) (inc closure-length))])
+ (dotimes [idx* (dec arity)])))
;; Finish
(.visitInsn Opcodes/RETURN)
(.visitMaxs 0 0)
@@ -166,7 +173,7 @@
frame-stack (to-array [Opcodes/INTEGER])]
(do (doto method-writer
(.visitCode)
- (get-num-args! class-name)
+ get-num-partials!
(.visitFrame Opcodes/F_NEW
(int (alength frame-locals)) frame-locals
(int (alength frame-stack)) frame-stack)
@@ -180,7 +187,7 @@
(.visitInsn Opcodes/DUP)
(-> (get-field! class-name (str &&/closure-prefix cidx))
(->> (dotimes [cidx (&/|length env)])))
- (get-num-args! class-name)
+ get-num-partials!
(inc-int! +degree+)
(-> (get-field! class-name (str &&/partial-prefix idx))
(->> (dotimes [idx stage])))
@@ -249,18 +256,17 @@
=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit &host/bytecode-version lambda-flags
class-name nil &&/function-class (into-array String []))
+ (-> (.visitField (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC Opcodes/ACC_FINAL) &&/arity-field "I" nil (int arity))
+ (doto (.visitEnd)))
(-> (doto (.visitField datum-flags captured-name field-sig nil nil)
(.visitEnd))
(->> (let [captured-name (str &&/closure-prefix ?captured-id)])
(|case ?name+?captured
[?name [_ (&o/$captured _ ?captured-id ?source)]])
(doseq [?name+?captured (&/->seq ?env)])))
- (-> (doto (-> (.visitField datum-flags num-args-field "I" nil nil)
- (doto (.visitEnd)))
- (-> (.visitField datum-flags (str &&/partial-prefix idx) field-sig nil nil)
- (doto (.visitEnd))
- (->> (dotimes [idx (dec arity)]))))
- (->> (when (> arity 1))))
+ (-> (.visitField datum-flags (str &&/partial-prefix idx) field-sig nil nil)
+ (doto (.visitEnd))
+ (->> (dotimes [idx (dec arity)])))
(.visitSource file-name nil)
(add-lambda-<init> class-name arity ?env)
(add-lambda-reset class-name arity ?env)
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 0facb74c1..f2c67bfae 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -14,7 +14,8 @@
[lexer :as &lexer]
[parser :as &parser]
[analyser :as &analyser]
- [host :as &host])
+ [host :as &host]
+ [optimizer :as &o])
[lux.host.generics :as &host-generics]
(lux.analyser [base :as &a]
[module :as &a-module]
@@ -25,7 +26,8 @@
(:import (org.objectweb.asm Opcodes
Label
ClassWriter
- MethodVisitor)))
+ MethodVisitor)
+ java.lang.reflect.Field))
;; [Exports]
(defn compile-bool [compile ?value]
@@ -108,9 +110,8 @@
:let [_ (.visitFieldInsn *writer* Opcodes/GETSTATIC (str (&host/->module-class ?owner-class) "/" (&host/def-name ?name)) &/value-field "Ljava/lang/Object;")]]
(return nil)))
-(defn compile-apply [compile ?fn ?args]
+(defn ^:private compile-apply* [compile ?args]
(|do [^MethodVisitor *writer* &/get-writer
- _ (compile ?fn)
_ (&/map% (fn [?args]
(|do [:let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST &&/function-class)]
_ (&/map% compile ?args)
@@ -119,6 +120,35 @@
(&/|partition &&/num-apply-variants ?args))]
(return nil)))
+(defn compile-apply [compile ?fn ?args]
+ (|case ?fn
+ [_ (&o/$var (&/$Global ?module ?name))]
+ (|do [[_ [_ _ func-obj]] (&a-module/find-def ?module ?name)
+ class-loader &/loader
+ :let [func-class (class func-obj)
+ func-arity (.get ^Field (.getDeclaredField func-class &&/arity-field) nil)
+ func-partials (.get ^Field (.getDeclaredField (Class/forName "lux.Function" true class-loader) &&/partials-field) func-obj)
+ num-args (&/|length ?args)
+ func-class-name (->> func-class .getName &host-generics/->bytecode-class-name)]]
+ (if (and (= 0 func-partials)
+ (>= num-args func-arity))
+ (|do [_ (compile ?fn)
+ ^MethodVisitor *writer* &/get-writer
+ :let [_ (.visitTypeInsn *writer* Opcodes/CHECKCAST func-class-name)]
+ _ (&/map% compile (&/|take func-arity ?args))
+ :let [_ (.visitMethodInsn *writer* Opcodes/INVOKEVIRTUAL func-class-name (if (= 1 func-arity) &&/apply-method "impl") (&&/apply-signature func-arity))]
+ _ (if (= num-args func-arity)
+ (return nil)
+ (compile-apply* compile (&/|drop func-arity ?args)))]
+ (return nil))
+ (|do [_ (compile ?fn)]
+ (compile-apply* compile ?args))))
+
+ _
+ (|do [_ (compile ?fn)]
+ (compile-apply* compile ?args))
+ ))
+
(defn ^:private compile-def-type [compile ?body]
(|do [:let [?def-type (|case ?body
[[?def-type ?def-cursor] (&a/$ann ?def-value ?type-expr ?def-value-type)]
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 20:00:18 +0000