;;;; files for more information.
(in-package "SB!KERNEL")
+
+(/show0 "code/defstruct.lisp 15")
\f
;;;; getting LAYOUTs
;; documentation on the structure
(doc nil :type (or string null))
;; prefix for slot names. If NIL, none.
- (conc-name (concat-pnames name '-) :type (or symbol null))
+ (conc-name (symbolicate name "-") :type (or symbol null))
;; the name of the primary standard keyword constructor, or NIL if none
(default-constructor nil :type (or symbol null))
;; all the explicit :CONSTRUCTOR specs, with name defaulted
(constructors () :type list)
;; name of copying function
- (copier (concat-pnames 'copy- name) :type (or symbol null))
+ (copier (symbolicate "COPY-" name) :type (or symbol null))
;; name of type predicate
- (predicate (concat-pnames name '-p) :type (or symbol null))
+ (predicate (symbolicate name "-P") :type (or symbol null))
;; the arguments to the :INCLUDE option, or NIL if no included
;; structure
(include nil :type list)
(if (class-structure-p dd)
(let ((inherits (inherits-for-structure dd)))
`(progn
+ (/noshow0 "doing CLASS-STRUCTURE-P case for DEFSTRUCT " ,name)
(eval-when (:compile-toplevel :load-toplevel :execute)
(%compiler-only-defstruct ',dd ',inherits))
(%defstruct ',dd ',inherits)
,@(when (eq (dd-type dd) 'structure)
`((%compiler-defstruct ',dd)))
+ (/noshow0 "starting not-for-the-xc-host section in DEFSTRUCT")
,@(unless expanding-into-code-for-xc-host-p
(append (raw-accessor-definitions dd)
(predicate-definitions dd)
;(copier-definition dd)
(constructor-definitions dd)
(class-method-definitions dd)))
+ (/noshow0 "done with DEFSTRUCT " ,name)
',name))
`(progn
+ (/show0 "doing NOT CLASS-STRUCTURE-P case for DEFSTRUCT " ,name)
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (info :typed-structure :info ',name) ',dd))
,@(unless expanding-into-code-for-xc-host-p
(typed-predicate-definitions dd)
(typed-copier-definitions dd)
(constructor-definitions dd)))
+ (/noshow0 "done with DEFSTRUCT " ,name)
',name)))))
(sb!xc:defmacro defstruct (name-and-options &rest slot-descriptions)
#!+sb-doc
"DEFSTRUCT {Name | (Name Option*)} {Slot | (Slot [Default] {Key Value}*)}
- Define the structure type Name. Instances are created by MAKE-<name>, which
- takes keyword arguments allowing initial slot values to the specified.
+ Define the structure type Name. Instances are created by MAKE-<name>,
+ which takes &KEY arguments allowing initial slot values to the specified.
A SETF'able function <name>-<slot> is defined for each slot to read and
write slot values. <name>-p is a type predicate.
conc-name
(make-symbol (string conc-name))))))
(:constructor
- (destructuring-bind (&optional (cname (concat-pnames 'make- name))
+ (destructuring-bind (&optional (cname (symbolicate "MAKE-" name))
&rest stuff)
args
(push (cons cname stuff) (dd-constructors defstruct))))
(:copier
- (destructuring-bind (&optional (copier (concat-pnames 'copy- name)))
+ (destructuring-bind (&optional (copier (symbolicate "COPY-" name)))
args
(setf (dd-copier defstruct) copier)))
(:predicate
- (destructuring-bind (&optional (pred (concat-pnames name '-p))) args
+ (destructuring-bind (&optional (pred (symbolicate name "-P"))) args
(setf (dd-predicate defstruct) pred)))
(:include
(when (dd-include defstruct)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun parse-name-and-options (name-and-options)
(destructuring-bind (name &rest options) name-and-options
+ (assert name) ; A null name doesn't seem to make sense here.
(let ((defstruct (make-defstruct-description name)))
(dolist (option options)
(cond ((consp option)
(setf (dsd-%name islot) (string name))
(setf (dd-slots defstruct) (nconc (dd-slots defstruct) (list islot)))
- (let* ((accname (concat-pnames (dd-conc-name defstruct) name))
+ (let* ((accname (symbolicate (or (dd-conc-name defstruct) "") name))
(existing (info :function :accessor-for accname)))
(if (and (structure-class-p existing)
(not (eq (sb!xc:class-name existing) (dd-name defstruct)))
(return-from constructor-definitions ()))
(unless (or defaults boas)
- (push (concat-pnames 'make- (dd-name defstruct)) defaults))
+ (push (symbolicate "MAKE-" (dd-name defstruct)) defaults))
(collect ((res))
(when defaults
(rest args)))
(inherits (inherits-for-structure defstruct)))
(function-%compiler-only-defstruct defstruct inherits)))
+
+(/show0 "code/defstruct.lisp end of file")