From b2983f3591981a916f748362d91ff0e2817552cb Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Tue, 15 Dec 2015 19:15:23 +0000
Subject: [PATCH] New feature: initialization keyword arguments.

Initialization keyword arguments can now be declared in class
definitions.  They become additional keyword arguments accepted by the
object's `init' effective method.  The initialization arguments are
available for use (by name) within slot initializer expressions and
initialization fragments.

  * `User' initargs are otherwise passive.  They may usefully have a
    default value, which is used if the argument is
    omitted.  (Alternatively, user code can test the `suppliedp' flag
    and behave accordingly.)

  * `Slot' initargs are associated with an effective slot.  If one of a
    slot's initargs is provided in the `init' message, then its value is
    used to initialize the slot, instead of the slot initializer.  If
    more than one applicable initarg is provided, then priority is given
    to the initargs defined in more specific superclasses; if this
    doesn't disambiguate, then one of the initargs is chosen
    arbitrarily (this situation is likely an error).
---
 doc/SYMBOLS                  |  29 ++++++++++
 doc/concepts.tex             |  69 +++++++++++++++++-------
 doc/layout.tex               |   3 ++
 doc/meta.tex                 |  50 ++++++++++++++++-
 doc/syntax.tex               |  19 ++++++-
 src/builtin.lisp             | 124 ++++++++++++++++++++++++++++++++++++++++---
 src/class-finalize-impl.lisp |  35 ++++++++++++
 src/class-layout-impl.lisp   |  11 +++-
 src/class-layout-proto.lisp  |  12 ++++-
 src/class-make-impl.lisp     |  48 +++++++++++++++--
 src/class-make-proto.lisp    |  35 ++++++++++++
 src/classes.lisp             |  24 +++++++++
 src/module-parse.lisp        |  46 +++++++++++-----
 src/sod-module.5             |  14 ++++-
 test/test.sod                |  23 ++++++++
 15 files changed, 496 insertions(+), 46 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index af83764..00bfb3b 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -219,6 +219,7 @@ class-layout-proto.lisp
   effective-slot-class                          generic
   effective-slot-direct-slot                    generic
   effective-slot-initializer                    generic
+  find-slot-initargs                            generic
   find-slot-initializer                         generic
   ichain                                        class
   ichain-body                                   generic
@@ -268,6 +269,10 @@ class-make-proto.lisp
   make-sod-method                               generic
   make-sod-method-using-message                 generic
   make-sod-slot                                 generic
+  make-sod-slot-initarg                         generic
+  make-sod-slot-initarg-using-slot              generic
+  make-sod-user-initarg                         generic
+  sod-initarg-argument                          generic
   sod-message-method-class                      generic
 
 class-output.lisp
@@ -316,6 +321,7 @@ classes.lisp
   sod-class-tearfrags                           generic setf
   sod-class-type                                generic
   sod-class-vtables                             generic
+  sod-initarg                                   class
   sod-initializer                               class
   sod-initializer-class                         generic
   sod-initializer-slot                          generic
@@ -332,8 +338,10 @@ classes.lisp
   sod-method-type                               generic
   sod-slot                                      class
   sod-slot-class                                generic
+  sod-slot-initarg                              class
   sod-slot-name                                 generic
   sod-slot-type                                 generic
+  sod-user-initarg                              class
 
 codegen-impl.lisp
   codegen                                       class
@@ -601,6 +609,9 @@ pset-proto.lisp
   store-property                                function
   with-pset-iterator                            macro
 
+Leaked slot names: cl:type
+  sod-initarg: cl:type
+
 Classes:
 cl:t
   sb-pcl::slot-object
@@ -666,6 +677,9 @@ cl:t
           cl:class [sb-pcl::definition-source-mixin sb-pcl::standard-specializer]
       sequencer
       sod-class
+      sod-initarg
+        sod-slot-initarg
+        sod-user-initarg
       sod-initializer
         sod-class-initializer
         sod-instance-initializer
@@ -1012,6 +1026,7 @@ sod-parser:file-location
   c-fragment
   property
   sod-class
+  sod-initarg
   sod-initializer
   sod-message
   sod-method
@@ -1020,6 +1035,8 @@ finalize-module
   module
 finalize-sod-class
   sod-class
+find-slot-initargs
+  sod-class sod-slot
 find-slot-initializer
   sod-class sod-slot
 format-temporary-name
@@ -1145,6 +1162,7 @@ inst-metric
   if-inst
   return-inst
   set-inst
+  sod::suppliedp-struct-inst
   update-inst
   var-inst
   while-inst
@@ -1160,6 +1178,7 @@ inst-update
   for-inst
 inst-var
   set-inst
+  sod::suppliedp-struct-inst
   update-inst
 invoke-sequencer-items
   sequencer
@@ -1201,6 +1220,12 @@ make-sod-method-using-message
   sod-message sod-class t t t t
 make-sod-slot
   sod-class t t t
+make-sod-slot-initarg
+  sod-class t t t t
+make-sod-slot-initarg-using-slot
+  sod-class t sod-slot t
+make-sod-user-initarg
+  sod-class t t t
 method-entry-chain-head
   method-entry
 method-entry-chain-tail
@@ -1215,6 +1240,7 @@ method-entry-slot-name
   method-entry
 method-keyword-argument-lists
   effective-method t
+  sod::initialization-effective-method t
 module-dependencies
   module
 (setf module-dependencies)
@@ -1388,6 +1414,8 @@ sod-class-type
   sod-class
 sod-class-vtables
   sod-class
+sod-initarg-argument
+  sod-initarg
 sod-initializer-class
   sod-initializer
 sod-initializer-slot
@@ -1790,6 +1818,7 @@ file-location
   sod:c-fragment
   sod:property
   sod:sod-class
+  sod:sod-initarg
   sod:sod-initializer
   sod:sod-message
   sod:sod-method
diff --git a/doc/concepts.tex b/doc/concepts.tex
index 8151014..30c6735 100644
--- a/doc/concepts.tex
+++ b/doc/concepts.tex
@@ -745,11 +745,10 @@ 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, and to invoke each superclass's initialization fragments.  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 instance's slots, as described below, and to invoke each superclass's
+initialization fragments.  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.
 
 Slots are initialized in a well-defined order.
 \begin{itemize}
@@ -771,19 +770,53 @@ definition.  It is possible for an initialization fragment to use @|return|
 or @|goto| for special control-flow effects, but this is not likely to be a
 good idea.
 
-Note that an initialization fragment defined in a class is copied literally
-into each subclass's initialization method.  This is fine for simple cases
-but wasteful if the initialization logic is complicated.  More complex
-initialization behaviour should be added either by having an initialization
-fragments call functions (necessarily with external linkage), or by defining
-@|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.
+The @|init| message accepts keyword arguments
+(\xref{sec:concepts.methods.keywords}).  The set of acceptable keywords is
+determined by the applicable methods as usual, but also by the
+\emph{initargs} defined by the receiving instance's class and its
+superclasses, which are made available to slot initializers and
+initialization fragments.
+
+There are two kinds of initarg definitions.  \emph{User initargs} are defined
+by an explicit @|initarg| item appearing in a class definition: the item
+defines a name, type, and (optionally) a default value for the initarg.
+\emph{Slot initargs} are defined by attaching an @|initarg| property to a
+slot or slot initializer item: the property's determines the initarg's name,
+while the type is taken from the underlying slot type; slot initargs do not
+have default values.  Both kinds define a \emph{direct initarg} for the
+containing class.
+
+Initargs are inherited.  The \emph{applicable} direct initargs for an @|init|
+effective method are those defined by the receiving object's class, and all
+of its superclasses.  Applicable direct initargs with the same name are
+merged to form \emph{effective initargs}.  An error is reported if two
+applicable direct initargs have the same name but different types.  The
+default value of an effective initarg is taken from the most specific
+applicable direct initarg which specifies a defalt value; if no applicable
+direct initarg specifies a default value then the effective initarg has no
+default.
+
+All initarg values are made available at runtime to user code --
+initialization fragments and slot initializer expressions -- through local
+variables and a @|suppliedp| structure, as in a direct method
+(\xref{sec:concepts.methods.keywords}).  Furthermore, slot initarg
+definitions influence the initialization of slots.
+
+The process for deciding how to initialize a particular slot works as
+follows.
+\begin{enumerate}
+\item If there are any slot initargs defined on the slot, or any of its slot
+  initializers, \emph{and} the sender supplied a value for one or more of the
+  corresponding effective initargs, then the value of the most specific slot
+  initarg is stored in the slot.
+\item Otherwise, if there are any slot initializers defined which include an
+  initializer expression, then the initializer expression from the most
+  specific such slot initializer is evaluated and its value stored in the
+  slot.
+\item Otherwise, the slot is left uninitialized.
+\end{enumerate}
+Note that the default values (if any) of effective initargs do \emph{not}
+affect this procedure.
 
 
 \subsection{Destruction}
diff --git a/doc/layout.tex b/doc/layout.tex
index ab63860..7a82634 100644
--- a/doc/layout.tex
+++ b/doc/layout.tex
@@ -68,6 +68,9 @@
     {find-slot-initializer @<class> @<slot> @> @<init-or-nil>}
 \end{describe}
 
+\begin{describe}{gf}{find-slot-initargs @<class> @<slot> @> @<list>}
+\end{describe}
+
 \begin{describe}{gf}
     {compute-effective-slot @<class> @<slot> @> @<effective-slot>}
 \end{describe}
diff --git a/doc/meta.tex b/doc/meta.tex
index fab8dec..6707c42 100644
--- a/doc/meta.tex
+++ b/doc/meta.tex
@@ -33,7 +33,8 @@
       \&key \=:name :nick :location :pset \+ \\
               :superclasses :link :metaclass \\
               :slots :instance-initializers :class-initializers \\
-              :initfrags :tearfrags :messages :methods}
+              :initargs :initfrags :tearfrags \\
+              :messages :methods}
 \end{describe}
 
 \begin{describe*}
@@ -48,6 +49,8 @@
      \dhead{gf}{setf (sod-class-instance-initializers @<class>) @<list>}
      \dhead{gf}{sod-class-class-initializers @<class> @> @<list>}
      \dhead{gf}{setf (sod-class-class-initializers @<class>) @<list>}
+     \dhead{gf}{sod-class-initargs @<class> @> @<list>}
+     \dhead{gf}{setf (sod-class-initargs @<class>) @<list>}
      \dhead{gf}{sod-class-initfrags @<class> @> @<list>}
      \dhead{gf}{setf (sod-class-initfrags @<class>) @<list>}
      \dhead{gf}{sod-class-tearfrags @<class> @> @<list>}
@@ -163,6 +166,51 @@
       \nlret @<init>}
 \end{describe}
 
+\begin{describe}{cls}{sod-initarg () \&key :class :location :name :type}
+\end{describe}
+
+\begin{describe*}
+    {\dhead{gf}{sod-initarg-class @<initarg> @> @<class>}
+     \dhead{gf}{sod-initarg-name @<initarg> @> @<string>}
+     \dhead{gf}{sod-initarg-type @<initarg> @> @<c-type>}}
+\end{describe*}
+
+\begin{describe}{cls}
+    {sod-user-initarg (sod-initarg)
+      \&key :class :location :name :type :default}
+\end{describe}
+
+\begin{describe}{gf}
+     {make-sod-user-initarg @<class> @<name> @<type> @<pset>
+                            \&optional @<default> @<floc>}
+\end{describe}
+
+\begin{describe}{gf}{sod-initarg-default @<initarg> @> @<default>}
+\end{describe}
+
+\begin{describe}{cls}
+    {sod-slot-initarg (sod-initarg)
+      \&key :class :location :name :type :slot}
+\end{describe}
+
+\begin{describe}{gf}{sod-initarg-slot @<initarg> @> @<slot>}
+\end{describe}
+
+\begin{describe}{gf}
+    {make-sod-slot-initarg @<class> @<name> @<nick> @<slot-name> @<pset>
+                           \&optional @<floc>}
+\end{describe}
+
+\begin{describe}{gf}
+    {make-sod-slot-initarg @<class> @<name> @<nick> @<slot-name> @<pset>
+                           \&optional @<floc>}
+\end{describe}
+
+\begin{describe}{gf}
+    {make-sod-slot-initarg-using-slot @<class> @<name> @<slot> @<pset>
+                                      \&optional @<floc>}
+\end{describe}
+
 \begin{describe*}
     {\dhead{gf}{make-sod-class-initfrag @<class> @<frag> @<pset>
                                         \&optional @<floc>}
diff --git a/doc/syntax.tex b/doc/syntax.tex
index b18acd5..3034b1e 100644
--- a/doc/syntax.tex
+++ b/doc/syntax.tex
@@ -585,6 +585,7 @@ class Sub : Super {
 
 <class-item> ::= <slot-item>
 \alt <initializer-item>
+\alt <initarg-item>
 \alt <fragment-item>
 \alt <message-item>
 \alt <method-item>
@@ -663,7 +664,7 @@ class Example : Super {
 \begin{grammar}
 <initializer-item> ::= @["class"@] <list>$[\mbox{@<slot-initializer>}]$ ";"
 
-<slot-initializer> ::= <dotted-name> "=" <initializer>
+<slot-initializer> ::= <dotted-name> @["=" <initializer>@]
 
 <initializer> :: <c-fragment>
 \end{grammar}
@@ -676,6 +677,22 @@ The first component of the @<dotted-name> must be the nickname of one of the
 class's superclasses (including itself); the second must be the name of a
 slot defined in that superclass.
 
+An @|initarg| property may be set on an instance slot initializer (or a
+direct slot definition).  See \xref{sec:concepts.lifecycle.birth} for the
+details.  An initializer item must have either an @|initarg| property, or an
+initializer expression, or both.
+
+Each class may define at most one initializer item with an explicit
+initializer expression for a given slot.
+
+\subsubsection{Initarg items}
+\begin{grammar}
+<initarg-item> ::=
+  "initarg"
+  @<declaration-specifier>^+
+  <list>$[\mbox{@<init-declarator>}]$ ";"
+\end{grammar}
+
 \subsubsection{Fragment items}
 \begin{grammar}
 <fragment-item> ::= <fragment-kind> "{" <c-fragment> "}"
diff --git a/src/builtin.lisp b/src/builtin.lisp
index d7d0fcb..563766c 100644
--- a/src/builtin.lisp
+++ b/src/builtin.lisp
@@ -246,6 +246,39 @@ static const SodClass *const ~A__cpl[] = {
 					     (sod-class-chain-head class))
 					    (sod-class-nickname class)))))
 
+(defun collect-initarg-keywords (class)
+  "Return a list of keyword arguments corresponding to CLASS's initargs.
+
+   For each distinct name among the initargs defined on CLASS and its
+   superclasses, return a single `argument' object containing the (agreed
+   common) type, and the (unique, if present) default value from the most
+   specific defining superclass.
+
+   The arguments are not returned in any especially meaningful order."
+
+  (let ((map (make-hash-table :test #'equal))
+	(default-map (make-hash-table :test #'equal))
+	(list nil))
+    (dolist (super (sod-class-precedence-list class))
+      (dolist (initarg (sod-class-initargs super))
+	(let ((name (sod-initarg-name initarg))
+	      (default (sod-initarg-default initarg)))
+	  (unless (gethash name default-map)
+	    (when (or default (not (gethash name map)))
+	      (setf (gethash name map) (sod-initarg-argument initarg)))
+	    (when default
+	      (setf (gethash name default-map) t))))))
+    (maphash (lambda (key value)
+	       (declare (ignore key))
+	       (push value list))
+	     map)
+    list))
+
+(definst suppliedp-struct (stream) (flags var)
+  (format stream
+	  "~@<struct { ~2I~_~{unsigned ~A : 1;~^ ~_~} ~I~_} ~A;~:>"
+	  flags var))
+
 ;; Initialization.
 
 (defclass initialization-message (lifecycle-message)
@@ -258,13 +291,37 @@ static const SodClass *const ~A__cpl[] = {
     ((message initialization-message))
   'initialization-effective-method)
 
+(defmethod method-keyword-argument-lists
+    ((method initialization-effective-method) direct-methods)
+  (append (call-next-method)
+	  (delete-duplicates
+	   (mapcan (lambda (class)
+		     (let ((initargs (sod-class-initargs class)))
+		       (and initargs
+			    (list (cons (mapcar #'sod-initarg-argument
+						initargs)
+					(format nil "initargs for ~A"
+						class))))))
+		   (sod-class-precedence-list
+		    (effective-method-class method)))
+	   :key #'argument-name)))
+
 (defmethod lifecycle-method-kernel
     ((method initialization-effective-method) codegen target)
   (let* ((class (effective-method-class method))
+	 (keywords (collect-initarg-keywords class))
 	 (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)))
+	 (kw-tag (effective-method-keyword-struct-tag method))
+	 (kw-tail (and keywords
+		       (list (make-argument
+			      "sod__kw"
+			      (c-type (* (struct kw-tag :const)))))))
+	 (func-type (c-type (fun void
+				 ("sod__obj" (* (struct obj-tag)))
+				 . kw-tail)))
+	 (func-name (format nil "~A__init" class))
+	 (done-setup-p nil))
 
     ;; Start building the initialization function.
     (codegen-push codegen)
@@ -278,7 +335,46 @@ static const SodClass *const ~A__cpl[] = {
 	       (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)))
+	       (codegen-pop-block codegen))
+	     (setup ()
+	       ;; Do any necessary one-time initialization required to set up
+	       ;; the environment for the initialization code.
+	       (unless done-setup-p
+
+		 ;; Extract the keyword arguments into local variables.
+		 (when keywords
+		   (emit-decl codegen
+			      (make-suppliedp-struct-inst
+			       (mapcar #'argument-name keywords)
+			       "suppliedp"))
+		   (emit-banner codegen "Collect the keyword arguments.")
+		   (dolist (arg keywords)
+		     (let* ((name (argument-name arg))
+			    (type (argument-type arg))
+			    (default (argument-default arg))
+			    (kwvar (format nil "sod__kw->~A" name))
+			    (kwset (make-set-inst name kwvar))
+			    (suppliedp (format nil "suppliedp.~A" name)))
+		       (emit-decl codegen (make-var-inst name type))
+		       (deliver-expr codegen suppliedp
+				     (format nil "sod__kw->~A__suppliedp"
+					     name))
+		       (emit-inst
+			codegen
+			(if default
+			    (make-if-inst suppliedp kwset
+					  (set-from-initializer name
+								type
+								default))
+			    kwset))))
+
+		   (deliver-call codegen :void
+				 "SOD__IGNORE" "suppliedp")
+		   (dolist (arg keywords)
+		     (deliver-call codegen :void
+				   "SOD__IGNORE" (argument-name arg))))
+
+		 (setf done-setup-p t))))
 
       ;; Initialize the structure defined by the various superclasses, in
       ;; reverse precedence order.
@@ -297,6 +393,7 @@ static const SodClass *const ~A__cpl[] = {
 	  (flet ((focus-this-class ()
 		   ;; Delayed initial preparation.  Don't bother defining the
 		   ;; `me' pointer if there's actually nothing to do.
+		   (setup)
 		   (unless this-class-focussed-p
 		     (emit-banner codegen
 				  "Initialization for class `~A'." super)
@@ -307,8 +404,9 @@ static const SodClass *const ~A__cpl[] = {
 	    ;; Work through each slot in turn.
 	    (dolist (slot (and islots (islots-slots islots)))
 	      (let ((dslot (effective-slot-direct-slot slot))
-		    (init (effective-slot-initializer slot)))
-		(when init
+		    (init (effective-slot-initializer slot))
+		    (initargs (effective-slot-initargs slot)))
+		(when (or init initargs)
 		  (focus-this-class)
 		  (let* ((slot-type (sod-slot-type dslot))
 			 (slot-default (sod-initializer-value init))
@@ -317,6 +415,19 @@ static const SodClass *const ~A__cpl[] = {
 			 (initinst (set-from-initializer target
 							 slot-type
 							 slot-default)))
+
+		    ;; If there are applicable initialization arguments,
+		    ;; check to see whether they were supplied.
+		    (dolist (initarg (reverse (remove-duplicates
+					       initargs
+					       :key #'sod-initarg-name
+					       :test #'string=)))
+		      (let ((arg-name (sod-initarg-name initarg)))
+			(setf initinst (make-if-inst
+					(format nil "suppliedp.~A" arg-name)
+					(make-set-inst target arg-name)
+					initinst))))
+
 		    (emit-inst codegen initinst)))))
 
 	    ;; Emit the class's initialization fragments.
@@ -341,7 +452,8 @@ static const SodClass *const ~A__cpl[] = {
 			   for class `~A'."
 			  class)
 
-    (deliver-call codegen :void func-name "sod__obj")))
+    (apply #'deliver-call codegen :void func-name
+	   "sod__obj" (and keywords (list (keyword-struct-pointer))))))
 
 ;; Teardown.
 
diff --git a/src/class-finalize-impl.lisp b/src/class-finalize-impl.lisp
index 36d56e0..be42f13 100644
--- a/src/class-finalize-impl.lisp
+++ b/src/class-finalize-impl.lisp
@@ -343,6 +343,41 @@
 	(error "In `~A~, chain-to class `~A' is not a proper superclass"
 	       class chain-link)))
 
+    ;; Check that the initargs declare compatible types.  Duplicate entries,
+    ;; even within a class, are harmless, but at most one initarg in any
+    ;; class should declare a default value.
+    (with-slots (class-precedence-list) class
+      (let ((seen (make-hash-table :test #'equal)))
+	(dolist (super class-precedence-list)
+	  (with-slots (initargs) super
+	    (dolist (initarg (reverse initargs))
+	      (let* ((initarg-name (sod-initarg-name initarg))
+		     (initarg-type (sod-initarg-type initarg))
+		     (initarg-default (sod-initarg-default initarg))
+		     (found (gethash initarg-name seen))
+		     (found-type (and found (sod-initarg-type found)))
+		     (found-default (and found (sod-initarg-default found)))
+		     (found-class (and found (sod-initarg-class found)))
+		     (found-location (and found (file-location found))))
+		(with-default-error-location (initarg)
+		  (cond ((not found)
+			 (setf (gethash initarg-name seen) initarg))
+			((not (c-type-equal-p initarg-type found-type))
+			 (cerror* "Inititalization argument `~A' defined ~
+				   with incompatible types: ~
+				   ~A in class ~A, and ~
+				   ~A in class ~A (at ~A)"
+				initarg-name initarg-type super
+				found-type found-class found-location))
+			((and initarg-default found-default
+			      (eql super found-class))
+			 (cerror* "Initialization argument `~A' redefined ~
+				   with default value ~
+				   (previous definition at ~A)"
+				  initarg-name found-location))
+			(initarg-default
+			 (setf (gethash initarg-name seen) initarg))))))))))
+
     ;; Check for circularity in the superclass graph.  Since the superclasses
     ;; should already be acyclic, it suffices to check that our class is not
     ;; a superclass of any of its own direct superclasses.
diff --git a/src/class-layout-impl.lisp b/src/class-layout-impl.lisp
index 3779a69..d6b3e6d 100644
--- a/src/class-layout-impl.lisp
+++ b/src/class-layout-impl.lisp
@@ -41,11 +41,20 @@
 		:key #'sod-initializer-slot))
 	(sod-class-precedence-list class)))
 
+(defmethod find-slot-initargs ((class sod-class) (slot sod-slot))
+  (mappend (lambda (super)
+	     (remove-if-not (lambda (initarg)
+			      (and (typep initarg 'sod-slot-initarg)
+				   (eq (sod-initarg-slot initarg) slot)))
+			    (sod-class-initargs super)))
+	   (sod-class-precedence-list class)))
+
 (defmethod compute-effective-slot ((class sod-class) (slot sod-slot))
   (make-instance 'effective-slot
 		 :slot slot
 		 :class class
-		 :initializer (find-slot-initializer class slot)))
+		 :initializer (find-slot-initializer class slot)
+		 :initargs (find-slot-initargs class slot)))
 
 ;;;--------------------------------------------------------------------------
 ;;; Special-purpose slot objects.
diff --git a/src/class-layout-proto.lisp b/src/class-layout-proto.lisp
index d34bf8b..927700f 100644
--- a/src/class-layout-proto.lisp
+++ b/src/class-layout-proto.lisp
@@ -34,7 +34,9 @@
   ((%class :initarg :class :type sod-class :reader effective-slot-class)
    (slot :initarg :slot :type sod-slot :reader effective-slot-direct-slot)
    (initializer :initarg :initializer :type (or sod-initializer null)
-		:reader effective-slot-initializer))
+		:reader effective-slot-initializer)
+   (initargs :initarg :initargs :initform nil
+	     :type list :reader effective-slot-initargs))
   (:documentation
    "Describes a slot and how it's meant to be initialized.
 
@@ -50,6 +52,14 @@
   (:documentation
    "Return the most specific initializer for SLOT, starting from CLASS."))
 
+(export 'find-slot-initargs)
+(defgeneric find-slot-initargs (class slot)
+  (:documentation
+   "Return as a list all of the initargs defined on CLASS to initialize SLOT.
+
+   The list is returned with initargs defined on more specific classes
+   first."))
+
 (export 'compute-effective-slot)
 (defgeneric compute-effective-slot (class slot)
   (:documentation
diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp
index bd2407e..7263e44 100644
--- a/src/class-make-impl.lisp
+++ b/src/class-make-impl.lisp
@@ -72,9 +72,13 @@
 			       :name name
 			       :type type
 			       :location (file-location location)
-			       :pset pset)))
+			       :pset pset))
+	  (initarg-name (get-property pset :initarg :id)))
       (with-slots (slots) class
 	(setf slots (append slots (list slot))))
+      (when initarg-name
+	(make-sod-slot-initarg-using-slot class initarg-name
+					  slot pset location))
       slot)))
 
 (defmethod shared-initialize :after ((slot sod-slot) slot-names &key pset)
@@ -92,14 +96,20 @@
     ((class sod-class) nick name value pset &optional location)
   (with-default-error-location (location)
     (let* ((slot (find-instance-slot-by-name class nick name))
+	   (initarg-name (get-property pset :initarg :id))
 	   (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))))
+	(unless (or initarg-name initializer)
+	  (error "Slot initializer declaration with no effect"))
+	(when initarg-name
+	  (make-sod-slot-initarg-using-slot class initarg-name slot
+					    pset location))
+	(when initializer
+	  (setf instance-initializers
+		(append instance-initializers (list initializer)))))
       initializer)))
 
 (defmethod make-sod-class-initializer
@@ -132,6 +142,36 @@
   (declare (ignore slot-names pset))
   nil)
 
+(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.
 
diff --git a/src/class-make-proto.lisp b/src/class-make-proto.lisp
index f787bd3..d075304 100644
--- a/src/class-make-proto.lisp
+++ b/src/class-make-proto.lisp
@@ -124,6 +124,41 @@
    You are not expected to call this generic function directly; it's more
    useful as a place to hang methods for custom initializer classes."))
 
+(export 'make-sod-user-initarg)
+(defgeneric make-sod-user-initarg
+    (class name type pset &optional default location)
+  (:documentation
+   "Attach a user-defined initialization keyword argument to the CLASS.
+
+   The new argument has the given NAME and TYPE, and maybe a DEFAULT value.
+   Currently, initialization arguments are just dumb objects held in a
+   list."))
+
+(export 'make-sod-slot-initarg)
+(defgeneric make-sod-slot-initarg
+    (class name nick slot-name pset &optional location)
+  (:documentation
+   "Attach an initialization keyword argument to a slot by name.
+
+   The default method uses `find-instance-slot-by-name' to find the slot, and
+   `make-slot-initarg-using-slot' to actually make and attach the initarg."))
+
+(export 'make-sod-slot-initarg-using-slot)
+(defgeneric make-sod-slot-initarg-using-slot
+    (class name slot pset &optional location)
+  (:documentation
+   "Attach an initialization keyword argument to a SLOT.
+
+   The argument's type is taken from the slot type.  Slot initargs can't have
+   defaults: the slot's most-specific initializer is used instead.
+
+   You are not expected to call this generic function directly; it's more
+   useful as a place to hang methods for custom classes."))
+
+(export 'sod-initarg-argument)
+(defgeneric sod-initarg-argument (initarg)
+  (:documentation "Returns an `argument' object for the initarg."))
+
 (export 'make-sod-class-initfrag)
 (defgeneric make-sod-class-initfrag (class frag pset &optional location)
   (:documentation
diff --git a/src/classes.lisp b/src/classes.lisp
index 0c695b2..3ed103a 100644
--- a/src/classes.lisp
+++ b/src/classes.lisp
@@ -71,6 +71,8 @@
 			  :accessor sod-class-instance-initializers)
    (class-initializers :initarg :class-initializers :initform nil
 		       :type list :accessor sod-class-class-initializers)
+   (initargs :initarg :initargs :initform nil
+	     :type list :accessor sod-class-initargs)
    (initfrags :initarg :initfrags :initform nil
 	      :type list :accessor sod-class-initfrags)
    (tearfrags :initarg :tearfrags :initform nil
@@ -323,6 +325,28 @@
 
    See `sod-initializer' for more details."))
 
+(export 'sod-initarg)
+(defclass sod-initarg ()
+  ((%class :initarg :class :type sod-class :reader sod-initarg-class)
+   (location :initarg :location :initform (file-location nil)
+	     :type file-location :reader file-location)
+   (name :initarg :name :type string :reader sod-initarg-name)
+   (type :initarg :type :type c-type :reader sod-initarg-type))
+  (:documentation
+   "Describes a keyword argument accepted by the initialization function."))
+
+(export 'sod-user-initarg)
+(defclass sod-user-initarg (sod-initarg)
+  ((default :initarg :default :type t :reader sod-initarg-default))
+  (:documentation
+   "Describes an initialization argument defined by the user."))
+
+(export 'sod-slot-initarg)
+(defclass sod-slot-initarg (sod-initarg)
+  ((slot :initarg :slot :type sod-slot :reader sod-initarg-slot))
+  (:documentation
+   "Describes an initialization argument used to initialize a slot."))
+
 ;;;--------------------------------------------------------------------------
 ;;; Messages and methods.
 
diff --git a/src/module-parse.lisp b/src/module-parse.lisp
index f6d69ee..35e07ea 100644
--- a/src/module-parse.lisp
+++ b/src/module-parse.lisp
@@ -208,6 +208,25 @@
 		 (frag (parse-delimited-fragment scanner #\{ #\})))
 	     (funcall make class frag pset scanner)))))
 
+(define-pluggable-parser class-item initargs (scanner class pset)
+  ;; initarg-item ::= `initarg' declspec+ init-declarator-list
+  ;; init-declarator ::= declarator [`=' initializer]
+  (with-parser-context (token-scanner-context :scanner scanner)
+    (parse (seq ("initarg"
+		 (base-type (parse-c-type scanner))
+		 (nil (skip-many (:min 1)
+			(seq ((declarator (parse-declarator scanner
+							    base-type))
+			      (init (? (parse-delimited-fragment
+					scanner #\= (list #\; #\,)
+					:keep-end t))))
+			  (make-sod-user-initarg class
+						 (cdr declarator)
+						 (car declarator)
+						 pset init scanner))
+			#\,))
+		   #\;)))))
+
 (defun parse-class-body (scanner pset name supers)
   ;; class-body ::= `{' class-item* `}'
   ;;
@@ -295,19 +314,22 @@
 				    sub-pset scanner))))
 			     #\;)))
 
-	       (parse-initializer-item (sub-pset constructor)
+	       (parse-initializer-item (sub-pset must-init-p constructor)
 		 ;; initializer-item ::=
 		 ;;	[`class'] -!- slot-initializer-list `;'
 		 ;;
-		 ;; slot-initializer ::= id `.' id initializer
-		 (parse (and (skip-many ()
-			       (seq ((name-a :id) #\. (name-b :id)
-				     (init (parse-initializer)))
-				 (funcall constructor class
-					  name-a name-b init
-					  sub-pset scanner))
-			       #\,)
-			     #\;)))
+		 ;; slot-initializer ::= id `.' id [initializer]
+		 (let ((parse-init (if must-init-p
+				       #'parse-initializer
+				       (parser () (? (parse-initializer))))))
+		   (parse (and (skip-many ()
+				 (seq ((name-a :id) #\. (name-b :id)
+				       (init (funcall parse-init)))
+				   (funcall constructor class
+					    name-a name-b init
+					    sub-pset scanner))
+				 #\,)
+			       #\;))))
 
 	       (class-item-dispatch (sub-pset base-type type name)
 		 ;; Logically part of `parse-raw-class-item', but the
@@ -353,10 +375,10 @@
 							     (cdr dc))))))
 			    (and "class"
 				 (parse-initializer-item
-				  sub-pset
+				  sub-pset t
 				  #'make-sod-class-initializer))
 			    (parse-initializer-item
-			     sub-pset
+			     sub-pset nil
 			     #'make-sod-instance-initializer)))))
 
 	(parse (seq (#\{
diff --git a/src/sod-module.5 b/src/sod-module.5
index 86c29f8..66937da 100644
--- a/src/sod-module.5
+++ b/src/sod-module.5
@@ -542,6 +542,8 @@ class-definition
 .|
 .I initializer-item
 .|
+.I initarg-item
+.|
 .I fragment-item
 .|
 .I message-item
@@ -570,13 +572,21 @@ class-definition
 .I slot-initializer
 ::=
 .I dotted-name
-.B =
-.I initializer
+.RB [ =
+.IR initializer ]
 .br
 .I initializer
 ::=
 .I c-fragment
 .br
+.I initarg-item
+::=
+.<
+.B initarg
+.IR declaration-specifier \*+
+.IR list [ init-declarator ]
+.B ;
+.br
 .I fragment-item
 ::=
 .I fragment-kind
diff --git a/test/test.sod b/test/test.sod
index 71fdd68..f7f3537 100644
--- a/test/test.sod
+++ b/test/test.sod
@@ -202,4 +202,27 @@ code c : tests {
   }
 }
 
+/*----- Slot and user initargs --------------------------------------------*/
+
+[link = SodObject, nick = t2]
+class T2 : SodObject {
+  [initarg = x] int x = 0;
+
+  initarg int y = 1;
+  init { if (!y) STEP(0); }
+}
+
+code c : tests {
+  prepare("initargs, defaults");
+  { SOD_DECL(T2, t, NO_KWARGS);
+    if (t->t2.x == 0) STEP(0);
+    DONE(1);
+  }
+  prepare("initargs, explicit");
+  { SOD_DECL(T2, t, KWARGS(K(x, 42) K(y, 0)));
+    if (t->t2.x == 42) STEP(1);
+    DONE(2);
+  }
+}
+
 /*----- That's all, folks -------------------------------------------------*/
-- 
2.11.0

