0.9.10.30
[sbcl.git] / src / pcl / fsc.lisp
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 \f
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-funcallable-instance)
44
45 (defmethod allocate-instance
46            ((class funcallable-standard-class) &rest initargs)
47   (declare (ignore initargs))
48   (unless (class-finalized-p class) (finalize-inheritance class))
49   (allocate-funcallable-instance (class-wrapper class)))
50
51 (defmethod make-reader-method-function ((class funcallable-standard-class)
52                                         slot-name)
53   (make-std-reader-method-function (class-name class) slot-name))
54
55 (defmethod make-writer-method-function ((class funcallable-standard-class)
56                                         slot-name)
57   (make-std-writer-method-function (class-name class) slot-name))
58
59 ;;;; See the comment about reader-function--std and writer-function--sdt.
60 ;;;;
61 ;(define-function-template reader-function--fsc () '(slot-name)
62 ;  `(function
63 ;     (lambda (instance)
64 ;       (slot-value-using-class (wrapper-class (get-wrapper instance))
65 ;                              instance
66 ;                              slot-name))))
67 ;
68 ;(define-function-template writer-function--fsc () '(slot-name)
69 ;  `(function
70 ;     (lambda (nv instance)
71 ;       (setf
72 ;        (slot-value-using-class (wrapper-class (get-wrapper instance))
73 ;                                instance
74 ;                                slot-name)
75 ;        nv))))
76 ;
77 ;(eval-when (:load-toplevel)
78 ;  (pre-make-templated-function-constructor reader-function--fsc)
79 ;  (pre-make-templated-function-constructor writer-function--fsc))