Fix make-array transforms.
[sbcl.git] / contrib / sb-simple-streams / null.lisp
1 ;;; -*- lisp -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written by Paul Foley and has been placed in the public
5 ;;; domain.
6 ;;;
7
8 ;;; Sbcl port by Rudi Schlatte.
9
10 (in-package "SB-SIMPLE-STREAMS")
11
12 ;;;
13 ;;; **********************************************************************
14 ;;;
15 ;;; Definition of Null-Simple-Stream
16
17 (def-stream-class null-simple-stream (single-channel-simple-stream)
18   ())
19
20 (declaim (ftype j-read-char-fn null-read-char))
21 (defun null-read-char (stream eof-error-p eof-value blocking)
22   (declare (ignore blocking))
23   (sb-impl::eof-or-lose stream eof-error-p eof-value))
24
25 (declaim (ftype j-read-chars-fn null-read-chars))
26 (defun null-read-chars (stream string search start end blocking)
27   (declare (ignore stream string search start end blocking))
28   (values 0 :eof))
29
30 (declaim (ftype j-unread-char-fn null-unread-char))
31 (defun null-unread-char (stream relaxed)
32   (declare (ignore stream relaxed)))
33
34 (declaim (ftype j-write-char-fn null-write-char))
35 (defun null-write-char (character stream)
36   (declare (ignore stream))
37   character)
38
39 (declaim (ftype j-write-chars-fn null-write-chars))
40 (defun null-write-chars (string stream start end)
41   (declare (ignore string stream))
42   (- end start))
43
44 (declaim (ftype j-listen-fn null-listen))
45 (defun null-listen (stream)
46   (declare (ignore stream))
47   nil)
48
49 (defmethod device-open ((stream null-simple-stream) options)
50   (with-stream-class (null-simple-stream stream)
51     (add-stream-instance-flags stream :simple :input :output)
52     ;;(install-single-channel-character-strategy
53     ;; stream (getf options :external-format :default) nil)
54     (setf (sm j-read-char stream) #'null-read-char
55           (sm j-read-chars stream) #'null-read-chars
56           (sm j-unread-char stream) #'null-unread-char
57           (sm j-write-char stream) #'null-write-char
58           (sm j-write-chars stream) #'null-write-chars
59           (sm j-listen stream) #'null-listen))
60   stream)
61
62 (defmethod device-buffer-length ((stream null-simple-stream))
63   256)
64
65 (defmethod device-read ((stream null-simple-stream) buffer
66                         start end blocking)
67   (declare (ignore buffer start end blocking))
68   -1)
69
70 (defmethod device-write ((stream null-simple-stream) buffer
71                          start end blocking)
72   (declare (ignore buffer blocking))
73   (- end start))