X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/4307347660f48628e307f299eb4fac58ba35fd1a..a42893dda5f4dd2b89fbfe4e497da261159225ca:/src/class-make-impl.lisp

diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp
index 5b8baf0..bd2407e 100644
--- a/src/class-make-impl.lisp
+++ b/src/class-make-impl.lisp
@@ -89,41 +89,37 @@
 ;;; Slot initializers.
 
 (defmethod make-sod-instance-initializer
-    ((class sod-class) nick name value-kind value-form pset
-     &optional location)
+    ((class sod-class) nick name value pset &optional location)
   (with-default-error-location (location)
     (let* ((slot (find-instance-slot-by-name class nick name))
-	   (initializer (make-sod-initializer-using-slot
-			 class slot 'sod-instance-initializer
-			 value-kind value-form pset
-			 (file-location location))))
+	   (initializer (and value
+			     (make-sod-initializer-using-slot
+			      class slot 'sod-instance-initializer
+			      value pset (file-location location)))))
       (with-slots (instance-initializers) class
+
 	(setf instance-initializers
 	      (append instance-initializers (list initializer))))
       initializer)))
 
 (defmethod make-sod-class-initializer
-    ((class sod-class) nick name value-kind value-form pset
-     &optional location)
+    ((class sod-class) nick name value pset &optional location)
   (with-default-error-location (location)
     (let* ((slot (find-class-slot-by-name class nick name))
 	   (initializer (make-sod-initializer-using-slot
 			 class slot 'sod-class-initializer
-			 value-kind value-form pset
-			 (file-location location))))
+			 value pset (file-location location))))
       (with-slots (class-initializers) class
 	(setf class-initializers
 	      (append class-initializers (list initializer))))
       initializer)))
 
 (defmethod make-sod-initializer-using-slot
-    ((class sod-class) (slot sod-slot)
-     init-class value-kind value-form pset location)
+    ((class sod-class) (slot sod-slot) init-class value pset location)
   (make-instance (get-property pset :initializer-class :symbol init-class)
 		 :class class
 		 :slot slot
-		 :value-kind value-kind
-		 :value-form value-form
+		 :value value
 		 :location (file-location location)
 		 :pset pset))
 
@@ -137,6 +133,21 @@
   nil)
 
 ;;;--------------------------------------------------------------------------
+;;; 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)))))
+
+;;;--------------------------------------------------------------------------
 ;;; Messages.
 
 (defmethod make-sod-message