(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
(FILECREATED "16-Oct-88 17:32:07" {ERIS}<LISPCORE>PATCHES>SOURCES>AR-10885-PATCH.\;3 2970   

      |changes| |to:|  (VARS AR-10885-PATCHCOMS)

      |previous| |date:| "16-Oct-88 17:20:55" {ERIS}<LISPCORE>PATCHES>SOURCES>AR-10885-PATCH.\;1)


(PRETTYCOMPRINT AR-10885-PATCHCOMS)

(RPAQQ AR-10885-PATCHCOMS (
                               (* |;;| 
                             "Patch file AR-10885-PATCH.  Contains fixes for the AR(s) (10885).")

                               (ADDVARS (*FEATURES* :AR-10885))
                               (FUNCTIONS CL::DEFSTRUCT-SHARED-SETF-EXPANDER)
                               (PROP FILETYPE AR-10885-PATCH)))



(* |;;| "Patch file AR-10885-PATCH.  Contains fixes for the AR(s) (10885).")


(ADDTOVAR *FEATURES* :AR-10885)

(CL::DEFINE-SHARED-SETF-MACRO CL::DEFSTRUCT-SHARED-SETF-EXPANDER CL::ACCESSOR (CL::DATUM) (
                                                                                        CL::NEW-VALUE
                                                                                               )

   (* |;;| "Shared setf expander for all defstruct slot accessors ")

   (LET ((CL::SLOT-INFO (CL:GETHASH CL::ACCESSOR CL::*DEFSTRUCT-INFO-CACHE*)))
        (CL:WHEN (NULL CL::SLOT-INFO)
            (CL:SETQ CL::SLOT-INFO (CL::CACHE-SLOT-INFO CL::ACCESSOR)))
        (DESTRUCTURING-BIND
         (TYPE CL::SLOT CL::FAST-ACCESSSOR-P)
         CL::SLOT-INFO
         (LET ((CL::DESCRIPTOR (CL::PSLOT-FIELD-DESCRIPTOR CL::SLOT)))
              (CL:ECASE TYPE
                  (CL::DATATYPE `(,(CL:IF CL::FAST-ACCESSSOR-P
                                       'FREPLACEFIELD
                                       'REPLACEFIELD)
                                  ',CL::DESCRIPTOR
                                  ,CL::DATUM
                                  ,CL::NEW-VALUE))
                  (LIST `(CL:SETF (CL:NTH ,CL::DESCRIPTOR ,CL::DATUM)
                                ,CL::NEW-VALUE))
                  (CL:VECTOR (CL:MACROLET ((CL::SIMPLE-P (CL::X)
                                                  `(OR (CL:SYMBOLP ,CL::X)
                                                       (CL:CONSTANTP ,CL::X))))
                                    (CL:IF (AND (CL::SIMPLE-P CL::DATUM)
                                                (CL::SIMPLE-P CL::NEW-VALUE))
                                        `(ASET ,CL::NEW-VALUE ,CL::DATUM ,CL::DESCRIPTOR)
                                        (LET ((CL::D (CL:GENSYM))
                                              (CL::V (CL:GENSYM)))
                                             `(LET ((,CL::D ,CL::DATUM)
                                                    (,CL::V ,CL::NEW-VALUE))
                                                   (ASET ,CL::V ,CL::D ,CL::DESCRIPTOR)))))))))))

(PUTPROPS AR-10885-PATCH FILETYPE :COMPILE-FILE)
(DECLARE\: DONTCOPY
  (FILEMAP (NIL)))
STOP