Changeset 14602
- Timestamp:
- 01/16/14 17:18:38 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp
r14436 r14602 344 344 (stream-write-char stream #\Space))))) 345 345 346 (defun basic-read-sequence (stream sequence start end 347 expected-element-type read-fun) 348 (let ((element-type (stream-element-type stream))) 349 (if (subtypep element-type expected-element-type) 350 (dotimes (count (- end start) 351 ;; If (< end start), skip the dotimes body but 352 ;; return start 353 (max start end)) 354 (let ((el (funcall read-fun stream))) 355 (when (eq el :eof) 356 (return (+ count start))) 357 (setf (elt sequence (+ count start)) el))) 358 (error "Cannot READ-SEQUENCE on stream of :ELEMENT-TYPE ~A" 359 element-type)))) 360 361 (defun basic-write-sequence (stream sequence start end 362 expected-element-type write-fun) 363 (let ((element-type (stream-element-type stream))) 364 (if (subtypep element-type expected-element-type) 365 ;; Avoid LOOP because it isn't loaded yet 366 (do ((n start (+ n 1))) 367 ((= n end)) 368 (funcall write-fun stream (elt sequence n))) 369 (error "Cannot WRITE-SEQUENCE on stream of :ELEMENT-TYPE ~A" 370 element-type))) 371 (stream-force-output stream) 372 sequence) 373 346 374 (defmethod stream-read-sequence ((stream fundamental-character-input-stream) 347 375 sequence &optional (start 0) end) 348 (let ((element-type (stream-element-type stream)) 349 (end (or end (length sequence))) 350 (eof (cons nil nil))) 351 (cond 352 ((eq element-type 'character) 353 (dotimes (count (- end start) (- end start)) 354 (let ((c (stream-read-char stream nil eof))) 355 (if (eq c eof) 356 (return (+ count start))) 357 (setf (elt sequence (+ count start)) c)))) 358 ((or (eq element-type 'byte) 359 (eq element-type 'unsigned-byte) 360 (eq element-type 'signed-byte)) 361 (dotimes (count (- end start) (- end start)) 362 (let ((b (stream-read-byte stream nil eof))) 363 (if (eq b eof) 364 (return (+ count start))) 365 (setf (elt sequence (+ count start)) b)))) 366 (t (error "Cannot READ-SEQUENCE on stream of :ELEMENT-TYPE ~A" 367 element-type))))) 376 (basic-read-sequence stream sequence start (or end (length sequence)) 377 'character #'stream-read-char)) 368 378 369 379 (defmethod stream-write-sequence ((stream fundamental-character-output-stream) 370 380 sequence &optional (start 0) end) 371 (let ((element-type (stream-element-type stream)) 372 (end (or end (length sequence)))) 373 (if (eq element-type 'character) 374 (do ((n start (+ n 1))) 375 ((= n end)) 376 (stream-write-char 377 stream 378 (if (typep (elt sequence n) 'number) 379 (#+nil ccl:int-char code-char (elt sequence n)) 380 (elt sequence n)))) 381 (do ((n start (+ n 1))) 382 ((= n end)) 383 (stream-write-byte (elt sequence n) stream)))) ;; recoded to avoid LOOP, because it isn't loaded yet 384 (stream-force-output stream)) 381 (basic-write-sequence stream sequence start (or end (length sequence)) 382 'character #'stream-write-char)) 385 383 386 384 (defclass fundamental-binary-input-stream … … 389 387 (defclass fundamental-binary-output-stream 390 388 (fundamental-output-stream fundamental-binary-stream)) 389 390 (defmethod stream-read-sequence ((stream fundamental-binary-input-stream) 391 sequence &optional (start 0) end) 392 (basic-read-sequence stream sequence start (or end (length sequence)) 393 'signed-byte #'stream-read-byte)) 394 395 (defmethod stream-write-sequence ((stream fundamental-binary-output-stream) 396 sequence &optional (start 0) end) 397 (basic-write-sequence stream sequence start (or end (length sequence)) 398 'signed-byte #'stream-write-byte)) 391 399 392 400 (defun decode-read-arg (arg)
Note: See TracChangeset
for help on using the changeset viewer.