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
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
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
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
store-property function
with-pset-iterator macro
+Leaked slot names: cl:type
+ sod-initarg: cl:type
+
Classes:
cl:t
sb-pcl::slot-object
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
c-fragment
property
sod-class
+ sod-initarg
sod-initializer
sod-message
sod-method
module
finalize-sod-class
sod-class
+find-slot-initargs
+ sod-class sod-slot
find-slot-initializer
sod-class sod-slot
format-temporary-name
if-inst
return-inst
set-inst
+ sod::suppliedp-struct-inst
update-inst
var-inst
while-inst
for-inst
inst-var
set-inst
+ sod::suppliedp-struct-inst
update-inst
invoke-sequencer-items
sequencer
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
method-entry
method-keyword-argument-lists
effective-method t
+ sod::initialization-effective-method t
module-dependencies
module
(setf module-dependencies)
sod-class
sod-class-vtables
sod-class
+sod-initarg-argument
+ sod-initarg
sod-initializer-class
sod-initializer
sod-initializer-slot
sod:c-fragment
sod:property
sod:sod-class
+ sod:sod-initarg
sod:sod-initializer
sod:sod-message
sod:sod-method
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}
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}
{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}
\&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*}
\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>}
\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>}
<class-item> ::= <slot-item>
\alt <initializer-item>
+\alt <initarg-item>
\alt <fragment-item>
\alt <message-item>
\alt <method-item>
\begin{grammar}
<initializer-item> ::= @["class"@] <list>$[\mbox{@<slot-initializer>}]$ ";"
-<slot-initializer> ::= <dotted-name> "=" <initializer>
+<slot-initializer> ::= <dotted-name> @["=" <initializer>@]
<initializer> :: <c-fragment>
\end{grammar}
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> "}"
(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)
((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)
(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.
(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)
;; 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))
(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.
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.
(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.
: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.
((%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.
(: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
: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)
((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
(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.
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
: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
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.
(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* `}'
;;
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
(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 (#\{
.|
.I initializer-item
.|
+.I initarg-item
+.|
.I fragment-item
.|
.I message-item
.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
}
}
+/*----- 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 -------------------------------------------------*/
~mdw / sod / commitdiff