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