X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-simple-streams%2Fclasses.lisp;h=d11a62a61e3f2c790ab90bc52285a9b782d0a984;hb=1b650be8b800cf96e2c268ae317fb26d0bf36827;hp=0ad1d44748a52719415060cfcc1993b5a1dd9616;hpb=0677c33068646b6ec33d5f622771673f3de38504;p=sbcl.git diff --git a/contrib/sb-simple-streams/classes.lisp b/contrib/sb-simple-streams/classes.lisp index 0ad1d44..d11a62a 100644 --- a/contrib/sb-simple-streams/classes.lisp +++ b/contrib/sb-simple-streams/classes.lisp @@ -35,7 +35,7 @@ (values fixnum &optional (member nil t :eof)))) (deftype j-write-char-fn () - '(function (character simple-stream) character)) + '(function ((or character null) simple-stream) (or character null))) (deftype j-write-chars-fn () '(function (string simple-stream fixnum fixnum) t)) ;; return chars-written? @@ -66,6 +66,9 @@ (defvar *slot-access-functions* (make-hash-table)) (defvar *automagic-accessors* nil)) +;;; Commented out in favor of standard class machinery that does not +;;; depend on implementation internals. +#+nil (defmacro def-stream-class (name superclasses slots &rest options) (let ((accessors ()) (real-slots ())) @@ -123,6 +126,12 @@ collect `(setf (gethash ',(car accessor) *slot-access-functions*) ',(cdr accessor))))))) + +(defmacro def-stream-class (name superclasses slots &rest options) + (let ((slots (copy-tree slots))) + (dolist (slot slots) (remf (cdr slot) 'sb-pcl::location)) + `(defclass ,name ,superclasses ,slots ,@options))) + (def-stream-class simple-stream (standard-object stream) ((plist :initform nil :type list :accessor stream-plist sb-pcl::location 19) @@ -131,17 +140,17 @@ ;; A function that determines if one character can be successfully ;; read from stream. - (j-listen :type j-listen-fn sb-pcl::location 18) + (j-listen :initform #'sb-kernel:ill-in :type j-listen-fn sb-pcl::location 18) ;; A function that reads one character. - (j-read-char :type j-read-char-fn sb-pcl::location 17) + (j-read-char :initform #'sb-kernel:ill-in :type j-read-char-fn sb-pcl::location 17) ;; A function that reads characters into a string. - (j-read-chars :type j-read-chars-fn sb-pcl::location 16) + (j-read-chars :initform #'sb-kernel:ill-in :type j-read-chars-fn sb-pcl::location 16) ;; A function that writes one character. - (j-write-char :type j-write-char-fn sb-pcl::location 15) + (j-write-char :initform #'sb-kernel:ill-out :type j-write-char-fn sb-pcl::location 15) ;; A function that writes characters from a string into the stream. - (j-write-chars :type j-write-chars-fn sb-pcl::location 14) + (j-write-chars :initform #'sb-kernel:ill-out :type j-write-chars-fn sb-pcl::location 14) ;; A function that unreads the last character read. - (j-unread-char :type j-unread-char-fn sb-pcl::location 13) + (j-unread-char :initform #'sb-kernel:ill-in :type j-unread-char-fn sb-pcl::location 13) ;; Other slots @@ -211,10 +220,11 @@ ()) (def-stream-class file-simple-stream (single-channel-simple-stream) - ((pathname :initform nil :initarg :pathname) - (filename :initform nil :initarg :filename) - (original :initform nil :initarg :original) - (delete-original :initform nil :initarg :delete-original) + ((pathname :initform nil :initarg :pathname sb-pcl::location 27) + (filename :initform nil :initarg :filename sb-pcl::location 26) + (original :initform nil :initarg :original sb-pcl::location 25) + (delete-original :initform nil :initarg :delete-original + sb-pcl::location 24) )) (def-stream-class mapped-file-simple-stream (file-simple-stream @@ -224,8 +234,8 @@ ;;; A stream with two octet buffers, for example a socket or terminal ;;; stream. (def-stream-class dual-channel-simple-stream (simple-stream) - ;; Output buffer. - ((out-buffer :initform nil :type (or simple-stream-buffer null) + (;; Output buffer. + (out-buffer :initform nil :type (or simple-stream-buffer null) sb-pcl::location 26) ;; Current position in output buffer. (outpos :initform 0 :type fixnum sb-pcl::location 25) @@ -256,8 +266,14 @@ ;;; A stream with a string as buffer. (def-stream-class string-simple-stream (simple-stream) - ;; The input/output buffer. - ((buffer :initform nil :type (or simple-stream-buffer null) + ()) + +(def-stream-class composing-stream (string-simple-stream) + ()) + +(def-stream-class string-input-simple-stream (string-simple-stream) + (;; The input buffer. + (buffer :initform nil :type (or simple-stream-buffer null) sb-pcl::location 23) ;; Current position in buffer. (buffpos :initform 0 :type fixnum sb-pcl::location 22) @@ -265,22 +281,24 @@ (buffer-ptr :initform 0 :type fixnum sb-pcl::location 21) (buf-len :initform 0 :type fixnum sb-pcl::location 20))) -(def-stream-class composing-stream (string-simple-stream) - ()) - -(def-stream-class string-input-simple-stream (string-simple-stream) - ()) - (def-stream-class string-output-simple-stream (string-simple-stream) - ;; The output buffer (slot added so that a class can inherit from - ;; both string-input-simple-stream and string-output-simple-stream - ;; without the strategies clashing) - ((out-buffer :initform nil :type (or simple-stream-buffer null) - sb-pcl::location 26) + (;; The input buffer. + (buffer :initform nil :type (or simple-stream-buffer null) + sb-pcl::location 26) + ;; Current position in input buffer. + (buffpos :initform 0 :type fixnum sb-pcl::location 25) + ;; Maximum valid position in input buffer, or -1 on eof. + (buffer-ptr :initform 0 :type fixnum sb-pcl::location 24) + (buf-len :initform 0 :type fixnum sb-pcl::location 23) + ;; The output buffer (slot added so that a class can inherit from + ;; both string-input-simple-stream and string-output-simple-stream + ;; without the strategies clashing) + (out-buffer :initform nil :type (or simple-stream-buffer null) + sb-pcl::location 22) ;; Current position in output buffer. - (outpos :initform 0 :type fixnum sb-pcl::location 25) + (outpos :initform 0 :type fixnum sb-pcl::location 21) ;; Buffer length (one greater than maximum output buffer index) - (max-out-pos :initform 0 :type fixnum sb-pcl::location 24))) + (max-out-pos :initform 0 :type fixnum sb-pcl::location 20))) (def-stream-class fill-pointer-output-simple-stream (string-output-simple-stream) @@ -329,6 +347,4 @@ (defgeneric device-clear-output (stream)) -(defgeneric device-extend (stream need action)) - (defgeneric device-finish-record (stream blocking action))