;;; 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) ,@variables) `(funcall (locative-reader ,reader)))))