🚀 go-pugleaf

------- Forwarded Message

Return-Path: <@pt.cs.cmu.edu:MAILER-DAEMON@ROEBLING.CIVE.CMU.EDU>
Received: from pt.cs.cmu.edu by VEGA.FAC.CS.CMU.EDU id aa07280;
          22 Mar 91 17:17:50 EST
Received: from roebling.cive.cmu.edu by PT.CS.CMU.EDU id aa02013;
          22 Mar 91 17:17:07 EST
Received: by ROEBLING.CIVE.CMU.EDU (5.61/1.19)
	id AA07019; Fri, 22 Mar 91 17:16:42 -0500
Date: Fri, 22 Mar 91 17:16:42 -0500
From: Mail Delivery Subsystem <MAILER-DAEMON@ROEBLING.CIVE.CMU.EDU>
Subject: Returned mail: Cannot send message for 3 days
Message-Id: <9103222216.AA07019@ROEBLING.CIVE.CMU.EDU>
To: CMU-CommonLoops-Request@PT.CS.CMU.EDU
MMDF-Warning:  Parse error in original version of preceding line at PT.CS.CMU.EDU
To: commonloops-request@cis.ohio-state.edu

   ----- Transcript of session follows -----
421 slcs.slb.com.tcp... Deferred: Connection timed out during user open with SJOSU1.SINet.SLB.COM

   ----- Unsent message follows -----
Received: from PT.CS.CMU.EDU by ROEBLING.CIVE.CMU.EDU (5.61/1.19)
	id AA04805; Tue, 19 Mar 91 17:15:03 -0500
Received: from tut.cis.ohio-state.edu by PT.CS.CMU.EDU id aa28626;
          19 Mar 91 17:07:17 EST
Received: by tut.cis.ohio-state.edu (5.61-kk/5.910301)
	id AA10386; Tue, 19 Mar 91 17:01:42 -0500
Errors-To: commonloops-request@cis.ohio-state.edu
Received: by tut.cis.ohio-state.edu (5.61-kk/5.910301)
	id AA10214; Tue, 19 Mar 91 16:57:55 -0500
Received: from USENET by tut.cis.ohio-state.edu with netnews
	for commonloops@tut.cis.ohio-state.edu (commonloops@tut.cis.ohio-state.edu)
	(contact usenet@tut.cis.ohio-state.edu if you have questions)
Date: 19 Mar 91 21:36:27 GMT
From: Marty Hall <aplcen!hall@uakari.primate.wisc.edu>
Organization: AAI Corp AI Lab, JHU P/T CS Faculty
Subject: Re: Macro for defclass, constructor ...
Message-Id: <1991Mar19.213627.12203@aplcen.apl.jhu.edu>
References: <9103181745.AA18191@mingus.mitre.org>, <24620@hydra.gatech.EDU>
To: commonloops@cis.ohio-state.edu

In article <24620@hydra.gatech.EDU> gt4084c@prism.gatech.EDU (SRINIVASAN,K)
writes:
>
> Has anybody written a macro which expands into a call to defclass and also
> creates a constructor function and tailored descriptor function?  Any hints
> or code will be very much appreciated.

Here is a simple one. I am by no means a CLOS hacker; when we started my
current program (in the pre CLOS/CLIM days) we needed transportable objects
and graphics, so have been using KEE. Anyhow, I am sure there are plenty of
whizzy ones out there, but here is a vanilla one.

Pardon the odd capitalization; I have a long habit of capitalizing
functions/vars I write myself in order to distinguish them from predefined
ones when I go back later and look at the code.

Feel free to do whatever you want with the code.

					- Marty Hall
- ------------------------------------------------------
hall@aplcen.apl.jhu.edu, hall%aplcen@jhunix.bitnet, ..uunet!aplcen!hall
Artificial Intelligence Lab, AAI Corp, PO Box 126, Hunt Valley, MD 21030

(setf (need-p 'disclaimer) NIL)

============================== Cut Here ==============================

;;;======================================================================
;;; Lets you type
;;;       (define-class Foo (Bar Baz) (A B) (C D)) if you want
;;;       (defclass Foo (Bar Baz)
;;;         ((A :accessor A :initform B :initarg :A)
;;;          (C :accessor C :initform D :initarg :C)))
;;;
;;; I was lazy: B/D cannot be lexical vars.
;;;
;;; 12/90 Marty Hall

(defmacro Define-Class (Object-Name Super-Class-List &rest Slot-Value-Pairs)
  `(defclass ,Object-Name ,Super-Class-List
     ,(mapcar #'Expand-Slot-Name-Value-Pair Slot-Value-Pairs)) )

;;;======================================================================
;;; (A B) --> (A :accessor A :initform B :initarg :A)
;;;
;;; 12/90 Marty Hall

(defun Expand-Slot-Name-Value-Pair (Name-Value-Pair)
  (let ((Slot-Name (first Name-Value-Pair))
	(Slot-Value (eval (second Name-Value-Pair))))
    (list Slot-Name
	  :accessor Slot-Name
	  :initform Slot-Value
	  :initarg (read-from-string
		    (concatenate 'string ":" (string Slot-Name))) )))

;;;======================================================================

------- End of Forwarded Message