;; through here.
(%slotplace-accessor-funs (slotplace instance-type-check-form)
(/show "macroexpanding %SLOTPLACE-ACCESSOR-FUNS" slotplace instance-type-check-form)
- `(values (lambda (instance)
- (/noshow0 "in %SLOTPLACE-ACCESSOR-FUNS-defined reader")
- ,instance-type-check-form
- (/noshow0 "back from INSTANCE-TYPE-CHECK-FORM")
- ,slotplace)
- (let ((typecheckfun (typespec-typecheckfun dsd-type)))
- (lambda (new-value instance)
+ `(let ((typecheckfun (typespec-typecheckfun dsd-type)))
+ (values (if (dsd-safe-p dsd)
+ (lambda (instance)
+ (/noshow0 "in %SLOTPLACE-ACCESSOR-FUNS-defined reader")
+ ,instance-type-check-form
+ (/noshow0 "back from INSTANCE-TYPE-CHECK-FORM")
+ ,slotplace)
+ (lambda (instance)
+ (/noshow0 "in %SLOTPLACE-ACCESSOR-FUNS-defined reader")
+ ,instance-type-check-form
+ (/noshow0 "back from INSTANCE-TYPE-CHECK-FORM")
+ (let ((value ,slotplace))
+ (funcall typecheckfun value)
+ value)))
+ (lambda (new-value instance)
(/noshow0 "in %SLOTPLACE-ACCESSOR-FUNS-defined writer")
,instance-type-check-form
(/noshow0 "back from INSTANCE-TYPE-CHECK-FORM")
(let ((dsd-index (dsd-index dsd))
(dsd-type (dsd-type dsd)))
-
+
#+sb-xc (/show0 "got DSD-TYPE=..")
#+sb-xc (/hexstr dsd-type)
(ecase (dd-type dd)
(structure
#+sb-xc (/show0 "case of DSD-TYPE = STRUCTURE")
(%native-slot-accessor-funs %instance-ref))
-
+
;; structures with the :TYPE option
;; FIXME: Worry about these later..
res))
\f
-;;; default PRINT-OBJECT and MAKE-LOAD-FORM methods
+;;; default PRINT-OBJECT method
(defun %default-structure-pretty-print (structure stream)
(let* ((layout (%instance-layout structure))
(pprint-pop)
(let ((slot (pop remaining-slots)))
(write-char #\: stream)
- (output-symbol-name (dsd-%name slot) stream)
+ (output-symbol-name (symbol-name (dsd-name slot)) stream)
(write-char #\space stream)
(pprint-newline :miser stream)
(output-object (funcall (fdefinition (dsd-accessor-name slot))
(write-char #\space stream)
(write-char #\: stream)
(let ((slot (first remaining-slots)))
- (output-symbol-name (dsd-%name slot) stream)
+ (output-symbol-name (symbol-name (dsd-name slot)) stream)
(write-char #\space stream)
(output-object
(funcall (fdefinition (dsd-accessor-name slot))
(%default-structure-ugly-print structure stream))))
(def!method print-object ((x structure-object) stream)
(default-structure-print x stream *current-level-in-print*))
-
-(defun make-load-form-saving-slots (object &key slot-names environment)
- (declare (ignore object environment))
- (if slot-names
- (error "stub: MAKE-LOAD-FORM-SAVING-SLOTS :SLOT-NAMES not implemented") ; KLUDGE
- :sb-just-dump-it-normally))
\f
;;;; testing structure types
,x
,(compiler-layout-or-lose class-name)))
((vector)
- (let ((xx (gensym "X")))
+ (with-unique-names (xx)
`(let ((,xx ,x))
(declare (type vector ,xx))
,@(when (dd-named dd)
:format-arguments (list ',class-name ,xx)))))
(values))))
((list)
- (let ((xx (gensym "X")))
+ (with-unique-names (xx)
`(let ((,xx ,x))
(declare (type list ,xx))
,@(when (dd-named dd)