+(defmethod make-sod-user-initarg
+ ((class sod-class) name type pset &key default location)
+ (with-slots (initargs) class
+ (push (make-instance (get-property pset :initarg-class :symbol
+ 'sod-user-initarg)
+ :location (file-location location)
+ :class class :name name :type type :default default)
+ initargs)))
+
+(defmethod make-sod-slot-initarg
+ ((class sod-class) name nick slot-name pset &key location)
+ (let ((slot (find-instance-slot-by-name class nick slot-name)))
+ (make-sod-slot-initarg-using-slot class name slot pset
+ :location location)))
+
+(defmethod make-sod-slot-initarg-using-slot
+ ((class sod-class) name (slot sod-slot) pset &key location)
+ (with-slots (initargs) class
+ (with-slots ((type %type)) slot
+ (setf initargs
+ (append initargs
+ (cons (make-instance (get-property pset :initarg-class
+ :symbol
+ 'sod-slot-initarg)
+ :location (file-location location)
+ :class class :name name
+ :type type :slot slot)
+ nil))))))
+
+(defmethod sod-initarg-default ((initarg sod-initarg)) nil)
+
+(defmethod sod-initarg-argument ((initarg sod-initarg))
+ (make-argument (sod-initarg-name initarg)
+ (sod-initarg-type initarg)
+ (sod-initarg-default initarg)))
+
+;;;--------------------------------------------------------------------------
+;;; Initialization and teardown fragments.
+
+(defmethod make-sod-class-initfrag
+ ((class sod-class) frag pset &key location)
+ (declare (ignore pset location))
+ (with-slots (initfrags) class
+ (setf initfrags (append initfrags (list frag)))))
+
+(defmethod make-sod-class-tearfrag
+ ((class sod-class) frag pset &key location)
+ (declare (ignore pset location))
+ (with-slots (tearfrags) class
+ (setf tearfrags (append tearfrags (list frag)))))
+