1;;;; This file contains the definition of the FUNCALLABLE-STANDARD-CLASS 2;;;; metaclass. Much of the implementation of this metaclass is actually 3;;;; defined on the class STD-CLASS. What appears in this file is a modest 4;;;; number of simple methods related to the low-level differences in the 5;;;; implementation of standard and funcallable-standard instances. 6;;;; 7;;;; As it happens, none of these differences are the ones reflected in 8;;;; the MOP specification; STANDARD-CLASS and FUNCALLABLE-STANDARD-CLASS 9;;;; share all their specified methods at STD-CLASS. 10 11;;;; This software is part of the SBCL system. See the README file for 12;;;; more information. 13 14;;;; This software is derived from software originally released by Xerox 15;;;; Corporation. Copyright and release statements follow. Later modifications 16;;;; to the software are in the public domain and are provided with 17;;;; absolutely no warranty. See the COPYING and CREDITS files for more 18;;;; information. 19 20;;;; copyright information from original PCL sources: 21;;;; 22;;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation. 23;;;; All rights reserved. 24;;;; 25;;;; Use and copying of this software and preparation of derivative works based 26;;;; upon this software are permitted. Any distribution of this software or 27;;;; derivative works must comply with all applicable United States export 28;;;; control laws. 29;;;; 30;;;; This software is made available AS IS, and Xerox Corporation makes no 31;;;; warranty about the software, its performance or its conformity to any 32;;;; specification. 33 34(in-package "SB-PCL") 35 36(defmethod wrapper-fetcher ((class funcallable-standard-class)) 37 'fsc-instance-wrapper) 38 39(defmethod slots-fetcher ((class funcallable-standard-class)) 40 'fsc-instance-slots) 41 42(defmethod raw-instance-allocator ((class funcallable-standard-class)) 43 'allocate-standard-funcallable-instance) 44 45(defmethod allocate-instance 46 ((class funcallable-standard-class) &rest initargs) 47 (declare (ignore initargs) 48 (inline ensure-class-finalized)) 49 (allocate-standard-funcallable-instance 50 (class-wrapper (ensure-class-finalized class)))) 51 52(defmethod make-reader-method-function ((class funcallable-standard-class) 53 slot-name) 54 (make-std-reader-method-function class slot-name)) 55 56(defmethod make-writer-method-function ((class funcallable-standard-class) 57 slot-name) 58 (make-std-writer-method-function class slot-name)) 59 60;;;; See the comment about reader-function--std and writer-function--sdt. 61;;;; 62;(define-function-template reader-function--fsc () '(slot-name) 63; `(function 64; (lambda (instance) 65; (slot-value-using-class (wrapper-class (get-wrapper instance)) 66; instance 67; slot-name)))) 68; 69;(define-function-template writer-function--fsc () '(slot-name) 70; `(function 71; (lambda (nv instance) 72; (setf 73; (slot-value-using-class (wrapper-class (get-wrapper instance)) 74; instance 75; slot-name) 76; nv)))) 77; 78;(eval-when (:load-toplevel) 79; (pre-make-templated-function-constructor reader-function--fsc) 80; (pre-make-templated-function-constructor writer-function--fsc)) 81