NetNews Usenet Archive 1992 #26/NN_1992_26.iso/spool/comp/lang/lisp/2876

Text File | 1992-11-14 | 3.4 KB | 87 lines

Newsgroups: comp.lang.lisp
Path: sparky!uunet!gumby!wupost!decwrl!ads.com!kerry
From: [e-mail] (Kerry Koitzsch)
Subject: Vendor independent analog to Symbolics GET-DEFSTRUCT-DESCRIPTION
Message-ID: <[e-mail]>
Followup-To: Simon Clearys question
Summary: Hard to do, make it part of Common Lisp
Keywords: Vendor independent, dpANS
Sender: [e-mail] (USENET News)
Organization: Advanced Decision Systems, Mtn. View, CA [phone]
Date: Fri, 13 Nov 1992 17:24:51 GMT
Lines: 73

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