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.
63 lines
1.0 KiB
63 lines
1.0 KiB
5 years ago
|
;;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)))))
|
||
|
|
|
||
|
|
|
||
|
|
]
|