+(defmethod make-sod-user-initarg
+ ((class sod-class) name type pset &optional default location)
+ (declare (ignore pset))
+ (with-slots (initargs) class
+ (push (make-instance '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 &optional location)
+ (let ((slot (find-instance-slot-by-name class nick slot-name)))
+ (make-sod-slot-initarg-using-slot class name slot pset location)))
+
+(defmethod make-sod-slot-initarg-using-slot
+ ((class sod-class) name (slot sod-slot) pset &optional location)
+ (declare (ignore pset))
+ (with-slots (initargs) class
+ (with-slots ((type %type)) slot
+ (push (make-instance 'sod-slot-initarg
+ :location (file-location location)
+ :class class :name name :type type :slot slot)
+ initargs))))
+
+(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 &optional 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 &optional location)
+ (declare (ignore pset location))
+ (with-slots (tearfrags) class
+ (setf tearfrags (append tearfrags (list frag)))))
+