Added box

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

cl-channel.asd

@@ -10,4 +10,5 @@
 		:bt-semaphore )
   :components ((:file "package")
                (:file "cl-channel")
+	       (:file "cl-box")
 	       (:file "cl-dispatcher")))

package.lisp

@@ -7,3 +7,7 @@
 (defpackage #:cl-dispatcher
   (:use #:cl)
   (:nicknames :dispatcher))
+
+(defpackage #:cl-box
+  (:use #:cl)
+  (:nicknames :box))