Major effort to plug slot-name leaks.

[sod] / src / utilities.lisp

diff --git a/src/utilities.lisp b/src/utilities.lisp
index be5ce56c5b1452a18579539f9c53a08b5cba0fc9..099c4ba281a5768c6c76dc29eb322255ffd8e34a 100644 (file)
--- a/src/utilities.lisp
+++ b/src/utilities.lisp
@@ -693,6 +693,26 @@ (defmacro dosequence ((var seq &key (start 0) (end nil) indexvar)
                      ,(loopguts t t end)
                      ,(loopguts indexvar t nil))))))))))
 
+;;;--------------------------------------------------------------------------
+;;; Structure accessor hacks.
+
+(export 'define-access-wrapper)
+(defmacro define-access-wrapper (from to &key read-only)
+  "Make (FROM THING) work like (TO THING).
+
+   If not READ-ONLY, then also make (setf (FROM THING) VALUE) work like
+   (setf (TO THING) VALUE).
+
+   This is mostly useful for structure slot accessors where the slot has to
+   be given an unpleasant name to avoid it being an external symbol."
+  `(progn
+     (declaim (inline ,from ,@(and (not read-only) `((setf ,from)))))
+     (defun ,from (object)
+       (,to object))
+     ,@(and (not read-only)
+           `((defun (setf ,from) (value object)
+               (setf (,to object) value))))))
+
 ;;;--------------------------------------------------------------------------
 ;;; CLOS hacking.