From: Kerry Koitzsch
Subject: Vendor independent analog to Symbolics GET-DEFSTRUCT-DESCRIPTION
Date:
Message-ID: <1992Nov13.172451.16365@ads.com>
Hello LISP experts:
Getting at the internal structure of defstructs in a portable way has
always been a pain, given the lack of standardization of defstruct internal
accessors in Common Lisp. Simon Clearys recent question about the analog
to SI:GET-DEFSTRUCT-DESCRIPTION is a good example of this:
;;; Vendor-indpendent analog of GET-DEFSTRUCT-DESCRIPTION for
;;; the 'Big Seven':
(defvar *vendor-defstruct-name-function*
#+akcl #'(lambda(desc)(si::s-data-name desc))
#+excl #'(lambda(desc)(slot-value desc 'excl::name))
#+lucid #'(lambda(desc)(system::structure-ref desc 0 'lucid::defstruct))
#+lispm #'(lambda(desc)(si:defstruct-description-name desc))
#+:mcl #'(lambda(desc)(class-name (class-of desc)))
#+cmu #'(lambda(desc)(kernel::structure-ref struct 0))
#+xerox #'(lambda(desc)) ;;; ????
"Given defstruct descriptor, return name.")
(defvar *vendor-defstruct-descriptor-function*
#+symbolics #'(lambda(name)(si:get name 'si:defstruct-description))
#+lucid #'(lambda(name)(gethash name lucid::*defstructs*))
#+excl #'(lambda(name)(get name 'excl::%structure-definition))
#+akcl #'(lambda (name)(get name 'si::s-data))
#+cmu #'(lambda (name)(ext:info c::type c::defined-structure-info name))
#+:mcl #'(lambda (name)(gethash name 'ccl::%defstructs%))
#+xerox #'(lambda(name)) ;;; ???
"from symbol name of defstruct get the defstruct descriptor.")
(defun PSEUDO-QUOTE-READER (stream subchar arg)
"Reader to convert a function spec into a more parsable format."
(declare (ignore subchar arg))
(eval (list 'quote
(second (read-from-string
(nsubstitute #\space #\#
(concatenate 'string "("
(read-line stream t nil t) ")")
:test #'equal))))))
(defun PARSE-DEFSTRUCT-SPEC (struct)
"Vendor independent way to get defstruct name from defstruct object."
(let ((ans nil)
(*readtable* (copy-readtable)))
(set-dispatch-macro-character #\# #\' (function pseudo-quote-reader))
(set-dispatch-macro-character #\# #\< (function pseudo-quote-reader))
(set-dispatch-macro-character #\# #\S (function pseudo-quote-reader))
(setq ans (subseq (format nil "~a" struct) 3))
(setq ans (subseq ans 0 (position #\space ans)))
(read-from-string ans)))
(defun GET-DEFSTRUCT-NAME (instance)
"Given a defstruct instance, return the symbol which is its name."
(parse-defstruct-spec instance))
(defun STRUCTURE-P (X)
"Vendor independent redicate: returns T if x is a structure instance!"
(funcall *vendor-defstruct-predicate-function* x))
(defun GET-DEFSTRUCT-DESCRIPTOR (structname)
"A vendor-independent way to get the defstruct descriptor out."
(when (structure-p structname)
(setf structname (get-defstruct-name structname)))
(funcall *vendor-defstruct-descriptor-function* structname))
This problem is even worse for functions of the form:
(get-defstruct-copier <defstruct name>)
So when you write your dpANS comments, please advocate a more
complete interface to DEFSTRUCT that suits YOUR needs!
kerry