;;;; Locatives: C-style pointers in Common Lisp
;;; This a Common Lisp source file. Download it and load it
;;; into a Lisp Image. The file and the output are intended
;;; to be read side-by-side.
;;; The C computer programming language has pointers. One
;;; can take the address of variable and pass it to a
;;; function. This allows the function to reach out, back
;;; into the calling environment, like Carrie reaching out
;;; of her grave, and change the value of the variable.
;;; This has alarming implications for memory management.
;;; Once raw machine addresses have escaped into the wild
;;; malloc and free dare not move anything, so it is not
;;; possible to have memory mangement routines that compact
;;; the live space. If ones machine has 4kbyte pages and
;;; one ends up with a thin scattering of 256 bytes chunks
;;; of data, one could take a factor of sixteen hit on on
;;; memory utilisation. If that pushes the machine into
;;; paging, you will take a performance hit of not more than
;;; 10000 times.
;;; Common Lisp is carefully designed so that
;;; implementations may provide compacting garbage
;;; collectors. This would seem to rule out pointers of the
;;; kind present in C. The price of permitting compacting
;;; garbage collection is a level of indirection, so that
;;; the garbage collector can adjust pointers when it moves
;;; things. In practice, this extra level of indirection is
;;; usually present anyway, such as when a function is
;;; passed a CLOS object and changes the value of of a slot.
;;; C programmers often create Christmas trees of pointers
;;; to structures of pointers to structures ... Common Lisp
;;; programmers do essentially the same thing (though more
;;; conveniently) and may not realise that the apparently
;;; essential ingredient, pointers, is only implicitly
;;; present in the language.
;;; Although creating C-style pointers in Common Lisp is of
;;; no practical importance, the fact that it would appear
;;; to be impossible makes it an intriguing intellectual
;;; challenge. Obviously one is going to use macros, but
;;; this is the kind of fundamental addition to a
;;; programming language that looks on the face of it to be
;;; beyond the power of source-to-source transformations. I
;;; posted some code on comp.lang.lisp that created C-style
;;; pointers to variables. It was very limited. For
;;; example, it could not point to the third element of an
;;; array.
;;; Lars Brinkhof and Paul Foley have told me how to
;;; implement locatives - things that can point to any kind
;;; of place, just like a C-style pointer. Their code made
;;; me run away and hide under the bed. This is my attempt
;;; to sneak up on the code, and overcome my fear of
;;; get-setf-expansion
;;; The basic idea is to use closures
(defvar *read*)
(defvar *write*)
(let (variable) ;create a pointer to this variable
(setf *read* (lambda()variable)
*write* (lambda(data)(setf variable data))))
(funcall *write* 73)
(format t "Calling *read*, result is ~A~%"
(funcall *read*))
;;; We can set about packaging this
;;; The first step is to put the two closures
;;; together in a cons.
(defvar *read/write*)
(let (variable)
(setf *read/write*
(cons (lambda()variable)
(lambda(data)(setf variable data)))))
(funcall (cdr *read/write*) 351)
(format t "Calling reader from *read/write*~%~
Result is ~A~%"
(funcall (car *read/write*)))
;;; Pressing on, we can wrap (cons ... ) in a
;;; macro, so we can conveniently use the code
;;; in various places
(defmacro addr(variable-name)
`(cons (lambda() ,variable-name)
(lambda(data)(setf ,variable-name data))))
(let (&x &y)
(let (x y)
(setf &x (addr x)
&y (addr y)))
(funcall (cdr &x) "Ecks")
(funcall (cdr &y) "Why")
(format t "X=~A, Y=~A~%"
(funcall (car &x))
(funcall (car &y))))
;;; This is taking shape very nicely.
;;; Let us tidy up the funcalls with a function
(defun data (read-write-cons)
(funcall (car read-write-cons)))
(defun (setf data) (value read-write-cons)
(funcall (cdr read-write-cons) value))
(let (addr-x addr-y)
(let ((x 5)(y 7))
(setf addr-x (addr x)
addr-y (addr y)))
(psetf (data addr-x)(+ (data addr-x)
(data addr-y))
(data addr-y)(* (data addr-x)
(data addr-y)))
(format t "Adding and multiplying makes X=~A and Y=~A~%"
(data addr-x)
(data addr-y)))
;;; It looks as though we are done
;;; now we can translate C code
;;; &x = (addr x), *x = (data x)
;;; The trouble is, we have a multiple evaluation bug.
(let ((a #(a b c d e f g))
(i 2))
(let ((pointer (addr (aref a (incf i)))))
(dotimes (j 3)
(format t "Multiple evaluation bug -> ~A~%"
(data pointer)))))
;;; The multiple evaluation problem goes
;;; away if we introduce temporary variables
(let ((a #(a b c d e f g))
(i 2))
(let ((temp (incf i)))
(let ((pointer (addr (aref a temp))))
(dotimes (j 3)
(format t "Multiple eval bug cured -> ~A~%"
(data pointer))))))
;;; but that will not do. In place of
#|
(macroexpand '(addr (aref a (incf a))))
=>
(CONS (LAMBDA () (AREF A (INCF A)))
(LAMBDA (DATA)
(SETF (AREF A (INCF A)) DATA)))
|#
;;; we want to have
#|
(macroexpand '(addr (aref a (incf a))))
=>
(let ((temp (incf a)))
(cons (lambda ()(aref a temp))
(lambda (data)
(setf (aref a temp) data))))
|#
;;; At first sight we are stuck.
;;; Our macro ADDR would have to analyse the
;;; form it was given, decide what forms
;;; need to be evaluated and saved in temporary
;;; variables, and construct setter and getter
;;; forms to access the place without side-effects.
;;; That is a lot of work. Fortunately
;;; get-setf-expansion does it all for us.
(defmacro addr(access-form-with-side-effects)
(multiple-value-bind (temporary-variables
once-only-forms
;; to allow for multiples
;; values get-setf-expansion
;; returns a list of one element
list-of-store-variable
setter
getter)
(get-setf-expansion access-form-with-side-effects)
`(let* ,(mapcar (function list)
temporary-variables
once-only-forms)
(cons (lambda() ,getter)
(lambda(data)
(let ((,(car list-of-store-variable)
data))
,setter))))))
(let ((a #(a b c d e f g))
(i 2))
(let ((pointer (addr (aref a (incf i)))))
(dotimes (j 3)
(format t "Multiple eval bug free -> ~A~%"
(data pointer)))))
;;; Lars Brinkhoff
;;; http://www.hexapodia.net/pipermail/small-cl-src/2004-June/000016.html)
;;; Jeff Dalton
;;; http://groups.google.com/groups?q=jeff+Dalton+get-setf-expansion&hl=en&lr=&ie=UTF-8&selm=x2zox3zao2.fsf%40todday.aiai.ed.ac.uk&rnum=1
;;; and Paul Foley (email)
;;; all have sophisticated versions of this code.
;;; One nice touch that I've missed is that lambda and let
;;; are the same underneath, so I need not say
#|
(lambda(data)
(let ((,(car list-of-store-variable)
data))
,setter))
|#
;;; it should be simply
#|
(lambda ,list-of-store-variable ,setter)
|#
(defmacro addr(variable-name)
(multiple-value-bind (temporary-variables
once-only-forms
;; to allow for multiples
;; values get-setf-expansion
;; returns a list of one element
list-of-store-variable
setter
getter)
(get-setf-expansion variable-name)
`(let* ,(mapcar (function list)
temporary-variables
once-only-forms)
(cons (lambda() ,getter)
(lambda ,list-of-store-variable
,setter)))))
(print (macroexpand '(addr (aref a (incf i)(decf j)))))
#| =>
(LET* ((#:G888 A)
(#:G887 (INCF I))
(#:G886 (DECF J)))
(CONS
(LAMBDA ()
(AREF #:G888 #:G887 #:G886))
(LAMBDA (#:G885)
(COMMON-LISP::%ASET #:G888
#:G887
#:G886
#:G885))))
|#
;;; I don't know whether I've frightened my readers, but now
;;; feel much more confident about get-setf-expansion. I'm
;;; also very glad that I've created a web page about it. I
;;; do not think that I am actually going to use this
;;; frequently enough to avoid forgetting the details, so I
;;; will come back to this webpage myself to refresh my
;;; memory.