new file mode 100644

@@ -0,0 +1,2 @@

+*~

+*.fasl

new file mode 100644

@@ -0,0 +1,14 @@

+(in-package :fwoar.event-loop)

+

+(defclass chanl-event-loop ()

+  ((%queue :initarg :queue :reader queue :initform (make-instance 'chanl:bounded-channel :size *task-depth*))

+   (%finish-callbaack :reader finish-cb :writer register-finish-cb)))

+

+(defmethod tick ((event-loop chanl-event-loop))

+  (prog1 event-loop

+    (let ((task (chanl:recv (queue event-loop))))

+      (when task

+        (funcall task)))))

+

+(defmethod enqueue ((queue chanl:channel) fn)

+  (chanl:send queue fn))

new file mode 100644

@@ -0,0 +1,43 @@

+(in-package :fwoar.event-loop)

+

+(defgeneric run (task event-loop)

+  (:method :around (task event-loop)

+    (bb:with-promise (resolve reject)

+      (enqueue (queue event-loop)

+               (lambda ()

+                 (handler-case (resolve (call-next-method))

+                   (serious-condition (c)

+                     (reject c))))))))

+

+

+(defgeneric enqueue (queue fn))

+

+(defgeneric prepare-loop (event-loop)

+  (:method (event-loop)

+    (declare (ignore event-loop))))

+

+(defgeneric queue (event-loop))

+

+(defgeneric register-finish-cb (cb event-loop))

+

+(defgeneric tick (event-loop))

+

+(defparameter *task-depth* 10)

+

+(defun run-loop (event-loop)

+  (let ((finished nil))

+    (register-finish-cb (lambda ()

+                          (setf finished t))

+                        event-loop)

+    (prepare-loop event-loop)

+    (loop

+      until finished

+      do

+         (tick event-loop))))

+

+(defun wait-for-promise (promise)

+  (let* ((result-queue (make-instance 'chanl:bounded-channel)))

+    (bb:alet ((v promise))

+      (chanl:send result-queue v))

+    (loop

+      (return (chanl:recv result-queue)))))

new file mode 100644

@@ -0,0 +1,19 @@

+;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Package: ASDF-USER -*-

+(in-package :asdf-user)

+

+(defsystem :fwoar-event-loop 

+  :description ""

+  :author "Ed L <edward@elangley.org>"

+  :license "MIT"

+  :depends-on (#:alexandria

+               #:blackbird

+               #:chanl

+               #:serapeum

+               #:uiop

+               (:feature :sbcl

+                         (:require :sb-concurrency)))

+  :serial t

+  :components ((:file "package")

+               (:file "event-loop")

+               (:file "chanl-event-loop")

+               (:file "sbcl-concurrency-event-loop" :if-feature :sbcl)))

new file mode 100644

@@ -0,0 +1,9 @@

+(defpackage :fwoar.event-loop

+  (:use :cl )

+  (:export

+   #:run

+   #:tick

+   #:run-loop

+   #:wait-for-promise

+   #:prepare-loop

+   #:register-finish-cb))

new file mode 100644

@@ -0,0 +1,14 @@

+(in-package :fwoar.event-loop)

+

+(defclass sb-concurrency-event-loop ()

+  ((%queue :initarg :queue :reader queue :initform (sb-concurrency:make-mailbox))

+   (%finish-callbaack :reader finish-cb :writer register-finish-cb)))

+

+(defmethod enqueue ((queue sb-concurrency:mailbox) fn)

+  (sb-concurrency:send-message queue fn))

+

+(defmethod tick ((event-loop sb-concurrency-event-loop))

+  (prog1 event-loop

+    (let ((task (sb-concurrency:receive-message (queue event-loop) :timeout 0.001)))

+      (when task

+        (funcall task)))))