(FILECREATED " 8-Aug-86 16:37:32" ("compiled on " {ERINYES}NEWPCL>STRUCTURE-CLASS.;16) " 7-Aug-86 23:09:22" "COMPILE-FILEd" in "Xerox Lisp 7-Aug-86 ..." dated " 7-Aug-86 23:25:59") (FILECREATED " 8-Aug-86 16:36:58" {ERINYES}NEWPCL>STRUCTURE-CLASS.;16 47020 changes to: ( METHODS MAKE-COPIER-DEFINITIONS~STRUCTURE-CLASS~T~T~T MAKE-ACCESSOR-DEFINITIONS~STRUCTURE-CLASS~T~T~T SUPERS-CHANGED~STRUCTURE-CLASS~T~T~T~T) previous date: " 7-Aug-86 21:59:41" {ERINYES}NEWPCL>STRUCTURE-CLASS.;14) (RPAQQ STRUCTURE-CLASSCOMS ((STRUCTURES STRUCTURE-CLASS STRUCTURE-OBJECT) (P (DECLAREDATATYPE (QUOTE T ) (QUOTE NIL) (QUOTE NIL) 0 NIL) (DECLAREDATATYPE (QUOTE STRUCTURE-OBJECT) (QUOTE NIL) (QUOTE NIL) 0 ( QUOTE T))) (METHODS ALL-SLOTS-USING-CLASS~STRUCTURE-CLASS~T CHECK-SUPER-META-CLASS-COMPATIBILITY~STRUCTURE-CLASS~CLASS CLASS-DEFAULT-INCLUDES~STRUCTURE-CLASS GET-SLOT-USING-CLASS~STRUCTURE-CLASS~T~T~T~T INITIALIZE-FROM-DEFAULTS~STRUCTURE-OBJECT INITIALIZE-FROM-INIT-PLIST~STRUCTURE-OBJECT~T INITIALIZE~STRUCTURE-OBJECT~T MAKE-COPIER-DEFINITIONS~STRUCTURE-CLASS~T~T~T MAKE-ACCESSOR-DEFINITIONS~STRUCTURE-CLASS~T~T~T MAKE-INSTANCE~STRUCTURE-CLASS MAKE-PREDICATE-DEFINITIONS~STRUCTURE-CLASS~T~T~T OPTIMIZE-GET-SLOT~T~STRUCTURE-CLASS~T PRINT-INSTANCE~STRUCTURE-OBJECT~T~T PUT-SLOT-USING-CLASS~STRUCTURE-CLASS~T~T~T SLOTS-CHANGED~STRUCTURE-CLASS~T~T SUPERS-CHANGED~STRUCTURE-CLASS~T~T~T~T UPDATE-FROM-LOCALS~STRUCTURE-CLASS~T) (SETFS GET-SLOT--STRUCTURE-CLASS-1) (FUNCTIONS GET-SLOT--STRUCTURE-CLASS-1 MDEFSTRUCT STRUCTURE-CONSTRUCTOR UPDATE-SLOTS--STRUCTURE-CLASS) (PROP FILETYPE STRUCTURE-CLASS))) (RECORD-DEFINITION (QUOTE STRUCTURE-CLASS) (QUOTE NDEFSTRUCT)) (ADD-NAMED-CLASS (CLASS-PROTOTYPE (CLASS-NAMED (QUOTE CLASS))) (QUOTE STRUCTURE-CLASS) (QUOTE (CLASS)) (QUOTE NIL) (QUOTE |S(DS-OPTIONS NAME STRUCTURE-CLASS CONSTRUCTORS ((MAKE-STRUCTURE-CLASS)) COPIER COPY-STRUCTURE-CLASS PREDICATE STRUCTURE-CLASS-P PRINT-FUNCTION NIL GENERATE-ACCESSORS METHOD CONC-NAME STRUCTURE-CLASS- INCLUDES (CLASS) SLOT-INCLUDES NIL INITIAL-OFFSET 0))) (DO-ACCESSOR-DEFINITIONS (QUOTE STRUCTURE-CLASS) (QUOTE NIL)) MAKE-STRUCTURE-CLASS D1 (L (0 -args-)) UeHk2JdIó²¿K!g k»ºgI°,a½Lµ Mh\»JkÔZ°ØM&¼°÷dýKkØ[nñ—o ¿µëKJ(114Q LISPERROR 32Q SYMBOL-FUNCTION) (40Q STRUCTURE-CLASS 27Q MAKE) ( 111Q "TOO MANY ARGUMENTS") (DO-COPIER-DEFINITION (QUOTE STRUCTURE-CLASS) (QUOTE COPY-STRUCTURE-CLASS)) STRUCTURE-CLASS-P D1 (L (0 X)) '@ ´!g @ É gg hðhð(40Q CL:MEMBER 35Q SYMBOL-FUNCTION 24Q CLASS-CLASS-PRECEDENCE-LIST 17Q IWMC-CLASS-CLASS-WRAPPER 13Q CLASS-NAMED 3 IWMC-CLASS-P) (32Q EQ 27Q :TEST 10Q STRUCTURE-CLASS) () (PUTPROPS STRUCTURE-CLASS DEFTYPE (MACRO NIL (QUOTE (SATISFIES STRUCTURE-CLASS-P)))) (RECORD-DEFINITION (QUOTE STRUCTURE-OBJECT) (QUOTE NDEFSTRUCT)) (ADD-NAMED-CLASS (CLASS-PROTOTYPE (CLASS-NAMED (QUOTE CLASS))) (QUOTE STRUCTURE-OBJECT) (QUOTE (T)) ( QUOTE NIL) (QUOTE |S(DS-OPTIONS NAME STRUCTURE-OBJECT CONSTRUCTORS ((MAKE-STRUCTURE-OBJECT)) COPIER COPY-STRUCTURE-OBJECT PREDICATE STRUCTURE-OBJECT-P PRINT-FUNCTION NIL GENERATE-ACCESSORS METHOD CONC-NAME STRUCTURE-OBJECT- INCLUDES (T) SLOT-INCLUDES NIL INITIAL-OFFSET 0))) (DO-ACCESSOR-DEFINITIONS (QUOTE STRUCTURE-OBJECT) (QUOTE NIL)) MAKE-STRUCTURE-OBJECT D1 (L (0 -args-)) UeHk2JdIó²¿K!g k»ºgI°,a½Lµ Mh\»JkÔZ°ØM&¼°÷dýKkØ[nñ—o ¿µëKJ(114Q LISPERROR 32Q SYMBOL-FUNCTION) (40Q STRUCTURE-OBJECT 27Q MAKE) ( 111Q "TOO MANY ARGUMENTS") (DO-COPIER-DEFINITION (QUOTE STRUCTURE-OBJECT) (QUOTE COPY-STRUCTURE-OBJECT)) STRUCTURE-OBJECT-P D1 (L (0 X)) '@ ´!g @ É gg hðhð(40Q CL:MEMBER 35Q SYMBOL-FUNCTION 24Q CLASS-CLASS-PRECEDENCE-LIST 17Q IWMC-CLASS-CLASS-WRAPPER 13Q CLASS-NAMED 3 IWMC-CLASS-P) (32Q EQ 27Q :TEST 10Q STRUCTURE-OBJECT) () (PUTPROPS STRUCTURE-OBJECT DEFTYPE (MACRO NIL (QUOTE (SATISFIES STRUCTURE-OBJECT-P)))) (DECLAREDATATYPE (QUOTE T) (QUOTE NIL) (QUOTE NIL) 0 NIL) (DECLAREDATATYPE (QUOTE STRUCTURE-OBJECT) (QUOTE NIL) (QUOTE NIL) 0 (QUOTE T)) (PUTDEF (QUOTE ALL-SLOTS-USING-CLASS~STRUCTURE-CLASS~T) (QUOTE METHODS) (QUOTE (DEFMETH ALL-SLOTS-USING-CLASS ((CLASS STRUCTURE-CLASS) OBJECT) (ITERATE ((SLOTD IN (CLASS-INSTANCE-SLOTS CLASS ))) (CL:COLLECT (SLOTD-NAME SLOTD)) (CL:COLLECT (FUNCALL (SLOTD-ACCESSOR SLOTD) OBJECT)))))) (PUTDEF (QUOTE CHECK-SUPER-META-CLASS-COMPATIBILITY~STRUCTURE-CLASS~CLASS) (QUOTE METHODS) (QUOTE ( DEFMETH CHECK-SUPER-META-CLASS-COMPATIBILITY ((CLASS STRUCTURE-CLASS) (SUPER-CLASS CLASS)) T))) (PUTDEF (QUOTE CLASS-DEFAULT-INCLUDES~STRUCTURE-CLASS) (QUOTE METHODS) (QUOTE (DEFMETH CLASS-DEFAULT-INCLUDES ((CLASS STRUCTURE-CLASS)) (LIST (QUOTE STRUCTURE-OBJECT))))) (PUTDEF (QUOTE GET-SLOT-USING-CLASS~STRUCTURE-CLASS~T~T~T~T) (QUOTE METHODS) (QUOTE (DEFMETH GET-SLOT-USING-CLASS ((CLASS STRUCTURE-CLASS) OBJECT SLOT-NAME NO-ERROR-P DEFAULT) (IGNORE NO-ERROR-P DEFAULT) (LET ((POS (SLOTD-POSITION SLOT-NAME (CLASS-INSTANCE-SLOTS CLASS)))) (CL:IF POS ( GET-SLOT--STRUCTURE-CLASS-1 OBJECT POS) (CL:ERROR "slot not found")))))) (PUTDEF (QUOTE INITIALIZE-FROM-DEFAULTS~STRUCTURE-OBJECT) (QUOTE METHODS) (QUOTE (DEFMETH INITIALIZE-FROM-DEFAULTS ((SELF STRUCTURE-OBJECT)) (ITERATE ((SLOTD IN (CLASS-INSTANCE-SLOTS (CLASS-OF SELF)))) (SETF (GET-SLOT SELF (SLOTD-NAME SLOTD)) (CL:EVAL (SLOTD-DEFAULT SLOTD))))))) (PUTDEF (QUOTE INITIALIZE-FROM-INIT-PLIST~STRUCTURE-OBJECT~T) (QUOTE METHODS) (QUOTE (DEFMETH INITIALIZE-FROM-INIT-PLIST ((SELF STRUCTURE-OBJECT) INIT-PLIST) (LET ((CLASS (CLASS-OF SELF)) (ENTRY NIL)) (MACROLET ((INITIALIZE-SLOTS (SLOTS) (BQUOTE (ITERATE ((SLOTD IN (\, SLOTS))) (CL:WHEN (CL:SETQ ENTRY (MEMQ (SLOTD-KEYWORD SLOTD) INIT-PLIST)) (SETF (CAR ENTRY) NIL) (SETF (GET-SLOT SELF (SLOTD-NAME SLOTD)) (CADR ENTRY))))))) (INITIALIZE-SLOTS (CLASS-INSTANCE-SLOTS CLASS)) (INITIALIZE-SLOTS ( CLASS-NON-INSTANCE-SLOTS CLASS))))))) (PUTDEF (QUOTE INITIALIZE~STRUCTURE-OBJECT~T) (QUOTE METHODS) (QUOTE (DEFMETH INITIALIZE ((OBJECT STRUCTURE-OBJECT) INIT-PLIST) (INITIALIZE-FROM-DEFAULTS OBJECT) (INITIALIZE-FROM-INIT-PLIST OBJECT INIT-PLIST)))) (PUTDEF (QUOTE MAKE-COPIER-DEFINITIONS~STRUCTURE-CLASS~T~T~T) (QUOTE METHODS) (QUOTE (DEFMETH MAKE-COPIER-DEFINITIONS ((CLASS STRUCTURE-CLASS) NAME DS-OPTIONS SLOTDS) (IGNORE SLOTDS) (* ;; "THIS IS NOT COMPLETE") (LET ((COPIER (DS-OPTIONS-COPIER DS-OPTIONS))) (CL:WHEN COPIER ( COMPILE-TIME-DEFINE (QUOTE DEFUN) COPIER) (BQUOTE ((DEFUN (\, COPIER) ((\, NAME)) (COPY (\, NAME)))))) )))) (PUTDEF (QUOTE MAKE-ACCESSOR-DEFINITIONS~STRUCTURE-CLASS~T~T~T) (QUOTE METHODS) (QUOTE (DEFMETH MAKE-ACCESSOR-DEFINITIONS ((CLASS STRUCTURE-CLASS) NAME DS-OPTIONS SLOTDS) (* ;; "this uses the ds-options to make sure that the offset includes your ") (LET ((OFFSET (+ ( DS-OPTIONS-INITIAL-OFFSET DS-OPTIONS) (LET ((SUPER (CAR (DS-OPTIONS-INCLUDES DS-OPTIONS)))) (CL:IF SUPER (LENGTH (CLASS-INSTANCE-SLOTS (CLASS-NAMED SUPER))) 0))))) (ITERATE ((SLOTD IN SLOTDS) (I FROM OFFSET)) (LET ((ACCESSOR (SLOTD-ACCESSOR SLOTD)) SETF-DISCRIMINATOR-NAME) (CL:WHEN ACCESSOR (CL:SETQ SETF-DISCRIMINATOR-NAME (MAKE-SETF-DISCRIMINATOR-NAME ACCESSOR)) (CL:COLLECT (BQUOTE (DEFUN (\, ACCESSOR) ((\, NAME)) (GET-SLOT--STRUCTURE-CLASS-1 (\, NAME) (\, I) (QUOTE (\, NAME)))))) (CL:COLLECT (BQUOTE (DEFUN (\, SETF-DISCRIMINATOR-NAME) ((\, NAME) NEW-VALUE) (SETF (GET-SLOT--STRUCTURE-CLASS-1 ( \, NAME) (\, I) (QUOTE (\, NAME))) NEW-VALUE)))) (CL:COLLECT (BQUOTE (DEFSETF (\, ACCESSOR) (\, SETF-DISCRIMINATOR-NAME))))))))))) (PUTDEF (QUOTE MAKE-INSTANCE~STRUCTURE-CLASS) (QUOTE METHODS) (QUOTE (DEFMETH MAKE-INSTANCE ((CLASS STRUCTURE-CLASS)) (NCREATE (GET-SLOT--CLASS CLASS (QUOTE NAME)))))) (PUTDEF (QUOTE MAKE-PREDICATE-DEFINITIONS~STRUCTURE-CLASS~T~T~T) (QUOTE METHODS) (QUOTE (DEFMETH MAKE-PREDICATE-DEFINITIONS ((CLASS STRUCTURE-CLASS) NAME DS-OPTIONS SLOTDS) (IGNORE CLASS SLOTDS) (LET ((PREDICATE (OR (DS-OPTIONS-PREDICATE DS-OPTIONS) (MAKE-SYMBOL (STRING-APPEND NAME " Predicate"))))) (BQUOTE ((DEFUN (\, PREDICATE) (X) (TYPEP X (QUOTE (\, NAME)))))))))) (PUTDEF (QUOTE OPTIMIZE-GET-SLOT~T~STRUCTURE-CLASS~T) (QUOTE METHODS) (QUOTE (DEFMETH OPTIMIZE-GET-SLOT (METHOD (CLASS STRUCTURE-CLASS) FORM) (CL:PRINT "no optimization for get-slot of structure-class") FORM))) (PUTDEF (QUOTE PRINT-INSTANCE~STRUCTURE-OBJECT~T~T) (QUOTE METHODS) (QUOTE (DEFMETH PRINT-INSTANCE (( INSTANCE STRUCTURE-OBJECT) STREAM DEPTH) (* THIS IS JUST THE DEFINITION FOR OBJECT (\, AND) CAN GO AWAY IF STRUCTURE-OBJECT IS A SUB-CLASS OF OBJECT) (LET ((CL:LENGTH (CL:IF (NUMBERP *PRINT-LENGTH*) ( CL:* *PRINT-LENGTH* 2) NIL))) (FORMAT STREAM "#S(~S" (CLASS-NAME (CLASS-OF INSTANCE))) (ITERATE (( SLOT-OR-VALUE IN (ALL-SLOTS INSTANCE)) (SLOTP = T (NOT SLOTP))) (CL:WHEN (NUMBERP CL:LENGTH) (COND (( <= CL:LENGTH 0) (FORMAT STREAM " ...") (RETURN NIL)) (T (DECF CL:LENGTH)))) (PRINC " " STREAM) (LET (( *PRINT-LEVEL* (COND ((NULL *PRINT-LEVEL*) NIL) (SLOTP 1) (T (- *PRINT-LEVEL* DEPTH))))) (CL:IF (AND *PRINT-LEVEL* (<= *PRINT-LEVEL* 0)) (PRINC "#" STREAM) (CL:PRIN1 SLOT-OR-VALUE STREAM)))) (PRINC ")" STREAM))))) (PUTDEF (QUOTE PUT-SLOT-USING-CLASS~STRUCTURE-CLASS~T~T~T) (QUOTE METHODS) (QUOTE (DEFMETH PUT-SLOT-USING-CLASS ((CLASS STRUCTURE-CLASS) OBJECT SLOT-NAME NEW-VALUE) (LET ((POS (SLOTD-POSITION SLOT-NAME (CLASS-INSTANCE-SLOTS CLASS)))) (CL:IF POS (SETF (GET-SLOT--STRUCTURE-CLASS-1 OBJECT POS) NEW-VALUE) (CL:ERROR "slot not found")))))) (PUTDEF (QUOTE SLOTS-CHANGED~STRUCTURE-CLASS~T~T) (QUOTE METHODS) (QUOTE (DEFMETH SLOTS-CHANGED (( CLASS STRUCTURE-CLASS) OLD-LOCAL-SLOTS EXTRA &OPTIONAL (TOP-P T)) (IGNORE TOP-P OLD-LOCAL-SLOTS) ( UPDATE-SLOTS--STRUCTURE-CLASS CLASS (CLASS-CLASS-PRECEDENCE-LIST CLASS)) (DOLIST (SUB-CLASS ( CLASS-DIRECT-SUBCLASSES CLASS)) (SLOTS-CHANGED SUB-CLASS (CLASS-LOCAL-SLOTS SUB-CLASS) EXTRA NIL))))) (PUTDEF (QUOTE SUPERS-CHANGED~STRUCTURE-CLASS~T~T~T~T) (QUOTE METHODS) (QUOTE (DEFMETH SUPERS-CHANGED ((SELF STRUCTURE-CLASS) OLD-LOCAL-SUPERS OLD-LOCAL-SLOTS EXTRA TOP-P) (LET* ((LOCAL-SUPERS ( CLASS-LOCAL-SUPERS SELF)) (CPL (COMPUTE-CLASS-PRECEDENCE-LIST SELF LOCAL-SUPERS)) (NAME (CLASS-NAME SELF))) (SETF (CLASS-CLASS-PRECEDENCE-LIST SELF) CPL) (UPDATE-SLOTS--STRUCTURE-CLASS SELF CPL) ( DECLAREDATATYPE NAME (CL:MAPCAR (CL:FUNCTION (CL:LAMBDA (X) (IGNORE X) (QUOTE POINTER))) ( CLASS-LOCAL-SLOTS SELF)) NIL NIL (AND LOCAL-SUPERS (CLASS-NAME (CAR LOCAL-SUPERS)))) (EVAL (BQUOTE ( DEFTYPE (\, NAME) NIL (QUOTE (DATATYPE (\, NAME)))))))))) (PUTDEF (QUOTE UPDATE-FROM-LOCALS~STRUCTURE-CLASS~T) (QUOTE METHODS) (QUOTE (DEFMETH UPDATE-FROM-LOCALS ((SELF STRUCTURE-CLASS) OBSOLETE-CLASS) (RUN-SUPER) (LET ((LOCAL-SUPERS ( CLASS-LOCAL-SUPERS SELF))) (HELP) (DECLAREDATATYPE (CLASS-NAME SELF) (CL:MAPCAR (CL:FUNCTION ( CL:LAMBDA (X) (IGNORE X) (QUOTE POINTER))) (CLASS-INSTANCE-SLOTS CLASS)) NIL NIL (AND LOCAL-SUPERS ( CLASS-NAME (CAR LOCAL-SUPERS)))))))) (REMPROP (QUOTE GET-SLOT--STRUCTURE-CLASS-1) (QUOTE SETF-INVERSE)) GET-SLOT--STRUCTURE-CLASS-1-setf-expander D1 (P 13Q NV P 5 GET-SLOT--STRUCTURE-CLASS-1-setf-form P 4 DUMMIES P 3 X I 0 ACCESS-FORM) ‚@@°d»¸IµHhZH&¹µìJa @L½L@OhM__¿O__¿Od^²ggONhgOogOgOoOhM (177Q VALUES 50Q GENSYM 13Q GENSYM) (153Q CL:* 146Q \RPLPTR 134Q CL:* 122Q \DTEST 117Q \RPLPTR) ( 161Q (2) 142Q (2)) (PUTPROPS GET-SLOT--STRUCTURE-CLASS-1 SETF-METHOD-EXPANDER GET-SLOT--STRUCTURE-CLASS-1-setf-expander) expand-GET-SLOT--STRUCTURE-CLASS-1 D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) D@AH¹HZ»Jd\²ggILhgKohgIgKohNIL (66Q CL:* 62Q \GETBASEPTR 43Q CL:* 32Q \DTEST 27Q \GETBASEPTR) ( 73Q (2) 50Q (2)) (SETF-MACRO-FUNCTION (QUOTE GET-SLOT--STRUCTURE-CLASS-1) (QUOTE expand-GET-SLOT--STRUCTURE-CLASS-1)) expand-MDEFSTRUCT D1 (L (1 $$MACRO-ENVIRONMENT 0 $$MACRO-FORM)) &@HYd’d˜oIƒoYgIHNIL (36Q NDEFSTRUCT) ( 31Q ((:CLASS STRUCTURE-CLASS)) 21Q (:CLASS STRUCTURE-CLASS)) (SETF-MACRO-FUNCTION (QUOTE MDEFSTRUCT) (QUOTE expand-MDEFSTRUCT)) STRUCTURE-CONSTRUCTOR D1 (L (0 STRUCTURE-NAME)) $@di ˜¿g@ ÁÉg'µ o@ (41Q CL:ERROR 16Q PACK* 5 CLASS-NAMED) (26Q STRUCTURE-CONSTRUCTOR 12Q MAKE-) ( 35Q "no constructor for ~A structures") UPDATE-SLOTS--STRUCTURE-CLASS D1 (L (1 CPL 0 CLASS)) B @d hA H¹Hº@¼I »LK ¿@¾I½NM ¿@_¿J_¿OO g(74Q CLASS-NON-INSTANCE-SLOTS% :SETF-discriminator 54Q CLASS-INSTANCE-SLOTS% :SETF-discriminator 42Q CLASS-NO-OF-INSTANCE-SLOTS% :SETF-discriminator 34Q LENGTH 14Q \MVLIST 11Q COLLECT-SLOTDS 4 CLASS-LOCAL-SLOTS) (77Q WHEN) () (PUTPROPS STRUCTURE-CLASS FILETYPE COMPILE-FILE) STOP