Function: oclosure--defstruct-make-copiers

oclosure--defstruct-make-copiers is a byte-compiled function defined in oclosure.el.gz.

Signature

(oclosure--defstruct-make-copiers COPIERS SLOTDESCS NAME)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/oclosure.el.gz
(defun oclosure--defstruct-make-copiers (copiers slotdescs name)
  (require 'cl-macs)            ;`cl--arglist-args' is not autoloaded.
  (let* ((mutables '())
         (slots (mapcar
                 (lambda (desc)
                   (let ((name (cl--slot-descriptor-name desc)))
                     (when (oclosure--slot-mutable-p desc)
                       (push name mutables))
                     name))
                 slotdescs)))
    (mapcar
     (lambda (copier)
       (pcase-let*
           ((cname (pop copier))
            (args (or (pop copier) `(&key ,@slots)))
            (inline (and (eq :inline (car copier)) (pop copier)))
            (doc (or (pop copier)
                     (format "Copier for objects of type `%s'." name)))
            (obj (make-symbol "obj"))
            (absent (make-symbol "absent"))
            (anames (cl--arglist-args args))
            (mnames
             (let ((res '())
                   (tmp args))
               (while (and tmp
                           (not (memq (car tmp)
                                      cl--lambda-list-keywords)))
                 (push (pop tmp) res))
               res))
            (index -1)
            (mutlist '())
            (argvals
             (mapcar
	      (lambda (slot)
                (setq index (1+ index))
                (let* ((mutable (memq slot mutables))
                       (get `(oclosure--get ,obj ,index ,(not (not mutable)))))
                  (push mutable mutlist)
		  (cond
		   ((not (memq slot anames)) get)
		   ((memq slot mnames) slot)
		   (t
		    `(if (eq ',absent ,slot)
                         ,get
		       ,slot)))))
	      slots)))
	 `(,(if inline 'cl-defsubst 'cl-defun) ,cname
               (&cl-defs (',absent) ,obj ,@args)
            ,doc
            (declare (side-effect-free t))
            (oclosure--copy ,obj ',(if (remq nil mutlist) (nreverse mutlist))
                       ,@argvals))))
     copiers)))