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.

74 lines
1.3 KiB

;;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))
(flet ((-> (thing) (->! ,name thing))
(<- () (<-! ,name)))
(->! ,name (progn ,@things)))
(<-! ,name)))))
(defmacro <-- (box &body things)
(let ((name (gensym)))
`(let ((,name ,box))
(bt:with-lock-held ((box-lock ,name))
(flet ((-> (thing) (->! ,name thing))
(<- () (<-! ,name)))
,@things)
(<-! ,name)))))
]
(defun test ()
(let ((box (make)))
(-> box 'zero)
(pprint box)
(pprint (<-- box
(pprint (<-))
(-> 'one)))))