Improved async

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
+  `(let ((current-async-info (make-async-info)))
-    #'(lambda ()
+     (setf (async-info-handlers current-async-info) nil)
-	,@form)))
+     (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)
@@ -444,8 +468,6 @@
   '(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 ))
 ;  "Map over list in parallel"