From 9f22cf5f383e57afd7aa97efc2bfa257e5881829 Mon Sep 17 00:00:00 2001
From: Ringo Wantanabe <flanchan@cumallover.me>
Date: Fri, 5 Apr 2019 05:32:18 +0100
Subject: [PATCH] Added box

---
 cl-box.lisp    | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++
 cl-channel.asd |  1 +
 package.lisp   |  4 ++++
 3 files changed, 67 insertions(+)
 create mode 100644 cl-box.lisp

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))