Adding refs.

1 files changed, 51 insertions, 0 deletions

diff --git a/refs.lisp b/refs.lisp
new file mode 100644
index 0000000..de36c51
--- /dev/null
+++ b/refs.lisp
@@ -0,0 +1,51 @@
+;;;
+;;; Lisp references: pointer-like place locators that can be passed around.
+;;;
+;;; Copyright 2012 Kaz Kylheku <kaz@kylheku.com>
+;;;
+;;; How to use:
+;;;
+;;; Produce a reference which "lifts" the place designated
+;;; by form P:
+;;;
+;;;   (ref p)
+;;;
+;;; Dereference a reference R to designate the original place:
+;;;
+;;;   (deref r)
+;;;   (setf (deref r) 42) ;; store new value 42
+;;;
+;;; Shorthand notation instead of writing a lot of (deref)
+;;; Over FORMS, A is a symbol macro which expands to 
+;;; (DEREF RA), B expands to (DEREF RB):
+;;;
+;;;   (with-refs ((a ra) (b rb) ...)
+;;;     
+;;;     ... forms)
+;;; 
+(defstruct ref 
+ (get-func) 
+ (set-func))
+
+(defun deref (ref) 
+ (funcall (ref-get-func ref))) 
+
+(defun (setf deref) (val ref) 
+  (funcall (ref-set-func ref) val)) 
+
+(defmacro ref (place-expression &environment env)
+  (multiple-value-bind (temp-syms val-forms 
+                        store-vars store-form access-form)
+                        (get-setf-expansion place-expression env)
+    (when (cdr store-vars)
+      (error "REF: cannot take ref of multiple-value place"))
+    `(multiple-value-bind (,@temp-syms) (values ,@val-forms)
+       (make-ref
+         :get-func (lambda () ,access-form)
+         :set-func (lambda (,@store-vars) ,store-form)))))
+
+(defmacro with-refs ((&rest ref-specs) &body forms) 
+    `(symbol-macrolet 
+       ,(loop for (var ref) in ref-specs 
+              collecting (list var `(deref ,ref))) 
+       ,@forms))