Replace the `init' class-slot function with an `init' message.

The `SodObject' class now defines an `init' message.  This message takes
keywords, which can be collected by methods and used to set up objects
in interesting ways.

The `init' message's default behaviour (unless overridden by a primary
or around method) is to initialize the instance's slots using the most
specific applicable initializers, just as the old `init' function used
to do.

Obviously, one can send an `init' message to an instance before it's
been imprinted, so that has to be done as a separate step now.  The
`SOD_DECL' macro has been adjusted to cope.  It also takes an additional
argument containing keyword arguments to be passed with the `init'
message (which constitutes an additional compatibility break).

The library has grown a new pair of functions `sod_init' and `sod_initv'
which wrap up the initialization protocol, and a macro `SOD_INIT' which
improves type safety a little.

(Some of the new code in `src/builtin.lisp' is a little odd.  This is
intended to accommodate future changes better.)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 06e2002..2acfd60 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -879,6 +879,7 @@ effective-method-function-name
 effective-method-keywords
   effective-method
 effective-method-live-p
 effective-method-keywords
   effective-method
 effective-method-live-p

+  sod::lifecycle-effective-method

   simple-effective-method
 effective-method-message
   effective-method
   simple-effective-method
 effective-method-message
   effective-method


@@ -1310,6 +1311,7 @@ cl:shared-initialize
   sod-token-scanner t
 simple-method-body
   aggregating-effective-method t t
   sod-token-scanner t
 simple-method-body
   aggregating-effective-method t t

+  sod::lifecycle-effective-method t t

   standard-effective-method t t
 cl:slot-unbound
   t basic-direct-method (eql sod::function-type)
   standard-effective-method t t
 cl:slot-unbound
   t basic-direct-method (eql sod::function-type)


@@ -1381,6 +1383,7 @@ sod-message-combination
   aggregating-message
 sod-message-effective-method-class
   aggregating-message
   aggregating-message
 sod-message-effective-method-class
   aggregating-message

+  sod::initialization-message

   standard-message
 sod-message-kernel-function
   aggregating-message
   standard-message
 sod-message-kernel-function
   aggregating-message

diff --git a/doc/concepts.tex b/doc/concepts.tex
index 1663939..39cccb8 100644 (file)
--- a/doc/concepts.tex
+++ b/doc/concepts.tex
@@ -388,7 +388,8 @@ Keyword arguments can be provided in three ways.
 
 Keyword arguments are provided as a general feature for C functions.
 However, Sod has special support for messages which accept keyword arguments
 
 Keyword arguments are provided as a general feature for C functions.
 However, Sod has special support for messages which accept keyword arguments

-(\xref{sec:concepts.methods.keywords}).
+(\xref{sec:concepts.methods.keywords}); and they play an essential role in
+the instance construction protocol (\xref{sec:concepts.lifecycle.birth}).

 
 %%%--------------------------------------------------------------------------
 \section{Messages and methods} \label{sec:concepts.methods}
 
 %%%--------------------------------------------------------------------------
 \section{Messages and methods} \label{sec:concepts.methods}


@@ -654,8 +655,10 @@ Construction of a new instance of a class involves three steps.
   necessary.
 \end{enumerate}
 The \descref{SOD_DECL}[macro]{mac} handles constructing instances with
   necessary.
 \end{enumerate}
 The \descref{SOD_DECL}[macro]{mac} handles constructing instances with

-automatic storage duration (`on the stack').  Currently, there is no built-in
-support for constructing dynamically-allocated instances.
+automatic storage duration (`on the stack').  Programmers can add support for
+other allocation strategies by using the \descref{SOD_INIT}[macro]{mac} and
+the \descref{sod_init}{fun} and \descref{sod_initv}{fun} functions, which
+package up imprinting and initialization.

 
 \subsubsection{Allocation}
 Instances of most classes (specifically including those classes defined by
 
 \subsubsection{Allocation}
 Instances of most classes (specifically including those classes defined by


@@ -724,31 +727,42 @@ Details of initialization are necessarily class-specific, but typically it
 involves setting the instance's slots to appropriate values, and possibly
 linking it into some larger data structure to keep track of it.
 
 involves setting the instance's slots to appropriate values, and possibly
 linking it into some larger data structure to keep track of it.
 

-Classes can declare initial values for their slots.  A class object's @|init|
-slot points to a function which will establish the appropriate initial values
-for a new instance's slots.  Slots are not initialized in any particularly
-useful order.
-
-The provided initialization protocol is extremely simplistic; most notably,
-it's not possible to pass parameters into the initialization process.
-Classes which have more complex requirements will need to define and
-implement their own additional (or alternative) protocols.
+Initialization is performed by sending the imprinted instance an @|init|
+message, defined by the @|SodObject| class.  This message uses a nonstandard
+method combination which works like the standard combination, except that the
+\emph{default behaviour}, if there is no overriding method, is to initialize
+the instance's slots using the initializers defined in the class and its
+superclasses.  This default behaviour may be invoked multiple times if some
+method calls on its @|next_method| more than once, unless some other method
+takes steps to prevent this.
+
+The recommended way to add new initialization behaviour is to define @|after|
+methods on the @|init| message.  These will be run after the slot
+initializers have been applied, in reverse precedence order.
+
+Initialization is \emph{parametrized}, so the caller may select from a space
+of possible initial states for the new instance, or to inform the new
+instance about some other objects known to the caller.  Specifically, the
+@|init| message accepts keyword arguments (\xref{sec:concepts.keywords})
+which can be defined and used by methods defined on it.

 
 \subsubsection{Example}
 The following is a simple function, with syntactic-sugar macro, which
 allocate storage for an instance of a class, imprints and initializes it, and
 returns a pointer to the new instance.
 \begin{prog}
 
 \subsubsection{Example}
 The following is a simple function, with syntactic-sugar macro, which
 allocate storage for an instance of a class, imprints and initializes it, and
 returns a pointer to the new instance.
 \begin{prog}

-  void *make_instance(const SodClass *c) \\
+  void *make_instance(const SodClass *c, @|\dots|) \\

   \{ \\ \ind
   \{ \\ \ind

+    va_list ap;

     void *p = malloc(c@->cls.initsz); \\
     if (!p) return (0); \\
     void *p = malloc(c@->cls.initsz); \\
     if (!p) return (0); \\

-    c@->cls.imprint(p); \\
-    c@->cls.init(p); \\
+    va_start(ap, c); \\
+    sod_initv(c, p, ap); \\
+    va_end(ap); \\

     return (p); \- \\
   \}
   \\+
     return (p); \- \\
   \}
   \\+

-  \#define MAKE(cls) (cls *)make_instance(cls\#\#__class)
+  \#define MAKE(cls, keys) (cls *)make_instance(cls\#\#__class, keys)

 \end{prog}
 
 
 \end{prog}
 
 

diff --git a/doc/runtime.tex b/doc/runtime.tex
index 0a44f91..6a1941d 100644 (file)
--- a/doc/runtime.tex
+++ b/doc/runtime.tex
@@ -732,10 +732,42 @@ instance.
 The following macros and functions manage the standard steps along an
 instance's lifecycle.
 
 The following macros and functions manage the standard steps along an
 instance's lifecycle.
 

+\subsubsection{Low-level operations}
+The following macros and functions are agnostic with respect to storage
+allocation strategies.  They don't concern themselves with allocation or
+deallocation, and applications are free to use any suitable mechanism.
+
+\begin{describe*}
+    {\dhead[SOD_INIT]{mac}
+       {@<cls> *SOD_INIT(@<cls>, void *@<p>, @<keywords>);}
+     \dhead[sod_init]{fun}
+       {void *sod_init(const SodClass *@<cls>, void *@<p>, \dots);}
+     \dhead[sod_initv]{fun}
+       {void *sod_initv(const SodClass *@<cls>, void *@<p>, va_list @<ap>);}}
+  Imprints and initializes an instance of a class @<cls> in the storage
+  starting at address~@<p>.
+
+  The direct class for the new instance is specified as a class name to
+  @|SOD_INIT|, or a pointer to a class object to the functions.
+
+  Keyword arguments for the initialization message may be provided.  The
+  @|SOD_INIT| macro expects a single preprocessor-time argument which is
+  a use of one of \descref{KWARGS}{mac} or \descref{NO_KWARGS}{mac}; the
+  @|sod_init| function expects the keywords as a variable-length argument
+  tail; and @|sod_initv| expects the keywords to be passed indirectly,
+  through the captured argument-tail cursor @<ap>.
+
+  The return value is an instance pointer for the class @<cls>; the
+  @|SOD_INIT| macro will have converted it to the correct type, so it should
+  probably be used where possible.  In fact, this is guaranteed to be equal
+  to @<p> by the layout rules described in
+  \xref{sec:structures.layout.instance}.
+\end{describe*}
+

 \subsubsection{Automatic storage duration}
 The following macro constructs an instance with automatic storage duration.
 
 \subsubsection{Automatic storage duration}
 The following macro constructs an instance with automatic storage duration.
 

-\begin{describe}[SOD_DECL]{mac}{SOD_DECL(@<cls>, @<var>);}
+\begin{describe}[SOD_DECL]{mac}{SOD_DECL(@<cls>, @<var>, @<keywords>);}

   Declares and initializes an instance with automatic storage duration.
 
   Given a class name @<cls> and an identifier @<var>, @|SOD_DECL| declares
   Declares and initializes an instance with automatic storage duration.
 
   Given a class name @<cls> and an identifier @<var>, @|SOD_DECL| declares


@@ -744,6 +776,10 @@ The following macro constructs an instance with automatic storage duration.
   up, and slots for which initializers are defined are set to the appropriate
   initial values.
 
   up, and slots for which initializers are defined are set to the appropriate
   initial values.
 

+  Keyword arguments for the initialization message may be provided.  The
+  macro expects a single preprocessor-time argument which is a use of one of
+  \descref{KWARGS}{mac} or \descref{NO_KWARGS}{mac}.
+

   The instance has automatic storage duration: pointers to it will become
   invalid when control exits the scope of the declaration.
 \end{describe}
   The instance has automatic storage duration: pointers to it will become
   invalid when control exits the scope of the declaration.
 \end{describe}

diff --git a/doc/structures.tex b/doc/structures.tex
index c8d9daf..51e71f9 100644 (file)
--- a/doc/structures.tex
+++ b/doc/structures.tex
@@ -105,7 +105,11 @@ recommended.
     \begin{nprog}
       struct SodObject__vt_obj \{ \\ \ind
         const SodClass *_class; \\
     \begin{nprog}
       struct SodObject__vt_obj \{ \\ \ind
         const SodClass *_class; \\

-        size_t _base; \- \\
+        size_t _base; \\
+        struct SodObject__vtmsgs_obj \{ \\ \ind
+          void (*init)(SodObject *me, ...); \\
+          void (*init__v)(SodObject *me, va_list); \- \\
+        \} obj; \- \\

       \};
     \end{nprog} \\
   \end{tabular}
       \};
     \end{nprog} \\
   \end{tabular}


@@ -115,19 +119,48 @@ recommended.
 
 \begin{describe}[SodObject]{cls}
     {[nick = obj, metaclass = SodClass, lisp_metaclass = sod_class] \\
 
 \begin{describe}[SodObject]{cls}
     {[nick = obj, metaclass = SodClass, lisp_metaclass = sod_class] \\

-     class SodObject \{ \}}
+     class SodObject \{ \\ \ind
+       void init(?);
+     \}}

 
 

-  The @|SodObject| class defines no slots or messages.  Because @|SodObject|
-  has no direct superclasses, there is only one chain, and no inherited
-  slots or messages, so the single chain contains only a vtable pointer.
+  The @|SodObject| class defines no slots.  Because @|SodObject| has no
+  direct superclasses, there is only one chain, and no inherited slots or
+  messages, so the single chain contains only a vtable pointer.

 
 

-  Since there are no messages, and @|SodClass| also has only one chain, the
-  vtable contains only the standard class pointer and offset-to-base members.
-  In a direct instance of @|SodObject| (why would you want one?)  the class
-  pointer contains the address of @|SodObject__class| and the offset is zero.
+  Since @|SodClass| also has only one chain, the vtable contains only the
+  standard class pointer and offset-to-base members.  In a direct instance of
+  @|SodObject| (why would you want one?)  the class pointer contains the
+  address of @|SodObject__class| and the offset is zero.

 
   The instance and vtable layout of @|SodObject| is shown in
   \xref{fig:structures.root.sodobject}.
 
   The instance and vtable layout of @|SodObject| is shown in
   \xref{fig:structures.root.sodobject}.

+
+  The following message is defined.
+
+  \begin{describe}[obj.init]{msg}{void init(?);}
+    Initialize a newly allocated instance.
+
+    This message uses a custom method combination which works like the
+    standard method combination except that default behaviour specific to the
+    receiver's direct class is invoked if no primary or around method
+    overrides.  This default behaviour may be invoked multiple times if some
+    method calls on its @|next_method| function more than once.
+
+    This default behaviour is to initialize the instance's slots using the
+    defined slot initializers: each slot is initialized using the most
+    specific applicable initializer, if any.  Slots without an initializer
+    are left uninitialized.
+
+    There are no standard keyword arguments; methods on subclasses are free
+    to introduce their own in the usual way.
+
+    It is usual to provide complex initialization behaviour as @|after|
+    methods.  This ensures that slots have been initialized as necessary
+    before the method executes.
+
+    For more details on instance construction, see
+    \xref{sec:concepts.lifecycle.birth}.
+  \end{describe}

 \end{describe}
 
 
 \end{describe}
 
 


@@ -140,7 +173,6 @@ recommended.
        const char *nick; \\
        size_t initsz; \\
        void *(*imprint)(void *@<p>); \\
        const char *nick; \\
        size_t initsz; \\
        void *(*imprint)(void *@<p>); \\

-       void *(*init)(void *@<p>); \\

        size_t n_supers; \\
        const SodClass *const *supers; \\
        size_t n_cpl; \\
        size_t n_supers; \\
        const SodClass *const *supers; \\
        size_t n_cpl; \\


@@ -154,9 +186,9 @@ recommended.
        size_t islotsz; \- \\
      \}}
 
        size_t islotsz; \- \\
      \}}
 

-  The @|SodClass| class defines no messages, but there are a number of slots.
-  Its only direct superclass is @|SodObject| and so (like its superclass) its
-  vtable is trivial.
+  The @|SodClass| class defines no additional messages , but there are a
+  number of slots.  Its only direct superclass is @|SodObject| and so (like
+  its superclass) its vtable is simple.

 
   The slots defined are as follows.
   \begin{description} \let\makelabel\code
 
   The slots defined are as follows.
   \begin{description} \let\makelabel\code


@@ -173,10 +205,6 @@ recommended.
     the vtable and class pointers are properly initialized, but the slots are
     left untouched.  The function returns its argument @<p>.
 
     the vtable and class pointers are properly initialized, but the slots are
     left untouched.  The function returns its argument @<p>.
 

-  \item[init] A pointer to a function: given a pointer @<p> to an imprinted
-    instance, initialize all of its slots for which initializers are defined.
-    Other slots are left untouched.  The function returns its argument @<p>.
-

   \item[n_supers] The number of direct superclasses.  (This is zero exactly
     in the case of @|SodObject|.)
 
   \item[n_supers] The number of direct superclasses.  (This is zero exactly
     in the case of @|SodObject|.)
 

diff --git a/lib/sod-structs.3 b/lib/sod-structs.3
index 2d4ecd1..6cfbb75 100644 (file)
--- a/lib/sod-structs.3
+++ b/lib/sod-structs.3
@@ -69,6 +69,10 @@ struct sod_vtable {
 struct SodObject__vt_obj {
 \h'2n'const SodClass *_class;
 \h'2n'size_t _base;
 struct SodObject__vt_obj {
 \h'2n'const SodClass *_class;
 \h'2n'size_t _base;

+\h'2n'struct SodObject__vtmsgs_obj {
+\h'4n'void (*init)(SodObject *\fIme\fB, ...);
+\h'4n'void (*init__v)(SodObject *\fIme\fB, va_list);
+\h'2n'} obj;

 };
 
 struct SodObject__ilayout {
 };
 
 struct SodObject__ilayout {


@@ -85,6 +89,10 @@ extern const struct SodClass__ilayout SodObject__classobj;
 struct SodClass__vt_obj {
 \h'2n'const SodClass *_class;
 \h'2n'size_t _base;
 struct SodClass__vt_obj {
 \h'2n'const SodClass *_class;
 \h'2n'size_t _base;

+\h'2n'struct SodClass__vtmsgs_obj {
+\h'4n'void (*init)(SodClass *\fIme\fB, ...);
+\h'4n'void (*init__v)(SodClass *\fIme\fB, va_list);
+\h'2n'} obj;

 };
 
 struct SodObject__ilayout {
 };
 
 struct SodObject__ilayout {


@@ -96,7 +104,6 @@ struct SodObject__ilayout {
 \h'8n'const char *nick;
 \h'8n'size_t initsz;
 \h'8n'void *(*imprint)(void *\fIp\fB);
 \h'8n'const char *nick;
 \h'8n'size_t initsz;
 \h'8n'void *(*imprint)(void *\fIp\fB);

-\h'8n'void *(*init)(void *\fIp\fB);

 \h'8n'size_t n_supers;
 \h'8n'const SodClass *const *supers;
 \h'8n'size_t n_cpl;
 \h'8n'size_t n_supers;
 \h'8n'const SodClass *const *supers;
 \h'8n'size_t n_cpl;


@@ -212,7 +219,7 @@ and not really to be recommended.
 .SS The SodObject class
 The
 .B SodObject
 .SS The SodObject class
 The
 .B SodObject

-class defines no slots or messages.
+class defines no slots.

 Because
 .B SodObject
 has no direct superclasses,
 Because
 .B SodObject
 has no direct superclasses,


@@ -220,8 +227,7 @@ there is only one chain,
 and no inherited slots or messages,
 so the single chain contains only a vtable pointer.
 .PP
 and no inherited slots or messages,
 so the single chain contains only a vtable pointer.
 .PP

-Since there are no messages,
-and
+Since

 .B SodClass
 also has only one chain,
 the vtable contains only the standard class pointer and offset-to-base
 .B SodClass
 also has only one chain,
 the vtable contains only the standard class pointer and offset-to-base


@@ -232,6 +238,45 @@ In an actual instance of
 the class pointer contains the address of
 .B SodObject__class
 and the offset is zero.
 the class pointer contains the address of
 .B SodObject__class
 and the offset is zero.

+.PP
+The
+.B init
+message is used to initialize a newly allocated instance.
+.PP
+This message uses a custom method combination
+which works like the standard method combination
+except that default behaviour
+specific to the receiver's direct class
+is invoked if no primary or around method overrides.
+This default behaviour may be invoked multiple times
+if some method calls on its
+.B next_method
+function more than once.
+.PP
+This default behaviour is to initialize the instance's slots
+using the defined slot initializers:
+each slot is initialized
+using the most specific applicable initializer,
+if any.
+Slots without an initializer
+are left uninitialized.
+.PP
+Slots are initialized in reverse-precedence order
+of their defining classes;
+i.e., slots defined by a less specific superclass are initialized
+earlier than slots defined by a more specific superclass.
+Slots defined by the same class are initialized in the order in which
+they appear in the class definition.
+.PP
+There are no standard keyword arguments;
+methods on subclasses are free to
+introduce their own in the usual way.
+.PP
+It is usual to provide complex initialization behaviour as
+.B after
+methods.
+This ensures that slots have been initialized as necessary
+before the method executes.

 .
 .SS The SodClass class
 The
 .
 .SS The SodClass class
 The


@@ -267,16 +312,6 @@ but the slots are left untouched.
 The function returns its argument
 .IR p .
 .TP
 The function returns its argument
 .IR p .
 .TP

-.BI "void *(*init)(void *" p );
-A pointer to a function:
-given a pointer
-.I p
-to an imprinted instance,
-initialize all of its slots for which initializers are defined.
-Other slots are left untouched.
-The function returns its argument
-.IR p .
-.TP

 .B size_t n_supers;
 The number of direct superclasses.
 (This is zero exactly in the case of
 .B size_t n_supers;
 The number of direct superclasses.
 (This is zero exactly in the case of

diff --git a/lib/sod.3 b/lib/sod.3
index 5908eb7..b713d57 100644 (file)
--- a/lib/sod.3
+++ b/lib/sod.3
@@ -92,6 +92,24 @@ sod \- Sensible Object Design runtime library
 .BI "const SodClass *" cls ,
 .BI "const void *" obj );
 .PP
 .BI "const SodClass *" cls ,
 .BI "const void *" obj );
 .PP

+.IB cls " *" \c
+.B SOD_INIT(\c
+.IB cls ,
+.BI "void *" p ,
+.IB keywords );
+.br
+.B void *\c
+.B sod_init(\c
+.BI "const SodClass *" cls ,
+.BI "void *" p ,
+.B ...);
+.br
+.B void *\c
+.B sod_initv(\c
+.BI "const SodClass *" cls ,
+.BI "void *" p ,
+.BI "va_list " ap );
+.br

 .B SOD_DECL(\c
 .IB cls ,
 .IB var );
 .B SOD_DECL(\c
 .IB cls ,
 .IB var );


@@ -336,6 +354,55 @@ manage the standard steps along
 an instance's lifecycle.
 .PP
 The
 an instance's lifecycle.
 .PP
 The

+.B SOD_INIT
+macro,
+and the
+.B sod_init
+and
+.B sod_initv
+functions,
+imprint and initialize an instance of a class
+.I cls
+in the storage starting at address
+.IR p .
+.PP
+The direct class for the new instance is specified as
+a class name to
+.BR SOD_INIT ,
+or a pointer to a class object to the functions.
+.PP
+Keyword arguments for the initialization message may be provided.
+The
+.B SOD_INIT
+macro expects a single preprocessor-time argument
+which is a use of one of
+.B KWARGS
+or
+.B NO_KWARGS
+(see
+.BR keyword (3));
+the
+.B sod_init
+function expects the keywords as
+a variable-length argument tail;
+and
+.B sod_initv
+expects the keywords to be passed indirectly,
+through the captured argument-tail cursor
+.IR ap .
+.PP
+The return value is an instance pointer for the class
+.IR cls ;
+the
+.B SOD_INIT
+macro will have converted it to the correct type,
+so it should probably be used where possible.
+In fact, this is guaranteed to be equal to
+.I p
+by the layout rules described in
+.BR sod-structs (3).
+.PP
+The

 .B SOD_DECL
 macro declares and initializes an instance
 with automatic storage duration.
 .B SOD_DECL
 macro declares and initializes an instance
 with automatic storage duration.


@@ -360,6 +427,7 @@ exits the scope of the declaration.
 .
 .\"--------------------------------------------------------------------------
 .SH SEE ALSO
 .
 .\"--------------------------------------------------------------------------
 .SH SEE ALSO

+.BR keyword (3),

 .BR sod (1),
 .BR sod-structs (3).
 .
 .BR sod (1),
 .BR sod-structs (3).
 .

diff --git a/lib/sod.c b/lib/sod.c
index 1e8d061..aee28d5 100644 (file)
--- a/lib/sod.c
+++ b/lib/sod.c
@@ -120,4 +120,43 @@ void *sod_convert(const SodClass *cls, const void *obj)
   return ((char *)obj - vt->_base + chain->off_ichain);
 }
 
   return ((char *)obj - vt->_base + chain->off_ichain);
 }
 

+/* --- @sod_init@, @sod_initv@ --- *
+ *
+ * Arguments:  @const SodClass *cls@ = class object for new instance
+ *             @void *p@ = pointer to storage for new instance
+ *             @va_list ap, ...@ = initialization keyword arguments
+ *
+ * Returns:    Pointer to the initialized instance.
+ *
+ * Use:                Initializes an instance in pre-allocated storage, and returns
+ *             a pointer to it.
+ *
+ *             This function will imprint the storage, and then send an
+ *             `initialize' message to the fresh instance containing the
+ *             provided keyword arguments.
+ *
+ *             It's usually convenient to use the macro @SOD_INIT@ rather
+ *             than calling @sod_init@ directly.
+ */
+
+void *sod_init(const SodClass *cls, void *p, ...)
+{
+  va_list ap;
+
+  va_start(ap, p);
+  sod_initv(cls, p, ap);
+  va_end(ap);
+  return (p);
+}
+
+void *sod_initv(const SodClass *cls, void *p, va_list ap)
+{
+  SodObject *obj;
+
+  cls->cls.imprint(p);
+  obj = SOD_CONVERT(SodObject, p);
+  SodObject_init__v(obj, ap);
+  return (p);
+}
+

 /*----- That's all, folks -------------------------------------------------*/
 /*----- That's all, folks -------------------------------------------------*/

diff --git a/lib/sod.h b/lib/sod.h
index e0e9193..185c6fb 100644 (file)
--- a/lib/sod.h
+++ b/lib/sod.h
@@ -227,19 +227,30 @@ struct sod_chain {
 
 #define SOD_CONVERT(cls, obj) ((cls *)sod_convert(cls##__class, (obj)))
 
 
 #define SOD_CONVERT(cls, obj) ((cls *)sod_convert(cls##__class, (obj)))
 

+/* --- @SOD_INIT@ --- *
+ *
+ * Arguments:  @cls@ = a class type name
+ *             @p@ = pointer to storage to initialize
+ *             @keys@ = a @KWARGS(...)@ keyword argument sequence
+ *
+ * Use:                Initializes raw storage as an instance of @cls@.
+ */
+
+#define SOD_INIT(cls, p, keys) ((cls *)sod_init(cls##__class, (p), keys))
+

 /* --- @SOD_DECL@ --- *
  *
 /* --- @SOD_DECL@ --- *
  *

- * Arguments:  @cls_@ = a class type name
- *             @var_@ = a variable name
+ * Arguments:  @cls@ = a class type name
+ *             @var@ = a variable name
+ *             @keys@ = a @KWARGS(...)@ keyword argument sequence

  *
  *

- * Use:                Declare @var_@ as a pointer to an initialized instance of
- *             @cls_@ with automatic lifetime.
+ * Use:                Declare @var@ as a pointer to an initialized instance of
+ *             @cls@ with automatic lifetime.

  */
 
  */
 

-#define SOD_DECL(cls_, var_)                                           \
-  struct cls_##__ilayout var_##__layout;                               \
-  cls_ *var_ =                                                         \
-    cls_##__class->cls.init(cls_##__class->cls.imprint(&var_##__layout))
+#define SOD_DECL(cls, var, keys)                                       \
+  struct cls##__ilayout var##__layout;                                 \
+  cls *var = (cls *)sod_init(cls##__class, &var##__layout, keys)

 
 /*----- Functions provided ------------------------------------------------*/
 
 
 /*----- Functions provided ------------------------------------------------*/
 


@@ -280,6 +291,28 @@ extern int sod_subclassp(const SodClass */*sub*/, const SodClass */*super*/);
 
 extern void *sod_convert(const SodClass */*cls*/, const void */*obj*/);
 
 
 extern void *sod_convert(const SodClass */*cls*/, const void */*obj*/);
 

+/* --- @sod_init@, @sod_initv@ --- *
+ *
+ * Arguments:  @const SodClass *cls@ = class object for new instance
+ *             @void *p@ = pointer to storage for new instance
+ *             @va_list ap, ...@ = initialization keyword arguments
+ *
+ * Returns:    Pointer to the initialized instance.
+ *
+ * Use:                Initializes an instance in pre-allocated storage, and returns
+ *             a pointer to it.
+ *
+ *             This function will imprint the storage, and then send an
+ *             `initialize' message to the fresh instance containing the
+ *             provided keyword arguments.
+ *
+ *             It's usually convenient to use the macro @SOD_INIT@ rather
+ *             than calling @sod_init@ directly.
+ */
+
+extern KWCALL void *sod_init(const SodClass */*cls*/, void */*p*/, ...);
+extern void *sod_initv(const SodClass */*cls*/, void */*p*/, va_list /*ap*/);
+

 /*----- That's all, folks -------------------------------------------------*/
 
 #ifdef __cplusplus
 /*----- That's all, folks -------------------------------------------------*/
 
 #ifdef __cplusplus

diff --git a/src/builtin.lisp b/src/builtin.lisp
index 1073cae..6374e6d 100644 (file)
--- a/src/builtin.lisp
+++ b/src/builtin.lisp
@@ -109,44 +109,6 @@ static void *~:*~A__imprint(void *p)
                              (sod-class-nickname tail))))
                    (ilayout-ichains ilayout)))))
 
                              (sod-class-nickname tail))))
                    (ilayout-ichains ilayout)))))
 

-(define-class-slot "init" (class stream)
-    (* (fun (* void) ("/*p*/" (* void))))
-  (format nil "~A__init" class)
-
-  ;; FIXME this needs a metaobject protocol
-  (let ((ilayout (sod-class-ilayout class)))
-    (format stream "~&~:
-/* Provide initial values for an instance's slots. */
-static void *~A__init(void *p)~%{~%" class)
-    (dolist (ichain (ilayout-ichains ilayout))
-      (let ((ich (format nil "sod__obj->~A.~A"
-                        (sod-class-nickname (ichain-head ichain))
-                        (sod-class-nickname (ichain-tail ichain)))))
-       (dolist (item (ichain-body ichain))
-         (etypecase item
-           (vtable-pointer
-            nil)
-           (islots
-            (let ((isl (format nil "~A.~A"
-                               ich
-                               (sod-class-nickname (islots-class item)))))
-              (dolist (slot (islots-slots item))
-                (let ((dslot (effective-slot-direct-slot slot))
-                      (init (effective-slot-initializer slot)))
-                  (when init
-                    (format stream "  {~%    ")
-                    (pprint-c-type (sod-slot-type dslot) stream
-                                   *sod-tmp-val*)
-                    (format stream " = ~A;~%    ~
-                                      ~A.~A = ~A;~%  ~
-                                    }~%"
-                            (sod-initializer-value init)
-                            isl (sod-slot-name dslot)
-                            *sod-tmp-val*))))))))))
-    (format stream "~&~:
-  return (p);
-}~2%")))
-

 ;;;--------------------------------------------------------------------------
 ;;; Superclass structure.
 
 ;;;--------------------------------------------------------------------------
 ;;; Superclass structure.
 


@@ -242,6 +204,104 @@ static const SodClass *const ~A__cpl[] = {
       "0"))
 
 ;;;--------------------------------------------------------------------------
       "0"))
 
 ;;;--------------------------------------------------------------------------

+;;; Built-in methods.
+
+;; Common protocol.
+
+(defclass lifecycle-message (standard-message)
+  ())
+
+(defclass lifecycle-effective-method (standard-effective-method)
+  ())
+
+(defmethod effective-method-live-p ((method lifecycle-effective-method))
+  t)
+
+(defgeneric lifecycle-method-kernel (method codegen target)
+  (:documentation
+   "Compute (into CODEGEN) the class-specific part of the METHOD.
+
+   The result, if any, needs to find its way to the TARGET, as usual."))
+
+(defmethod simple-method-body
+    ((method lifecycle-effective-method) codegen target)
+  (invoke-delegation-chain codegen target
+                          (effective-method-basic-argument-names method)
+                          (effective-method-primary-methods method)
+                          (lambda (target)
+                            (lifecycle-method-kernel method
+                                                     codegen
+                                                     target))))
+
+;; Initialization.
+
+(defclass initialization-message (lifecycle-message)
+  ())
+
+(defclass initialization-effective-method (lifecycle-effective-method)
+  ())
+
+(defmethod sod-message-effective-method-class
+    ((message initialization-message))
+  'initialization-effective-method)
+
+(defmethod lifecycle-method-kernel
+    ((method initialization-effective-method) codegen target)
+  (let* ((class (effective-method-class method))
+        (ilayout (sod-class-ilayout class))
+        (obj-tag (ilayout-struct-tag class))
+        (func-type (c-type (fun void ("sod__obj" (* (struct obj-tag))))))
+        (func-name (format nil "~A__init" class)))
+
+    ;; Start building the initialization function.
+    (codegen-push codegen)
+
+    (labels ((set-from-initializer (var type init)
+              ;; Store the value of INIT, which has the given TYPE, in VAR.
+              ;; INIT has the syntax of an initializer: declare and
+              ;; initialize a temporary, and then copy the result.
+              ;; Compilers seem to optimize this properly.  Return the
+              ;; resulting code as an instruction.
+              (codegen-push codegen)
+              (emit-decl codegen (make-var-inst *sod-tmp-val* type init))
+              (deliver-expr codegen var *sod-tmp-val*)
+              (codegen-pop-block codegen)))
+
+      ;; Loop over the instance layout emitting initializers as we find them.
+      (dolist (ichain (ilayout-ichains ilayout))
+       (let ((ich (format nil "sod__obj->~A.~A"
+                          (sod-class-nickname (ichain-head ichain))
+                          (sod-class-nickname (ichain-tail ichain)))))
+         (dolist (item (ichain-body ichain))
+           (etypecase item
+             (vtable-pointer
+              nil)
+             (islots
+              (let ((isl (format nil "~A.~A"
+                                 ich
+                                 (sod-class-nickname (islots-class item)))))
+                (dolist (slot (islots-slots item))
+                  (let ((dslot (effective-slot-direct-slot slot))
+                        (init (effective-slot-initializer slot)))
+                    (when init
+                      (let* ((slot-type (sod-slot-type dslot))
+                             (slot-default (sod-initializer-value init))
+                             (target (format nil "~A.~A"
+                                             isl (sod-slot-name dslot)))
+                             (initinst (set-from-initializer target
+                                                             slot-type
+                                                             slot-default)))
+                        (emit-inst codegen initinst))))))))))))
+
+    ;; Done making the initialization function.
+    (codegen-pop-function codegen func-name func-type
+                         "Instance initialization function ~:_~
+                          for class `~A'."
+                         class)
+
+    (deliver-call codegen :void func-name "sod__obj")))
+
+;;;--------------------------------------------------------------------------

 ;;; Bootstrapping the class graph.
 
 (defun bootstrap-classes (module)
 ;;; Bootstrapping the class graph.
 
 (defun bootstrap-classes (module)


@@ -256,6 +316,12 @@ static const SodClass *const ~A__cpl[] = {
                                    (make-property-set :nick 'cls)))
         (classes (list sod-object sod-class)))
 
                                    (make-property-set :nick 'cls)))
         (classes (list sod-object sod-class)))
 

+    ;; Attach the built-in messages.
+    (make-sod-message sod-object "init"
+                     (c-type (fun void :keys))
+                     (make-property-set
+                      :message-class 'initialization-message))
+

     ;; Sort out the recursion.
     (setf (slot-value sod-class 'chain-link) sod-object)
     (dolist (class classes)
     ;; Sort out the recursion.
     (setf (slot-value sod-class 'chain-link) sod-object)
     (dolist (class classes)

diff --git a/src/sod.asd.in b/src/sod.asd.in
index c09a622..9f36e1c 100644 (file)
--- a/src/sod.asd.in
+++ b/src/sod.asd.in
@@ -131,7 +131,7 @@
          ("module-proto" "pset-proto" "c-types-class-impl" "builtin"))
    (:file "builtin" :depends-on
          ("module-proto" "pset-proto" "c-types-impl" "c-types-class-impl"
          ("module-proto" "pset-proto" "c-types-class-impl" "builtin"))
    (:file "builtin" :depends-on
          ("module-proto" "pset-proto" "c-types-impl" "c-types-class-impl"

-          "classes" "class-layout-proto"))
+          "classes" "class-layout-proto" "method-proto"))

    (:file "module-parse" :depends-on
          ("class-make-proto" "class-finalize-proto"
           "fragment-parse" "lexer-proto" "module-impl"))
    (:file "module-parse" :depends-on
          ("class-make-proto" "class-finalize-proto"
           "fragment-parse" "lexer-proto" "module-impl"))

diff --git a/test/chimaera.sod b/test/chimaera.sod
index 0723ae1..976c727 100644 (file)
--- a/test/chimaera.sod
+++ b/test/chimaera.sod
@@ -82,25 +82,25 @@ static void provoke_serpent(Serpent *s)
 int main(void)
 {
   {
 int main(void)
 {
   {

-    SOD_DECL(Lion, l);
+    SOD_DECL(Lion, l, NO_KWARGS);

     provoke_lion(l);
     tickle_animal(LION__CONV_NML(l));
   }
 
   {
     provoke_lion(l);
     tickle_animal(LION__CONV_NML(l));
   }
 
   {

-    SOD_DECL(Goat, g);
+    SOD_DECL(Goat, g, NO_KWARGS);

     provoke_goat(g);
     tickle_animal(GOAT__CONV_NML(g));
   }
 
   {
     provoke_goat(g);
     tickle_animal(GOAT__CONV_NML(g));
   }
 
   {

-    SOD_DECL(Serpent, s);
+    SOD_DECL(Serpent, s, NO_KWARGS);

     provoke_serpent(s);
     tickle_animal(SERPENT__CONV_NML(s));
   }
 
   {
     provoke_serpent(s);
     tickle_animal(SERPENT__CONV_NML(s));
   }
 
   {

-    SOD_DECL(Chimaera, c);
+    SOD_DECL(Chimaera, c, NO_KWARGS);

     provoke_lion(CHIMAERA__CONV_LION(c));
     provoke_goat(CHIMAERA__CONV_GOAT(c));
     provoke_serpent(CHIMAERA__CONV_SERPENT(c));
     provoke_lion(CHIMAERA__CONV_LION(c));
     provoke_goat(CHIMAERA__CONV_GOAT(c));
     provoke_serpent(CHIMAERA__CONV_SERPENT(c));

diff --git a/test/test.sod b/test/test.sod
index e5025b5..71fdd68 100644 (file)
--- a/test/test.sod
+++ b/test/test.sod
@@ -169,7 +169,7 @@ class T1Sub : T1Base {
 
 code c : tests {
   prepare("aggregate, base");
 
 code c : tests {
   prepare("aggregate, base");

-  { SOD_DECL(T1Base, t1);
+  { SOD_DECL(T1Base, t1, NO_KWARGS);

     struct item *l;
     struct vec v;
     STEP(0); T1Base_aprogn(t1); /* 1 */
     struct item *l;
     struct vec v;
     STEP(0); T1Base_aprogn(t1); /* 1 */


@@ -185,7 +185,7 @@ code c : tests {
     DONE(7);
   }
   prepare("aggregate, sub");
     DONE(7);
   }
   prepare("aggregate, sub");

-  { SOD_DECL(T1Sub, t1);
+  { SOD_DECL(T1Sub, t1, NO_KWARGS);

     struct item *l;
     struct vec v;
     T1Base_aprogn(t1); /* 0, 1 */
     struct item *l;
     struct vec v;
     T1Base_aprogn(t1); /* 0, 1 */