Common Lisp does not have a generic copy function for reasons outlined in Kent Pitman's article The Best of Intentions. However, it may still be convenient for rapid prototyping purposes to provide such a function that would recursively copy any given lisp object down to its immutable core objects. In the initial stages of development, this could obviate the need to write or import specialized copiers for complex sequences, arrays, hash tables, and structures.
The following generic methods attempt to specify a function called ucopy
(for universal copy) that implements universal recursive copying. An example of use might be to copy an array composed of structures containing a hash table: (setq array1 (ucopy array0))
. As this is my first attempt at writing a library(?), I would appreciate corrections, improvements, or any other instructive comments. Thanks.
;;;; Filename: universal-copy.lisp
;;; Deep (recursive) copy of a Common Lisp object.
;;; For example, (ucopy array0) where array0 is an array of structures.
;;; Assumes MOP is loaded.
(defmethod ucopy ((sym symbol))
"Simply return the symbol."
sym)
(defmethod ucopy ((num number))
"Simply return the number."
num)
(defmethod ucopy ((char character))
"Simply return the character."
char)
(defmethod ucopy ((fn function))
"Simply return the function."
fn)
(defmethod ucopy ((path pathname))
"Simply return the path."
path)
(defmethod ucopy ((seq sequence))
"Copy a sequence recursively."
(map (type-of seq) #'ucopy seq))
(defmethod ucopy ((ht hash-table))
"Copy a hash table recursively."
(loop with new-ht = (make-hash-table
:test (hash-table-test ht)
:size (hash-table-size ht)
:rehash-size (hash-table-rehash-size ht)
:rehash-threshold (hash-table-rehash-threshold ht))
for key being the hash-key in ht using (hash-value value)
do (setf (gethash (ucopy key) new-ht) (ucopy value))
finally (return new-ht)))
(defmethod ucopy ((arr array))
"Copy an array recursively."
(let ((new-arr (make-array (array-dimensions arr)
:element-type (array-element-type arr)
:adjustable (adjustable-array-p arr))))
(dotimes (i (array-total-size arr))
(setf (row-major-aref new-arr i)
(ucopy (row-major-aref arr i))))
new-arr))
(defmethod ucopy ((struct structure-object))
"Copy a structure recursively."
(let ((new-struct (copy-structure struct))
(slots (class-direct-slots (class-of struct))))
(dolist (slot slots)
(let ((slot-name (slot-definition-name slot)))
(setf (slot-value new-struct slot-name)
(ucopy (slot-value struct slot-name)))))
new-struct))
(defmethod ucopy ((inst standard-object))
"Copy an instance of a class recursively."
(let ((new-inst (allocate-instance (class-of inst)))
(slots (class-direct-slots (class-of inst))))
(dolist (slot slots)
(let ((slot-name (slot-definition-name slot)))
(when (slot-boundp inst slot-name)
(setf (slot-value new-inst slot-name)
(ucopy (slot-value inst slot-name))))))
new-inst))
1 Answer 1
Given the restrictions you outline that seems sensible, I also couldn't
find a CDR for it (in contrast to an extensible equality operator for
example), however I'd probably try to find a better name than UCOPY
.
Also, since you often might have to choose between shallow and deep
copies, perhaps introduce a parameter for that.
The method for STRUCTURE-OBJECT
isn't guaranteed to work, so it might
be more advisable to leave out that method and require the user to
implement them by hand.
Rest looks fine to me.
-
\$\begingroup\$ Yes, a more descriptive name like
deep-copy
seems better. Also, didn't realizestructure-object
was not portable, thanks. Could a reader macro like#+sbcl
fix this? \$\endgroup\$davypough– davypough2017年03月12日 23:45:36 +00:00Commented Mar 12, 2017 at 23:45 -
\$\begingroup\$ Just to clarify, accessing the slots this way on things defined by
defstruct
is not specified by ANSI CL, though implementations frequently support it on (non-list/vector) structures. I really don't know if it's a stable guaranteed feature in e.g. SBCL, you might have to ask the devs (in which case a reader conditional would be fine of course). \$\endgroup\$ferada– ferada2017年03月13日 07:33:45 +00:00Commented Mar 13, 2017 at 7:33