[Small-cl-src] Locatives
Lars Brinkhoff
lars at nocrew.org
Mon Jun 7 10:02:35 UTC 2004
;;; A portable implementation of locatives (or first-class places).
;;; From the Lisp Machine Manual:
;;;
;;; A locative is a type of Lisp object used as a pointer to a cell.
;;; [...] A cell is a machine word that can hold a (pointer to a) Lisp
;;; object. For example, a symbol has five cells: the print name cell,
;;; the value cell, the function cell, the property list cell, and the
;;; package cell. The value cell holds (a pointer to) the binding of
;;; the symbol, and so on. [...] A locative is an object that points
;;; to a cell: it lets you refer to a cell so that you can examine or
;;; alter its contents.
;;;
;;; Since standard Common Lisp doesn't provide any way to create a pointer
;;; to a cell, this implementation instead uses the setf place machinery.
;;; This makes locatives more versatile, as they can refer to not just a
;;; cell, but any place, e.g. a single bit or multiple values. Because of
;;; this, a locative can't be an immediate value like a machine address, so
;;; it also makes locatives more heavy-weight. In this implementation,
;;; creating a locative involves consing two closures, plus storage to hold
;;; them.
;;; Two additional Lisp machine locative operators, location-boundp and
;;; location-makunbound, can at best only be approximated, so are better
;;; left out completely.
;;; Usage example:
;;;
;;; (defun foo (list)
;;; ;; Return a locative pointing into a list.
;;; (locf (nth 2 list)))
;;;
;;; (defun bar (array)
;;; ;; Return a locative pointing into an array.
;;; (locf (aref array 3)))
;;;
;;; (defun frob (loc)
;;; ;; Modify the contents of the place.
;;; (setf (contents loc) 42))
;;;
;;; (let ((list (list 1 2 3 4 5))
;;; (array (vector 1 2 3 4 5)))
;;; (frob (foo list))
;;; (frob (bar array))
;;; (values list array))
(defpackage #:locatives
(:use #:common-lisp)
(:export #:locative #:locativep #:locf #:contents))
(in-package #:locatives)
(eval-when (:compile-toplevel :execute)
(defconstant +locative-doc+
"A locative is a type of Lisp object used as a pointer to a place.")
(defconstant +locativep-doc+
"Returns true if the object is a locative."))
;;; Three different storage types for locatives are provided:
;;; structure, class, or cons.
#+(and)
(progn
(defstruct (locative
(:predicate locativep)
(:constructor make-locative (reader writer))
(:copier nil))
#.+locative-doc+
(reader nil :type function :read-only t)
(writer nil :type function :read-only t))
(setf (documentation 'locativep 'function) #.+locativep-doc+))
#+(or)
(progn
(defclass locative ()
((reader :initarg :reader :type function :reader locative-reader)
(writer :initarg :writer :type function :reader locative-writer))
(:documentation #.+locative-doc+))
(defun locativep (object)
#.+locativep-doc+
(typep object 'locative))
(defun make-locative (reader writer)
(make-instance 'locative :reader reader :writer writer)))
#+(or)
(progn
(deftype locative ()
#.+locative-doc+
`(cons function function))
(defun locativep (object)
#.+locativep-doc+
(typep object 'locative))
(defun locative-reader (loc) (car loc))
(defun locative-writer (loc) (cdr loc))
(defun make-locative (reader writer) (cons reader writer)))
(when (find-class 'locative nil)
(defmethod print-object ((object locative) stream)
(print-unreadable-object (object stream :type t :identity t))
object))
(defmacro locf (place &environment env)
"Return a locative for place."
(multiple-value-bind (temps values variables writer reader)
(get-setf-expansion place env)
`(let* ,(mapcar #'list temps values)
(make-locative (lambda () ,reader) (lambda ,variables ,writer)))))
(defun contents (locative)
"Returns the contents of the place which the locative points to."
(funcall (locative-reader locative)))
(define-setf-expander contents (locative &environment env)
"Modifies the contents of the place which the locative points to."
(multiple-value-bind (temps values variables writer reader)
(get-setf-expansion locative env)
(declare (ignore writer))
(values temps
values
variables
`(funcall (locative-writer ,reader) , at variables)
`(funcall (locative-reader ,reader)))))
More information about the Small-cl-src
mailing list