aboutsummaryrefslogtreecommitdiff
path: root/luxc
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--luxc/src/lux/analyser/proc/common.clj31
-rw-r--r--luxc/src/lux/compiler/jvm.clj3
-rw-r--r--luxc/src/lux/compiler/jvm/proc/common.clj39
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj106
-rw-r--r--luxc/src/lux/type.clj5
5 files changed, 182 insertions, 2 deletions
diff --git a/luxc/src/lux/analyser/proc/common.clj b/luxc/src/lux/analyser/proc/common.clj
index 51e0f3528..7703aa8a6 100644
--- a/luxc/src/lux/analyser/proc/common.clj
+++ b/luxc/src/lux/analyser/proc/common.clj
@@ -436,6 +436,30 @@
(return (&/|list (&&/|meta exo-type _cursor
(&&/$proc (&/T ["atom" "compare-and-swap"]) (&/|list =atom =old =new) (&/|list)))))))))
+(defn ^:private analyse-process-concurrency-level [analyse exo-type ?values]
+ (|do [:let [(&/$Nil) ?values]
+ _ (&type/check exo-type &type/Nat)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["process" "concurrency-level"]) (&/|list) (&/|list)))))))
+
+(defn ^:private analyse-process-future [analyse exo-type ?values]
+ (|do [:let [(&/$Cons ?procedure (&/$Nil)) ?values]
+ =procedure (&&/analyse-1 analyse (&/$AppT &type/IO &type/Top) ?procedure)
+ _ (&type/check exo-type &/$UnitT)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["process" "future"]) (&/|list =procedure) (&/|list)))))))
+
+(defn ^:private analyse-process-schedule [analyse exo-type ?values]
+ (|do [:let [(&/$Cons ?milliseconds (&/$Cons ?procedure (&/$Nil))) ?values]
+ =milliseconds (&&/analyse-1 analyse &type/Nat ?milliseconds)
+ =procedure (&&/analyse-1 analyse (&/$AppT &type/IO &type/Top) ?procedure)
+ _ (&type/check exo-type &/$UnitT)
+ _cursor &/cursor]
+ (return (&/|list (&&/|meta exo-type _cursor
+ (&&/$proc (&/T ["process" "schedule"]) (&/|list =milliseconds =procedure) (&/|list)))))))
+
(defn analyse-proc [analyse exo-type category proc ?values]
(case category
"lux"
@@ -595,6 +619,13 @@
"get" (analyse-atom-get analyse exo-type ?values)
"compare-and-swap" (analyse-atom-compare-and-swap analyse exo-type ?values)
)
+
+ "process"
+ (case proc
+ "concurrency-level" (analyse-process-concurrency-level analyse exo-type ?values)
+ "future" (analyse-process-future analyse exo-type ?values)
+ "schedule" (analyse-process-schedule analyse exo-type ?values)
+ )
;; else
(&/fail-with-loc (str "[Analyser Error] Unknown host procedure: " [category proc]))))
diff --git a/luxc/src/lux/compiler/jvm.clj b/luxc/src/lux/compiler/jvm.clj
index 5cc3c1f79..7fd764e56 100644
--- a/luxc/src/lux/compiler/jvm.clj
+++ b/luxc/src/lux/compiler/jvm.clj
@@ -192,7 +192,8 @@
(.visitSource file-name nil))]
_ (if (= "lux" name)
(|do [_ &&rt/compile-Function-class
- _ &&rt/compile-LuxRT-class]
+ _ &&rt/compile-LuxRT-class
+ _ &&rt/compile-LuxRunnable-class]
(return nil))
(return nil))]
(fn [state]
diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj
index dd59a41f0..0afcdc9e0 100644
--- a/luxc/src/lux/compiler/jvm/proc/common.clj
+++ b/luxc/src/lux/compiler/jvm/proc/common.clj
@@ -826,6 +826,38 @@
&&/wrap-boolean)]]
(return nil)))
+(defn ^:private compile-process-concurrency-level [compile ?values special-args]
+ (|do [:let [(&/$Nil) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ :let [_ (doto *writer*
+ (.visitFieldInsn Opcodes/GETSTATIC "lux/LuxRT" "concurrency_level" "I")
+ (.visitInsn Opcodes/I2L)
+ &&/wrap-long)]]
+ (return nil)))
+
+(defn ^:private compile-process-future [compile ?values special-args]
+ (|do [:let [(&/$Cons ?procedure (&/$Nil)) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?procedure)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST "lux/Function"))]
+ :let [_ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "future" "(Llux/Function;)Ljava/lang/Object;"))]]
+ (return nil)))
+
+(defn ^:private compile-process-schedule [compile ?values special-args]
+ (|do [:let [(&/$Cons ?milliseconds (&/$Cons ?procedure (&/$Nil))) ?values]
+ ^MethodVisitor *writer* &/get-writer
+ _ (compile ?milliseconds)
+ :let [_ (doto *writer*
+ &&/unwrap-long)]
+ _ (compile ?procedure)
+ :let [_ (doto *writer*
+ (.visitTypeInsn Opcodes/CHECKCAST "lux/Function"))]
+ :let [_ (doto *writer*
+ (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "schedule" "(JLlux/Function;)Ljava/lang/Object;"))]]
+ (return nil)))
+
(defn compile-proc [compile category proc ?values special-args]
(case category
"lux"
@@ -985,6 +1017,13 @@
"get" (compile-atom-get compile ?values special-args)
"compare-and-swap" (compile-atom-compare-and-swap compile ?values special-args)
)
+
+ "process"
+ (case proc
+ "concurrency-level" (compile-process-concurrency-level compile ?values special-args)
+ "future" (compile-process-future compile ?values special-args)
+ "schedule" (compile-process-schedule compile ?values special-args)
+ )
;; else
(&/fail-with-loc (str "[Compiler Error] Unknown procedure: " [category proc]))))
diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj
index 7f193a1cd..0f86325f2 100644
--- a/luxc/src/lux/compiler/jvm/rt.clj
+++ b/luxc/src/lux/compiler/jvm/rt.clj
@@ -25,6 +25,7 @@
(def init-method "<init>")
;; [Resources]
+;; Functions
(def compile-Function-class
(|do [_ (return nil)
:let [super-class "java/lang/Object"
@@ -65,6 +66,37 @@
(&&/save-class! (second (string/split &&/function-class #"/"))
(.toByteArray (doto =class .visitEnd)))))
+;; Custom Runnable
+(def compile-LuxRunnable-class
+ (|do [_ (return nil)
+ :let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
+ (.visit &host/bytecode-version (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
+ "lux/LuxRunnable" nil "java/lang/Object" (into-array String ["java/lang/Runnable"])))
+ _ (doto (.visitField =class Opcodes/ACC_PUBLIC "procedure" "Llux/Function;" nil nil)
+ (.visitEnd))
+ _ (doto (.visitMethod =class Opcodes/ACC_PUBLIC init-method "(Llux/Function;)V" nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Object" init-method "()V")
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitVarInsn Opcodes/ALOAD 1)
+ (.visitFieldInsn Opcodes/PUTFIELD "lux/LuxRunnable" "procedure" "Llux/Function;")
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ _ (doto (.visitMethod =class Opcodes/ACC_PUBLIC "run" "()V" nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitFieldInsn Opcodes/GETFIELD "lux/LuxRunnable" "procedure" "Llux/Function;")
+ (.visitInsn Opcodes/ACONST_NULL)
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "lux/Function" &&/apply-method (&&/apply-signature 1))
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))]]
+ (&&/save-class! "LuxRunnable"
+ (.toByteArray (doto =class .visitEnd)))))
+
+;; Runtime infrastructure
(defn ^:private compile-LuxRT-adt-methods [^ClassWriter =class]
(|let [_ (let [$begin (new Label)
$not-rec (new Label)]
@@ -1281,6 +1313,77 @@
(.visitEnd)))
nil))
+(defn ^:private compile-LuxRT-process-methods [^ClassWriter =class]
+ (do (doto (.visitField =class
+ (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC)
+ "concurrency_level" "I" nil nil)
+ (.visitEnd))
+ (doto (.visitField =class
+ (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC)
+ "executor" "Ljava/util/concurrent/ScheduledThreadPoolExecutor;" nil nil)
+ (.visitEnd))
+ (doto (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil)
+ (.visitCode)
+ ;; concurrency_level
+ (.visitMethodInsn Opcodes/INVOKESTATIC "java/lang/Runtime" "getRuntime" "()Ljava/lang/Runtime;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Runtime" "availableProcessors" "()I")
+ (.visitFieldInsn Opcodes/PUTSTATIC "lux/LuxRT" "concurrency_level" "I")
+ ;; executor
+ (.visitTypeInsn Opcodes/NEW "java/util/concurrent/ScheduledThreadPoolExecutor")
+ (.visitInsn Opcodes/DUP)
+ (.visitFieldInsn Opcodes/GETSTATIC "lux/LuxRT" "concurrency_level" "I")
+ (.visitMethodInsn Opcodes/INVOKESPECIAL "java/util/concurrent/ScheduledThreadPoolExecutor" "<init>" "(I)V")
+ (.visitFieldInsn Opcodes/PUTSTATIC "lux/LuxRT" "executor" "Ljava/util/concurrent/ScheduledThreadPoolExecutor;")
+ ;; DONE
+ (.visitInsn Opcodes/RETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "future" "(Llux/Function;)Ljava/lang/Object;" nil nil)
+ (.visitCode)
+ (.visitTypeInsn Opcodes/NEW "java/lang/Thread")
+ (.visitInsn Opcodes/DUP)
+ (.visitTypeInsn Opcodes/NEW "lux/LuxRunnable")
+ (.visitInsn Opcodes/DUP)
+ (.visitVarInsn Opcodes/ALOAD 0)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL "lux/LuxRunnable" "<init>" "(Llux/Function;)V")
+ (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/Thread" "<init>" "(Ljava/lang/Runnable;)V")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Thread" "start" "()V")
+ (.visitLdcInsn &/unit-tag)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd))
+ (let [$immediately (new Label)]
+ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "schedule" "(JLlux/Function;)Ljava/lang/Object;" nil nil)
+ (.visitCode)
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitLdcInsn (long 0))
+ (.visitInsn Opcodes/LCMP)
+ (.visitJumpInsn Opcodes/IFEQ $immediately)
+ ;; Schedule for later
+ (.visitFieldInsn Opcodes/GETSTATIC "lux/LuxRT" "executor" "Ljava/util/concurrent/ScheduledThreadPoolExecutor;")
+ (.visitTypeInsn Opcodes/NEW "lux/LuxRunnable")
+ (.visitInsn Opcodes/DUP)
+ (.visitVarInsn Opcodes/ALOAD 2)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL "lux/LuxRunnable" "<init>" "(Llux/Function;)V")
+ (.visitVarInsn Opcodes/LLOAD 0)
+ (.visitFieldInsn Opcodes/GETSTATIC "java/util/concurrent/TimeUnit" "MILLISECONDS" "Ljava/util/concurrent/TimeUnit;")
+ (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/util/concurrent/ScheduledThreadPoolExecutor" "schedule" "(Ljava/lang/Runnable;JLjava/util/concurrent/TimeUnit;)Ljava/util/concurrent/ScheduledFuture;")
+ (.visitLdcInsn &/unit-tag)
+ (.visitInsn Opcodes/ARETURN)
+ ;; Run immediately
+ (.visitLabel $immediately)
+ (.visitFieldInsn Opcodes/GETSTATIC "lux/LuxRT" "executor" "Ljava/util/concurrent/ScheduledThreadPoolExecutor;")
+ (.visitTypeInsn Opcodes/NEW "lux/LuxRunnable")
+ (.visitInsn Opcodes/DUP)
+ (.visitVarInsn Opcodes/ALOAD 2)
+ (.visitMethodInsn Opcodes/INVOKESPECIAL "lux/LuxRunnable" "<init>" "(Llux/Function;)V")
+ (.visitMethodInsn Opcodes/INVOKEINTERFACE "java/util/concurrent/Executor" "execute" "(Ljava/lang/Runnable;)V")
+ (.visitLdcInsn &/unit-tag)
+ (.visitInsn Opcodes/ARETURN)
+ (.visitMaxs 0 0)
+ (.visitEnd)))
+ nil))
+
(def compile-LuxRT-class
(|do [_ (return nil)
:let [full-name &&/lux-utils-class
@@ -1344,6 +1447,7 @@
(compile-LuxRT-int-methods)
(compile-LuxRT-deg-methods)
(compile-LuxRT-real-methods)
- (compile-LuxRT-text-methods))]]
+ (compile-LuxRT-text-methods)
+ (compile-LuxRT-process-methods))]]
(&&/save-class! (second (string/split &&/lux-utils-class #"/"))
(.toByteArray (doto =class .visitEnd)))))
diff --git a/luxc/src/lux/type.clj b/luxc/src/lux/type.clj
index 94c4e2ae7..854472c94 100644
--- a/luxc/src/lux/type.clj
+++ b/luxc/src/lux/type.clj
@@ -45,6 +45,11 @@
(&/$UnivQ empty-env
(&/$BoundT 1))))
+(def Top
+ (&/$NamedT (&/T ["lux" "Top"])
+ (&/$ExQ empty-env
+ (&/$BoundT 1))))
+
(def IO
(&/$NamedT (&/T ["lux/codata" "IO"])
(&/$UnivQ empty-env
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 19:35:31 +0000