Changeset 12183


Ignore:
Timestamp:
10/09/09 21:31:50 (12 years ago)
Author:
ehuelsmann
Message:

Fix last Gray stream incompatibilities: generic functions

overlapping with CL functions are no longer have the STREAM- prefix.

Note: this commit also removes gray stream testing code which does

not belong in the "production" image of our software.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/gray-streams.lisp

    r12014 r12183  
    9595;;;; Notes
    9696;;;; =====
    97 ;;;; CLOSE is not a generic function in this implementation. Instead,
    98 ;;;; the generic is called STREAM-CLOSE and the function CLOSE calls
    99 ;;;; STREAM-CLOSE. The same goes for STREAMP, INPUT-STREAM-P,
    100 ;;;; OUTPUT-STREAM-P and STREAM-ELEMENT-TYPE. The generic functions for
    101 ;;;; these are STREAM-STREAMP, STREAM-INPUT-STREAM-P,
    102 ;;;; STREAM-OUTPUT-STREAM-P and STREAM-STREAM-ELEMENT-TYPE.
    103 ;;;;
    104 ;;;; The standard Corman Lisp streams are not derived from
    105 ;;;; FUNDAMENTAL-STREAM. All the stream functions check to see if the
    106 ;;;; stream is an original Corman Lisp stream and forward on to the
    107 ;;;; original function implementations.
    108 ;;;;
    109 ;;;; The string streams are implemented in this file as Gray streams
    110 ;;;; but do not replace the Corman Lisp string streams. They are only
    111 ;;;; implemented here to test the Gray stream functionality. These methods
    112 ;;;; are called:
    113 ;;;;    GRAY-MAKE-STRING-OUTPUT-STREAM
    114 ;;;;    GRAY-GET-OUTPUT-STREAM-STRING
    115 ;;;;    GRAY-MAKE-STRING-INPUT-STREAM
     97;;;;
    11698;;;;
    11799;;;; Much of the implementation of the Gray streams below is from the
     
    124106  (:export
    125107   "FUNDAMENTAL-STREAM"
    126    "STREAM-CLOSE"
    127108   "STREAM-OPEN-STREAM-P"
    128109   "STREAM-STREAMP"
     
    201182(defclass fundamental-stream ())
    202183
    203 (defgeneric stream-close (stream &key abort))
    204 (defgeneric stream-open-stream-p (stream))
    205 (defgeneric stream-streamp (stream))
    206 (defgeneric stream-input-stream-p (stream))
    207 (defgeneric stream-input-character-stream-p (stream)) ;; # fb 1.01
    208 (defgeneric stream-output-stream-p (stream))
    209 (defgeneric stream-stream-element-type (stream))
    210 
    211 (defmethod stream-close (stream &key abort)
    212   (declare (ignore stream abort))
    213   nil)
    214 
    215 (defmethod stream-streamp (s)
    216   (declare (ignore s))
    217   nil)
     184(defgeneric gray-close (stream &key abort))
     185(defgeneric gray-open-stream-p (stream))
     186(defgeneric gray-streamp (stream))
     187(defgeneric gray-input-stream-p (stream))
     188(defgeneric gray-input-character-stream-p (stream)) ;; # fb 1.01
     189(defgeneric gray-output-stream-p (stream))
     190(defgeneric gray-stream-element-type (stream))
     191
    218192
    219193(defmethod stream-streamp ((s fundamental-stream))
     
    226200       (eq (stream-stream-element-type s) 'character)))
    227201
    228 (defmethod stream-input-stream-p (s)
    229   (declare (ignore s))
    230   nil)
    231 
    232202(defmethod stream-input-stream-p ((s fundamental-input-stream))
    233203  (declare (ignore s))
     
    235205
    236206(defclass fundamental-output-stream (fundamental-stream))
    237 
    238 (defmethod stream-output-stream-p (s)
    239   (declare (ignore s))
    240   nil)
    241207
    242208(defmethod stream-output-stream-p ((s fundamental-output-stream))
     
    540506      (stream-write-byte binary-output-stream integer)))
    541507
    542 (defclass string-input-stream (fundamental-character-input-stream)
    543   ((string :initarg :string :type string)
    544    (index :initarg :start :type fixnum)
    545    (end :initarg :end :type fixnum)))
    546 
    547 (defun gray-make-string-input-stream (string &optional (start 0) end)
    548   (make-instance 'string-input-stream :string string
    549                  :start start :end (or end (length string))))
    550 
    551 (defmethod stream-read-char ((stream string-input-stream))
    552   (with-slots (index end string) stream
    553     (if (>= index end)
    554         :eof
    555         (prog1
    556          (char string index)
    557          (incf index)))))
    558 
    559 (defmethod stream-unread-char ((stream string-input-stream) character)
    560   (with-slots (index end string) stream
    561     (decf index)
    562     (assert (eql (char string index) character))
    563     nil))
    564 
    565 (defmethod stream-read-line ((stream string-input-stream))
    566   (with-slots (index end string) stream
    567     (let* ((endline (position #\newline string :start index :end end))
    568            (line (subseq string index endline)))
    569       (if endline
    570           (progn
    571             (setq index (1+ endline))
    572             (values line nil))
    573           (progn
    574             (setq index end)
    575             (values line t))))))
    576 
    577 (defclass string-output-stream (fundamental-character-output-stream)
    578   ((string :initform nil :initarg :string)))
    579 
    580 (defun gray-make-string-output-stream ()
    581   (make-instance 'string-output-stream))
    582 
    583 (defun gray-get-output-stream-string (stream)
    584   (with-slots (string) stream
    585     (if (null string)
    586         ""
    587         (prog1
    588          (coerce string 'string)
    589          (setq string nil)))))
    590 
    591 (defmethod stream-write-char ((stream string-output-stream) character)
    592   (with-slots (string) stream
    593     (when (null string)
    594       (setq string (make-array 64 :slement-type 'character
    595                                :fill-pointer 0 :adjustable t)))
    596     (vector-push-extend character string)
    597     character))
    598 
    599 (defmethod stream-line-column ((stream string-output-stream))
    600   (with-slots (string) stream
    601     (if (null string)
    602         0
    603         (let ((nx (position #\newline string :from-end t)))
    604           (if (null nx)
    605               (length string)
    606               (- (length string) nx 1))))))
    607 
    608508(defmethod stream-line-column ((stream stream))
    609509  nil)
     
    615515        (stream-line-column stream))))
    616516
    617 (defun gray-stream-element-type (stream)
    618   (if (old-streamp stream)
    619       (funcall *old-stream-element-type* stream)
    620       (stream-stream-element-type stream)))
    621 
    622 (defun gray-close (stream &key abort)
    623   (if (old-streamp stream)
    624       (funcall *old-close* stream :abort abort)
    625       (stream-close stream :abort nil)))
    626 
    627 (defun gray-input-stream-p (stream)
    628   (if (old-streamp stream)
    629       (funcall *old-input-stream-p* stream)
    630       (stream-input-stream-p stream)))
    631 
    632 (defun gray-input-character-stream-p (stream)
    633   (if (old-streamp stream)
    634       (funcall *old-input-character-stream-p* stream)
    635       (stream-input-character-stream-p stream)))
    636 
    637 (defun gray-output-stream-p (stream)
    638   (if (old-streamp stream)
    639       (funcall *old-output-stream-p* stream)
    640       (stream-output-stream-p stream)))
    641 
    642 (defun gray-open-stream-p (stream)
    643   (if (old-streamp stream)
    644       (funcall *old-open-stream-p* stream)
    645       (stream-open-stream-p stream)))
    646 
    647 (defun gray-streamp (stream)
    648   (if (old-streamp stream)
    649       (funcall *old-streamp* stream)
    650       (stream-streamp stream)))
     517(defmethod gray-stream-element-type (stream)
     518  (funcall *old-stream-element-type* stream))
     519
     520(defmethod gray-close (stream &key abort)
     521  (funcall *old-close* stream :abort abort))
     522
     523(defmethod gray-input-stream-p (stream)
     524  (funcall *old-input-stream-p* stream))
     525
     526(defmethod gray-input-character-stream-p (stream)
     527  (funcall *old-input-character-stream-p* stream))
     528
     529(defmethod gray-output-stream-p (stream)
     530  (funcall *old-output-stream-p* stream))
     531
     532(defmethod gray-open-stream-p (stream)
     533  (funcall *old-open-stream-p* stream))
     534
     535(defmethod gray-streamp (stream)
     536  (funcall *old-streamp* stream))
    651537
    652538(defun gray-write-sequence (sequence stream &key (start 0) end)
     
    659545      (funcall *old-read-sequence* sequence stream :start start :end end)
    660546      (stream-read-sequence stream sequence start end)))
    661 
    662 (defstruct two-way-stream-g
    663   input-stream output-stream)
    664 
    665 (defun gray-make-two-way-stream (in out)
    666   (if (and (old-streamp in) (old-streamp out))
    667       (funcall *old-make-two-way-stream* in out)
    668       (make-two-way-stream-g :input-stream in :output-stream out)))
    669 
    670 (defun gray-two-way-stream-input-stream (stream)
    671   (if (old-streamp stream)
    672       (funcall *old-two-way-stream-input-stream* stream)
    673       (two-way-stream-g-input-stream stream)))
    674 
    675 (defun gray-two-way-stream-output-stream (stream)
    676   (if (old-streamp stream)
    677       (funcall *old-two-way-stream-output-stream* stream)
    678       (two-way-stream-g-output-stream stream)))
    679547
    680548(setf (symbol-function 'common-lisp::read-char) #'gray-read-char)
     
    704572(setf (symbol-function 'common-lisp::read-sequence) #'gray-read-sequence)
    705573(setf (symbol-function 'common-lisp::write-sequence) #'gray-write-sequence)
    706 (setf (symbol-function 'common-lisp::make-two-way-stream) #'gray-make-two-way-stream)
    707 (setf (symbol-function 'common-lisp::two-way-stream-input-stream) #'gray-two-way-stream-input-stream)
    708 (setf (symbol-function 'common-lisp::two-way-stream-output-stream) #'gray-two-way-stream-output-stream)
    709574
    710575(provide 'gray-streams)
Note: See TracChangeset for help on using the changeset viewer.