src/pcl/slot-name.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3
   4 ;;;; This software is derived from software originally released by Xerox
   5 ;;;; Corporation. Copyright and release statements follow. Later modifications
   6 ;;;; to the software are in the public domain and are provided with
   7 ;;;; absolutely no warranty. See the COPYING and CREDITS files for more
   8 ;;;; information.
   9
  10 ;;;; copyright information from original PCL sources:
  11 ;;;;
  12 ;;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
  13 ;;;; All rights reserved.
  14 ;;;;
  15 ;;;; Use and copying of this software and preparation of derivative works based
  16 ;;;; upon this software are permitted. Any distribution of this software or
  17 ;;;; derivative works must comply with all applicable United States export
  18 ;;;; control laws.
  19 ;;;;
  20 ;;;; This software is made available AS IS, and Xerox Corporation makes no
  21 ;;;; warranty about the software, its performance or its conformity to any
  22 ;;;; specification.
  23
  24 (in-package "SB-PCL")
  25 \f
  26 (defmacro slot-symbol (slot-name type)
  27   `(if (and (symbolp ,slot-name) (symbol-package ,slot-name))
  28        (or (get ,slot-name ',(ecase type
  29                                (reader 'reader-symbol)
  30                                (writer 'writer-symbol)
  31                                (boundp 'boundp-symbol)))
  32            (intern (format nil "~A ~A slot ~A"
  33                            (package-name (symbol-package ,slot-name))
  34                            (symbol-name ,slot-name)
  35                            ,(symbol-name type))
  36                    *slot-accessor-name-package*))
  37        (progn
  38          (error "Non-symbol and non-interned symbol slot name accessors~
  39                  are not yet implemented.")
  40          ;;(make-symbol (format nil "~A ~A" ,slot-name ,type))
  41          )))
  42
  43 (defun slot-reader-symbol (slot-name)
  44   (slot-symbol slot-name reader))
  45
  46 (defun slot-writer-symbol (slot-name)
  47   (slot-symbol slot-name writer))
  48
  49 (defun slot-boundp-symbol (slot-name)
  50   (slot-symbol slot-name boundp))
  51