From 086319dff08f69d88806e46d2db1fc4426980219 Mon Sep 17 00:00:00 2001 From: Ringo Wantanabe Date: Sun, 17 Feb 2019 00:08:17 +0000 Subject: [PATCH] Improved async --- utils.lisp | 34 ++++++++++++++++++++++++++++------ 1 file changed, 28 insertions(+), 6 deletions(-) diff --git a/utils.lisp b/utils.lisp index aa17f4f..ea4293b 100644 --- a/utils.lisp +++ b/utils.lisp @@ -364,13 +364,37 @@ (defun many-eql (&rest items) (many-equals items :test #'eql)) +(defstruct async-info + thread + handlers + lock) + +(defmacro push-handler (name lam) + `(bt:with-lock-held + ((async-info-lock current-async-info)) + (push (cons ,name ,lam) + (async-info-handlers current-async-info)))) + (defmacro async (&rest form) - `(bt:make-thread - #'(lambda () - ,@form))) + `(let ((current-async-info (make-async-info))) + (setf (async-info-handlers current-async-info) nil) + (setf (async-info-lock current-async-info) (bt:make-lock)) + (setf (async-info-thread current-async-info) + (bt:make-thread + #'(lambda () + ,@form))) + current-async-info)) + +(defun async-info-handler (async name &key (test 'eql)) + (bt:with-lock-held ((async-info-lock async)) + (let ((as (assoc name (async-info-handlers async) :test test ))) + (and as + (cdr as))))) (defun wait (handle) - (bt:join-thread handle)) + (if (async-info-p handle) + (wait (async-info-thread handle)) + (bt:join-thread handle))) (defun val (v) v) @@ -443,8 +467,6 @@ "Turn off reader macros" '(eval-when (:compile-toplevel :load-toplevel :execute) (setq *readtable* (pop *old-readtables*)))) - - ; ((defun map-parallel (func seq &key (map #'mapcar) (split 0.25) (debug nil)) ;;; TODO: make this work lol ; (flet ((dprint (x) (when debug (format t "~S~%" x)) x ))