jeff@aiai.ed.ac.uk (Jeff Dalton) (10/12/90)
In article <1990Oct10.130925.18317@hellgate.utah.edu> moore%cdr.utah.edu@cs.utah.edu (Tim Moore) writes: >In article <754@forsight.Jpl.Nasa.Gov> gat@robotics.Jpl.Nasa.Gov (Erann Gat) writes: >>You are right, of course. However, there are a number of things that you >>can do in T which you can't do in Common Lisp. Among these are: >> >>1. Create callable objects (which allow you to do things like SETF >> a locative passed to a function as an argument) > >I'm not sure what you mean by this. If you mean that T has locatives, >it's not hard to simulate locatives in Common Lisp (see Lisp Pointers, >vol. 2 no. 2); they're just closures that encapsulate the information >needed to store into the general variable (I think that's essentially >what they are in T; feel free to correct me). Or use the code at the end (ie, not the code in the middle) of this article. (I wrote it a while ago, so it may be that the version in Lisp Pointers is better.) As for callable objects, PCL uses something along those lines internally. I've often wondered whether CLOS lets the user define objects that are callable and have slots. You could use a hash table to hold the slots if hash tables were "weak" w.r.t garbage collection. So if you're using PopLog Common Lisp, you can do it by using the Pop-11 version of hash tables. Otherwise, there are various less perfect tricks you can use, such as: ;;; Almost-object functions. (defvar *magic-key* (list '*magic-key*)) (defun make-callable-object (fn value) #'(lambda (&rest args) (if (eq (car args) *magic-key*) value (apply fn args)))) The "value" can be anything you want, such as a table of slots. Unfortunately, it's difficult to devise a predicate that tells you whether something is one of these objects or not. But there's often some implementation-specific hack that will work, and for some Lisps you can probably figure it out from the PCL sources. Anyway, here's a simple one for KCL. ---------------------------------------------------------------------- ;;; *** Must be compiled *** (defCfun "object get_cc_env(cc) object cc;" 0 "return ((type_of(cc) == t_cclosure) ? cc->cc_env : Cnil);") (defentry get-cc-env (object) (object get_cc_env)) (defun make-callable-object (proc handler) (let ((mark '%callable-object-marker)) #'(lambda (&rest args) mark handler ;include in cclosure (apply proc args)))) (defun callable-object-p (x) (let ((env (get-cc-env x))) (and (consp env) (eq (car env) '%callable-object-marker)))) (defun callable-object-handler (co) (cadr (get-cc-env co))) ---------------------------------------------------------------------- The "handler" can be any object, but if you're implementing T-style objects it will be a function that returns a method if called with something that says which method you want. (The name (ie, a symbol) is the easiest thing to use.) Let's see if it works... > (setq cc (make-callable-object #'(lambda (x) (list 'z x)) 12)) #<compiled-closure 001f5af4> > (callable-object-p cc) ;does the predicate recognize them? t > (callable-object-p 12) ;and reject random other things? nil > (callable-object-handler cc) 12 > (funcall cc 'apples) (z apples) Anyway, here's the locatives code: ---------------------------------------------------------------------- ;;; Locatives `a la T 2.8 ;;; ;;; Jeff Dalton, AIAI/PSG, University of Edinburgh ;;; ;;; A locative is a pointer to a place, where the place is specified ;;; by a generalized variable as in SETF. Operations: ;;; ;;; (LOCATIVE place) Macro, creates a locative pointing to place. ;;; (CONTENTS locative) Dereferences a locative. Can be used with ;;; SETF. ;;; (LOCATIVE-P object) Predicate for recognizing locatives. ;;; ;;; In (LOCATIVE place), subforms of place are evaluated when the locative ;;; is created, and not when it is dereferenced. ;;; ;;; Unlike pointers in languages like C, or in Lisp systems that can make ;;; use of "invisible pointers", the locatives defined here are not very ;;; efficient: they're implemented using thunks. (provide "LOCATIVES") (in-package "RANDOM") (export '(locative locative-p contents)) (defstruct (locative (:print-function print-locative)) "Represents a locative pointer." (val-thunk ()) (set-thunk ()) (source ())) ;for debugging... (defun print-locative (loc stream depth) (if (and *print-level* (>= depth *print-level*)) (write-string "#" stream) (format stream "#<Locative from ~S>" (locative-source loc)))) (defmacro locative (place) "Returns a pointer to a place, place as in SETF." (if (symbolp place) `(make-locative :val-thunk #'(lambda () ,place) :set-thunk #'(lambda (val) (setq ,place val)) :source ',place) (multiple-value-bind (temp-vars val-forms store-vars store-form access-form) (get-setf-method place) (unless (= (length store-vars) 1) (error "Can't handle more than one store value in ~S" place)) ;; could skip binding vars in some cases... `(let* ,(mapcar #'list temp-vars val-forms) (make-locative :val-thunk #'(lambda () ,access-form) :set-thunk #'(lambda ,store-vars ,store-form) :source ',place))))) (defun contents (loc) "Dereferences a locative." (check-type loc locative) (funcall (locative-val-thunk loc))) (defun set-contents (loc val) "Sets the place indicated by a locative." (check-type loc locative) (funcall (locative-set-thunk loc) val)) (defsetf contents set-contents) ---------------------------------------------------------------------- Jeff Dalton, JANET: J.Dalton@uk.ac.ed AI Applications Institute, ARPA: J.Dalton%uk.ac.ed@nsfnet-relay.ac.uk Edinburgh University. UUCP: ...!ukc!ed.ac.uk!J.Dalton