+(defmethod make-load-form ((object cstruct-inline-slot-description) &optional environment)
+ (make-load-form-saving-slots object :environment environment))
+
+(defstruct cstruct-description
+ name
+ slots)
+
+(defmethod make-load-form ((object cstruct-description) &optional environment)
+ (make-load-form-saving-slots object :environment environment))
+
+(defun parse-cstruct-slot (slot)
+ (destructuring-bind (name type &key count initform inline) slot
+ (if inline
+ (make-cstruct-inline-slot-description :name name :type (generated-cunion-name type)
+ :count count :initform initform :inline-p inline
+ :boxed-type-name type)
+ (make-cstruct-inline-slot-description :name name :type type
+ :count count :initform initform :inline-p inline))))
+
+(defun parse-cstruct-definition (name slots)
+ (make-cstruct-description :name name
+ :slots (mapcar #'parse-cstruct-slot slots)))
+
+(defmacro define-g-boxed-cstruct (name g-type-name &body slots)
+ (let ((cstruct-description (parse-cstruct-definition name slots))
+ (cstruct-name (generated-cstruct-name name))
+ (cunion-name (generated-cunion-name name)))
+ `(progn
+ (defstruct ,name
+ ,@(iter (for slot in (cstruct-description-slots cstruct-description))
+ (for name = (cstruct-slot-description-name slot))
+ (for initform = (cstruct-slot-description-initform slot))
+ (collect (list name initform))))
+ (defcstruct ,cstruct-name
+ ,@(iter (for slot in (cstruct-description-slots cstruct-description))
+ (for name = (cstruct-slot-description-name slot))
+ (for type = (cstruct-slot-description-type slot))
+ (for count = (cstruct-slot-description-count slot))
+ (collect `(,name ,type ,@(when count `(:count ,count))))))
+ (defctype ,cstruct-name (:struct ,cstruct-name))
+ (defcunion ,cunion-name
+ (,name ,cstruct-name))
+ (defctype ,cunion-name (:union ,cunion-name))
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf (get ',name 'g-boxed-foreign-info)
+ (make-g-boxed-cstruct-wrapper-info :name ',name
+ :g-type ,g-type-name
+ :cstruct-description ,cstruct-description)
+ (gethash ,g-type-name *g-type-name->g-boxed-foreign-info*)
+ (get ',name 'g-boxed-foreign-info)
+ (get ',name 'structure-constructor)
+ ',(intern (format nil "MAKE-~A" (symbol-name name)) (symbol-package name)))))))
+
+(defmethod make-foreign-type ((info g-boxed-cstruct-wrapper-info) &key return-p)
+ (make-instance 'boxed-cstruct-foreign-type :info info :return-p return-p))
+
+(defun memcpy (target source bytes)
+ (iter (for i from 0 below bytes)
+ (setf (mem-aref target :uchar i)
+ (mem-aref source :uchar i))))
+
+(defmethod boxed-copy-fn ((info g-boxed-cstruct-wrapper-info) native)
+ (if (g-boxed-info-g-type info)
+ (g-boxed-copy (g-boxed-info-g-type info) native)
+ (let ((copy (foreign-alloc (generated-cstruct-name (g-boxed-info-name info)))))
+ (memcpy copy native (foreign-type-size (generated-cstruct-name (g-boxed-info-name info))))
+ copy)))
+
+(defmethod boxed-free-fn ((info g-boxed-cstruct-wrapper-info) native)
+ (if (g-boxed-info-g-type info)
+ (g-boxed-free (g-boxed-info-g-type info) native)
+ (foreign-free native)))
+
+(defun copy-slots-to-native (proxy native cstruct-description)
+ (iter (with cstruct-type = (generated-cstruct-name (cstruct-description-name cstruct-description)))
+ (for slot in (cstruct-description-slots cstruct-description))
+ (for slot-name = (cstruct-slot-description-name slot))
+ (cond
+ ((cstruct-slot-description-count slot)
+ (iter (with ptr = (foreign-slot-pointer native cstruct-type slot-name))
+ (with array = (slot-value proxy slot-name))
+ (for i from 0 below (cstruct-slot-description-count slot))
+ (setf (mem-aref ptr (cstruct-slot-description-type slot) i)
+ (aref array i))))
+ ((cstruct-slot-description-inline-p slot)
+ (let ((info (get-g-boxed-foreign-info (cstruct-inline-slot-description-boxed-type-name slot))))
+ (copy-slots-to-native (slot-value proxy slot-name)
+ (foreign-slot-pointer native cstruct-type slot-name)
+ (g-boxed-cstruct-wrapper-info-cstruct-description info))))
+ (t
+ (setf (foreign-slot-value native cstruct-type slot-name)
+ (slot-value proxy slot-name))))))
+
+(defun create-structure (structure-name)
+ (let ((constructor (get structure-name 'structure-constructor)))
+ (assert constructor nil "Don't know how to create structure of type ~A" structure-name)
+ (funcall constructor)))
+
+(defun copy-slots-to-proxy (proxy native cstruct-description)
+ (iter (with cstruct-type = (generated-cstruct-name (cstruct-description-name cstruct-description)))
+ (for slot in (cstruct-description-slots cstruct-description))
+ (for slot-name = (cstruct-slot-description-name slot))
+ (cond
+ ((cstruct-slot-description-count slot)
+ (setf (slot-value proxy slot-name) (make-array (list (cstruct-slot-description-count slot))))
+ (iter (with ptr = (foreign-slot-pointer native cstruct-type slot-name))
+ (with array = (slot-value proxy slot-name))
+ (for i from 0 below (cstruct-slot-description-count slot))
+ (setf (aref array i)
+ (mem-aref ptr (cstruct-slot-description-type slot) i))))
+ ((cstruct-slot-description-inline-p slot)
+ (let ((info (get-g-boxed-foreign-info (cstruct-inline-slot-description-boxed-type-name slot))))
+ (setf (slot-value proxy slot-name) (create-structure (cstruct-inline-slot-description-boxed-type-name slot)))
+ (copy-slots-to-proxy (slot-value proxy slot-name)
+ (foreign-slot-pointer native cstruct-type slot-name)
+ (g-boxed-cstruct-wrapper-info-cstruct-description info))))
+ (t (setf (slot-value proxy slot-name)
+ (foreign-slot-value native cstruct-type slot-name))))))
+
+(defmethod translate-to-foreign (proxy (type boxed-cstruct-foreign-type))
+ (if (null proxy)
+ (null-pointer)
+ (let* ((info (g-boxed-foreign-info type))
+ (native-structure-type (generated-cstruct-name (g-boxed-info-name info))))
+ (with-foreign-object (native-structure native-structure-type)
+ (copy-slots-to-native proxy native-structure (g-boxed-cstruct-wrapper-info-cstruct-description info))
+ (values (boxed-copy-fn info native-structure) proxy)))))
+
+(defmethod free-translated-object (native-structure (type boxed-cstruct-foreign-type) proxy)