2012-06-16 30 views
6

Tôi đang tìm cách sao chép các đối tượng CLOS theo cách nông, vì vậy đối tượng đã tạo sẽ có cùng loại với cùng giá trị trong mỗi vị trí, nhưng một thể hiện mới. Điều gần nhất tôi tìm thấy là một bản sao chức năng tiêu chuẩn-cấu trúc mà thực hiện điều này cho các cấu trúc.Có phương pháp chung để nhân bản các đối tượng CLOS không?

Trả lời

10

Không có cách nào được xác định trước để sao chép các đối tượng CLOS nói chung. Nó không phải là tầm thường, nếu có thể, để cung cấp một hoạt động sao chép mặc định hợp lý làm điều đúng (ít nhất) phần lớn thời gian cho các đối tượng tùy ý, vì ngữ nghĩa chính xác thay đổi từ lớp này sang lớp khác và từ ứng dụng sang ứng dụng. Các khả năng mở rộng mà MOP cung cấp làm cho nó khó khăn hơn để cung cấp một mặc định như vậy. Ngoài ra, trong CL, là một ngôn ngữ thu thập rác, việc sao chép các đối tượng không thực sự cần thiết thường xuyên, ví dụ: khi được chuyển thành tham số hoặc được trả về. Vì vậy, việc triển khai các hoạt động sao chép của bạn khi cần có lẽ sẽ là giải pháp sạch nhất.

Điều đó đang được nói, đây là những gì tôi tìm thấy trong một file đoạn của tôi, mà có thể làm những gì bạn muốn:

(defun shallow-copy-object (original) 
    (let* ((class (class-of original)) 
     (copy (allocate-instance class))) 
    (dolist (slot (mapcar #'slot-definition-name (class-slots class))) 
     (when (slot-boundp original slot) 
     (setf (slot-value copy slot) 
       (slot-value original slot)))) 
    copy)) 

Bạn sẽ cần một số hỗ trợ cho MOP class-slotsslot-definition-name.

(tôi có lẽ thông qua này từ an old c.l.l thread, nhưng tôi không thể nhớ tôi không bao giờ thực sự cần một cái gì đó như thế này, vì vậy nó hoàn toàn chưa được kiểm tra..)

Bạn có thể sử dụng nó như thế này (thử nghiệm với CCL):

CL-USER> (defclass foo() 
      ((x :accessor x :initarg :x) 
      (y :accessor y :initarg :y))) 
#<STANDARD-CLASS FOO> 
CL-USER> (defmethod print-object ((obj foo) stream) 
      (print-unreadable-object (obj stream :identity t :type t) 
      (format stream ":x ~a :y ~a" (x obj) (y obj)))) 
#<STANDARD-METHOD PRINT-OBJECT (FOO T)> 
CL-USER> (defparameter *f* (make-instance 'foo :x 1 :y 2)) 
*F* 
CL-USER> *f* 
#<FOO :x 1 :y 2 #xC7E5156> 
CL-USER> (shallow-copy-object *f*) 
#<FOO :x 1 :y 2 #xC850306> 
+5

Có thể hữu ích khi thêm kiểm tra nếu vị trí bị ràng buộc hay không. Sau đó chỉ truy cập vào giá trị khe, nếu khe bị ràng buộc. –

+1

Bạn nói đúng - tôi đã thêm bài kiểm tra. Cảm ơn! – danlei

+1

Hoạt động như được quảng cáo. Dưới đây là một tuyên bố nhập khẩu nên làm cho nó hoạt động theo cách di động nhiều hơn hoặc ít hơn: '(: shadowing-import-from \t # + openmcl-native-threads #: ccl \t # + cmu #: pcl \t # + sbcl #: sb-PCL \t # + lispworks #: hcl \t # + allegro #: lau \t # + CLISP #: clos \t #: đẳng cấp khe #: khe nét-tên) '. – Inaimathi

4

Đây là phiên bản hơi khác của hàm do danlei gửi. Tôi đã viết điều này một thời gian trước đây và chỉ tình cờ gặp bài đăng này. Vì lý do mà tôi không hoàn toàn nhớ lại, điều này gọi REINITIALIZE-INSTANCE sau khi sao chép. Tôi nghĩ rằng để bạn có thể thực hiện một số thay đổi đối với đối tượng mới bằng cách chuyển các initarg bổ sung cho hàm này

ví dụ:

(copy-instance *my-account* :balance 100.23) 

Điều này cũng được định nghĩa là chức năng chung cho các đối tượng 'đối tượng tiêu chuẩn'. Mà có thể hoặc có thể không phải là điều đúng để làm.

(defgeneric copy-instance (object &rest initargs &key &allow-other-keys) 
    (:documentation "Makes and returns a shallow copy of OBJECT. 

    An uninitialized object of the same class as OBJECT is allocated by 
    calling ALLOCATE-INSTANCE. For all slots returned by 
    CLASS-SLOTS, the returned object has the 
    same slot values and slot-unbound status as OBJECT. 

    REINITIALIZE-INSTANCE is called to update the copy with INITARGS.") 
    (:method ((object standard-object) &rest initargs &key &allow-other-keys) 
    (let* ((class (class-of object)) 
      (copy (allocate-instance class))) 
     (dolist (slot-name (mapcar #'sb-mop:slot-definition-name (sb-mop:class-slots class))) 
     (when (slot-boundp object slot-name) 
      (setf (slot-value copy slot-name) 
      (slot-value object slot-name)))) 
     (apply #'reinitialize-instance copy initargs)))) 
+1

Chính xác những gì tôi đang tìm kiếm; Tôi đã ngạc nhiên điều này không tồn tại theo mặc định trong Common Lisp. – MicroVirus

Các vấn đề liên quan