(defun sharp-left-paren (stream ignore length)
(declare (ignore ignore) (special *backquote-count*))
(let* ((list (read-list stream nil))
- (listlength (handler-case (length list)
- (type-error
- (error)
- (declare (ignore error))
- (simple-reader-error stream
- "improper list in #(): ~S"
- list)))))
+ (list-length (handler-case (length list)
+ (type-error ()
+ (simple-reader-error stream
+ "Improper list in #(): ~S."
+ list)))))
(declare (list list)
- (fixnum listlength))
+ (fixnum list-length))
(cond (*read-suppress* nil)
+ ((and length (> list-length length))
+ (simple-reader-error
+ stream
+ "Vector longer than the specified length: #~S~S."
+ length list))
((zerop *backquote-count*)
(if length
- (cond ((> listlength (the fixnum length))
- (simple-reader-error
- stream
- "vector longer than specified length: #~S~S"
- length list))
- (t
- (fill (the simple-vector
- (replace (the simple-vector
- (make-array length))
- list))
- (car (last list))
- :start listlength)))
+ (fill (replace (make-array length) list)
+ (car (last list))
+ :start list-length)
(coerce list 'vector)))
- (t (cons *bq-vector-flag* list)))))
+ (t
+ (cons *bq-vector-flag*
+ (if length
+ (append list
+ (make-list (- length list-length)
+ :initial-element (car (last list))))
+ list))))))
(defun sharp-star (stream ignore numarg)
(declare (ignore ignore))
(when *read-suppress*
(read stream t nil t)
(return-from sharp-A nil))
- (unless dimensions (simple-reader-error stream
- "no dimensions argument to #A"))
+ (unless dimensions
+ (simple-reader-error stream "No dimensions argument to #A."))
(collect ((dims))
- (let* ((contents (read stream t nil t))
+ (let* ((*bq-error*
+ (if (zerop *backquote-count*)
+ *bq-error*
+ "Comma inside a backquoted array (not a list or general vector.)"))
+ (*backquote-count* 0)
+ (contents (read stream t nil t))
(seq contents))
(dotimes (axis dimensions
(make-array (dims) :initial-contents contents))
(when *read-suppress*
(read stream t nil t)
(return-from sharp-S nil))
- (let ((body (if (char= (read-char stream t) #\( )
- (read-list stream nil)
+ (let* ((*bq-error*
+ (if (zerop *backquote-count*)
+ *bq-error*
+ "Comma inside backquoted structure (not a list or general vector.)"))
+ (*backquote-count* 0)
+ (body (if (char= (read-char stream t) #\( )
+ (let ((*backquote-count* 0))
+ (read-list stream nil))
(simple-reader-error stream "non-list following #S"))))
(unless (listp body)
(simple-reader-error stream "non-list following #S: ~S" body))
(unless (eq old new)
(setf (aref data i) new))))))
((typep tree 'instance)
- (do ((i 1 (1+ i))
- (end (%instance-length tree)))
- ((= i end))
- (let* ((old (%instance-ref tree i))
- (new (circle-subst old-new-alist old)))
- (unless (eq old new)
- (setf (%instance-ref tree i) new)))))
+ (let* ((n-untagged (layout-n-untagged-slots (%instance-layout tree)))
+ (n-tagged (- (%instance-length tree) n-untagged)))
+ ;; N-TAGGED includes the layout as well (at index 0), which
+ ;; we don't grovel.
+ (do ((i 1 (1+ i)))
+ ((= i n-tagged))
+ (let* ((old (%instance-ref tree i))
+ (new (circle-subst old-new-alist old)))
+ (unless (eq old new)
+ (setf (%instance-ref tree i) new))))
+ (do ((i 0 (1+ i)))
+ ((= i n-untagged))
+ (let* ((old (%raw-instance-ref/word tree i))
+ (new (circle-subst old-new-alist old)))
+ (unless (= old new)
+ (setf (%raw-instance-ref/word tree i) new))))))
((typep tree 'funcallable-instance)
(do ((i 1 (1+ i))
(end (- (1+ (get-closure-length tree)) sb!vm:funcallable-instance-info-offset)))