diff --git a/cl-box.lisp b/cl-box.lisp new file mode 100644 index 0000000..ba96d58 --- /dev/null +++ b/cl-box.lisp @@ -0,0 +1,62 @@ +;;Thing for atomising operations + +(in-package :cl-box) + +(flan-utils:enable-all-readers) + +(defstruct %box + value + lock) + +(defmacro %atomic (box &body re) + `(bt:with-lock-held ((%box-lock ,box)) + ,@re)) +[ +(defun make-box (&optional value) + (let ((b (make-%box))) + (setf (%box-value b) value) + (setf (%box-lock b) (bt:make-lock)) + b)) + +(defun make (&optional value) + (make-box value)) + +(defun -> (box val) + (%atomic box + (setf (%box-value box) val))) + +(defun <- (box) + (%atomic box + (%box-value box))) + +(defun <-! (box) + (%box-value box)) + +(defun ->! (box val) + (setf (%box-value box) val)) + +(defun box-lock (box) + (%box-lock box)) + +(defsetf <- ->) +(defsetf @ ->) + +(defun @ (box) + (<- box)) + +(defmacro --> (box &body things) + (let ((name (gensym))) + `(let ((,name ,box)) + (bt:with-lock-held ((box-lock ,name)) + (->! ,name (progn ,@things)) + (<-! ,name))))) + +(defmacro <-- (box &body things) + (let ((name (gensym))) + `(let ((,name ,box)) + (bt:with-lock-held ((box-lock ,name)) + (progn ,@things) + (<-! ,name))))) + + +] diff --git a/cl-channel.asd b/cl-channel.asd index 35141d9..8d1740b 100644 --- a/cl-channel.asd +++ b/cl-channel.asd @@ -10,4 +10,5 @@ :bt-semaphore ) :components ((:file "package") (:file "cl-channel") + (:file "cl-box") (:file "cl-dispatcher"))) diff --git a/package.lisp b/package.lisp index e21a3cb..d94bdf7 100644 --- a/package.lisp +++ b/package.lisp @@ -7,3 +7,7 @@ (defpackage #:cl-dispatcher (:use #:cl) (:nicknames :dispatcher)) + +(defpackage #:cl-box + (:use #:cl) + (:nicknames :box))