If EXPORT is non-nil, then export the `CODE-inst' and `make-CODE-inst'
symbols."
- (multiple-value-bind (bvl cooked raw)
+ (multiple-value-bind (bvl public private)
(let ((state :mandatory)
(bvl (make-list-builder))
- (cooked (make-list-builder))
- (raw (make-list-builder)))
+ (public (make-list-builder))
+ (private (make-list-builder)))
(labels ((recurse-arg (arg path)
(cond ((symbolp arg)
(let ((name (symbol-name arg)))
(if (and (plusp (length name))
(char= (char name 0) #\%))
- (let ((cooked (intern (subseq name 1))))
- (values cooked cooked arg))
+ (let ((public (intern (subseq name 1))))
+ (values public public arg))
(values arg arg arg))))
((atom arg)
(error "Unexpected item ~S in lambda-list." arg))
((null path)
- (multiple-value-bind (cooked raw)
+ (multiple-value-bind (public private)
(if (cdr arg) (values (car arg) (cadr arg))
(values (car arg) (car arg)))
- (values cooked cooked raw)))
+ (values public public private)))
(t
(let* ((step (car path))
(mine (nthcdr step arg)))
- (multiple-value-bind (full cooked raw)
+ (multiple-value-bind (full public private)
(recurse-arg (car mine) (cdr path))
(values (append (subseq arg 0 step)
full
(cdr mine))
- cooked
- raw))))))
+ public
+ private))))))
(hack-arg (arg maxdp)
- (multiple-value-bind (full cooked-name raw-name)
+ (multiple-value-bind (full public-name private-name)
(recurse-arg arg maxdp)
(lbuild-add bvl full)
- (lbuild-add cooked cooked-name)
- (lbuild-add raw raw-name))))
+ (lbuild-add public public-name)
+ (lbuild-add private private-name))))
(dolist (arg args)
(cond ((or (eq arg '&optional)
(eq arg '&rest)
(t
(error "Confusion in ~S!" 'definst)))))
(values (lbuild-list bvl)
- (lbuild-list cooked)
- (lbuild-list raw)))
+ (lbuild-list public)
+ (lbuild-list private)))
(let* ((inst-var (gensym "INST"))
(class-name (symbolicate code '-inst))
(constructor-name (symbolicate 'make- code '-inst))
(keys (mapcar (lambda (arg) (intern (symbol-name arg) :keyword))
- cooked)))
+ public)))
`(progn
(defclass ,class-name (inst)
- ,(mapcar (lambda (cooked-slot raw-slot key)
- `(,raw-slot :initarg ,key
- :reader ,(symbolicate 'inst- cooked-slot)))
- cooked raw keys))
+ ,(mapcar (lambda (public-slot private-slot key)
+ `(,private-slot :initarg ,key
+ :reader ,(symbolicate 'inst- public-slot)))
+ public private keys))
(defun ,constructor-name (,@bvl)
- (make-instance ',class-name ,@(mappend #'list keys cooked)))
+ (make-instance ',class-name ,@(mappend #'list keys public)))
(defmethod inst-metric ((,inst-var ,class-name))
- (with-slots (,@raw) ,inst-var
- (+ 1 ,@(mapcar (lambda (slot) `(inst-metric ,slot)) raw))))
+ (with-slots (,@private) ,inst-var
+ (+ 1 ,@(mapcar (lambda (slot) `(inst-metric ,slot)) private))))
(defmethod print-object ((,inst-var ,class-name) ,streamvar)
- (with-slots ,(mapcar #'list cooked raw) ,inst-var
+ (with-slots ,(mapcar #'list public private) ,inst-var
(if *print-escape*
(print-unreadable-object (,inst-var ,streamvar :type t)
(format stream "~@<~@{~S ~@_~S~^ ~_~}~:>"
- ,@(mappend #'list keys cooked)))
+ ,@(mappend #'list keys public)))
(block ,code ,@body))))
,@(and export `((export '(,class-name ,constructor-name
,@(mapcar (lambda (slot)
(symbolicate 'inst- slot))
- cooked)))))
+ public)))))
',code))))
;; Formatting utilities.