src/: Abolish the distinction between different kinds of initializers.

[sod] / src / class-make-proto.lisp

diff --git a/src/class-make-proto.lisp b/src/class-make-proto.lisp
index 8b024bd83e8b08dc880c1a8ff9ed884d042b08c0..b10c29817324e4d7dc4ceb216fbe47ecf888919c 100644 (file)
--- a/src/class-make-proto.lisp
+++ b/src/class-make-proto.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -59,14 +59,6 @@ (defun make-sod-class (name superclasses pset &optional location)
                                 :pset pset)))
       class)))
 
-(export 'guess-metaclass)
-(defgeneric guess-metaclass (class)
-  (:documentation
-   "Determine a suitable metaclass for the CLASS.
-
-   The default behaviour is to choose the most specific metaclass of any of
-   the direct superclasses of CLASS, or to signal an error if that failed."))
-
 ;;;--------------------------------------------------------------------------
 ;;; Slots and slot initializers.
 
@@ -85,7 +77,7 @@ (defgeneric make-sod-slot (class name type pset &optional location)
 
 (export 'make-sod-instance-initializer)
 (defgeneric make-sod-instance-initializer
-    (class nick name value-kind value-form pset &optional location)
+    (class nick name value pset &optional location)
   (:documentation
    "Construct and attach an instance slot initializer, to CLASS.
 
@@ -98,7 +90,7 @@ (defgeneric make-sod-instance-initializer
 
 (export 'make-sod-class-initializer)
 (defgeneric make-sod-class-initializer
-    (class nick name value-kind value-form pset &optional location)
+    (class nick name value pset &optional location)
   (:documentation
    "Construct and attach a class slot initializer, to CLASS.
 
@@ -111,7 +103,7 @@ (defgeneric make-sod-class-initializer
 
 (export 'make-sod-initializer-using-slot)
 (defgeneric make-sod-initializer-using-slot
-    (class slot init-class value-kind value-form pset location)
+    (class slot init-class value pset location)
   (:documentation
    "Common construction protocol for slot initializers.
 
@@ -214,74 +206,4 @@ (defgeneric check-method-type (method message type)
    This is separated out of `shared-initialize', where it's called, so that
    it can be overridden conveniently by subclasses."))
 
-;;;--------------------------------------------------------------------------
-;;; Builder macros.
-
-(export 'define-sod-class)
-(defmacro define-sod-class (name (&rest superclasses) &body body)
-  "Construct a new SOD class called NAME in the current module.
-
-   The new class has the named direct SUPERCLASSES, which should be a list of
-   strings.
-
-   The BODY begins with a sequence of alternating keyword/value pairs
-   defining properties for the new class.  The keywords are (obviously) not
-   evaluated, but the value forms are.
-
-   The remainder of the BODY are a sequence of forms to be evaluated as an
-   implicit `progn'.  Additional macros are available to the BODY, to make
-   defining the class easier.
-
-   In the following, NAME is a string giving a C identifier; NICK is a string
-   giving the nickname of a superclass; TYPE is a C type using S-expression
-   notation.
-
-     * message NAME TYPE &rest PLIST
-
-     * method NICK NAME TYPE BODY &rest PLIST
-
-     * slot NAME TYPE &rest PLIST
-
-     * instance-initializer NICK NAME VALUE-KIND VALUE-FORM &rest PLIST
-
-     * class-initializer NICK NAME VALUE-KIND VALUE-FORM &rest PLIST"
-
-  (let ((plist nil)
-       (classvar (gensym "CLASS-")))
-    (loop
-      (when (or (null body)
-               (not (keywordp (car body))))
-       (return))
-      (push (pop body) plist)
-      (push (pop body) plist))
-    `(let ((,classvar (make-sod-class ,name
-                                     (mapcar #'find-sod-class
-                                             (list ,@superclasses))
-                                     (make-property-set
-                                      ,@(nreverse plist)))))
-       (macrolet ((message (name type &rest plist)
-                   `(make-sod-message ,',classvar ,name (c-type ,type)
-                                      (make-property-set ,@plist)))
-                 (method (nick name type body &rest plist)
-                   `(make-sod-method ,',classvar ,nick ,name (c-type ,type)
-                                     ,body (make-property-set ,@plist)))
-                 (slot (name type &rest plist)
-                   `(make-sod-slot ,',classvar ,name (c-type ,type)
-                                   (make-property-set ,@plist)))
-                 (instance-initializer
-                     (nick name value-kind value-form &rest plist)
-                   `(make-sod-instance-initializer ,',classvar ,nick ,name
-                                                   ,value-kind ,value-form
-                                                   (make-property-set
-                                                    ,@plist)))
-                 (class-initializer
-                     (nick name value-kind value-form &rest plist)
-                   `(make-sod-class-initializer ,',classvar ,nick ,name
-                                                ,value-kind ,value-form
-                                                (make-property-set
-                                                 ,@plist))))
-        ,@body
-        (finalize-sod-class ,classvar)
-        (add-to-module *module* ,classvar)))))
-
 ;;;----- That's all, folks --------------------------------------------------