Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!tut.cis.ohio-state.edu!unreplyable!garbage From: Gripe@VEGA.FAC.CS.CMU.EDU Newsgroups: comp.lang.clos Subject: Failed Mail Message-ID: <3148.670024141@PULSAR.FAC.CS.CMU.EDU> Date: 26 Mar 91 21:49:01 GMT Sender: welch@tut.cis.ohio-state.edu Distribution: inet Organization: CommonLoops Lines: 102 ------- 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 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 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