You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
55 lines
1.3 KiB
55 lines
1.3 KiB
|
|
|
|
(in-package :cl-dispatcher)
|
|
|
|
(defstruct %dispatcher
|
|
hooks
|
|
lock)
|
|
|
|
(defmacro %atomic (disp &body thing)
|
|
`(bt:with-lock-held ((%dispatcher-lock disp))
|
|
,@thing))
|
|
|
|
(mapc 'export (list
|
|
|
|
(defun make-dispatcher ()
|
|
(let ((d (make-%dispatcher)))
|
|
(setf (%dispatcher-hooks d ) nil)
|
|
(setf (%dispatcher-lock d) (bt:make-lock))
|
|
d))
|
|
|
|
(defmacro make ()
|
|
`(make-dispatcher))
|
|
|
|
(defun hook (disp name lam)
|
|
(%atomic disp
|
|
(if (assoc name (%dispatcher-hooks disp))
|
|
(push lam (cdr (assoc name (%dispatcher-hooks disp))))
|
|
(push (cons name (list lam)) (%dispatcher-hooks disp)))))
|
|
|
|
(defun sig (disp name &optional (x nil))
|
|
(%atomic disp
|
|
(let ((hooks (assoc name (%dispatcher-hooks disp))))
|
|
(if (null hooks)
|
|
nil
|
|
(mapcar #'(lambda (y) (bt:make-thread (lambda () (funcall y x)))) (cdr hooks))))))
|
|
|
|
(defun sig-serial (disp name &optional (x nil))
|
|
(%atomic disp
|
|
(let ((hooks (assoc name (%dispatcher-hooks disp))))
|
|
(if (null hooks)
|
|
nil
|
|
(mapc #'(lambda (y) (funcall y x)) (cdr hooks))))))
|
|
|
|
))
|
|
|
|
(defun test ()
|
|
(let ((d (make-dispatcher)))
|
|
(hook d "test" (lambda (x) (print x)))
|
|
(hook d "test" (lambda (x) (print (cons "!!" x))))
|
|
(hook d "test" (lambda (x) (print "HELLO")))
|
|
|
|
(sig-serial d "test" 'uwu)
|
|
(print 'signalled)))
|
|
|