--- a/src/bit-streams.lisp Sat Jul 18 22:27:52 2020 -0400
+++ b/src/bit-streams.lisp Sat Jul 18 22:46:32 2020 -0400
@@ -1,95 +1,72 @@
(in-package :tdcb)
-;;;; Common -------------------------------------------------------------------
-(defclass bit-stream (trivial-gray-streams:fundamental-binary-stream)
- ((underlying-stream :accessor underlying-stream :initarg :underlying-stream :type stream)
- (rack :accessor rack :type (unsigned-byte 8) :initform 0)
- (mask :accessor mask :type (unsigned-byte 8) :initform #b10000000)))
+;;;; Struct -------------------------------------------------------------------
+(defstruct (bits (:constructor make-bits% (underlying-stream))
+ (:conc-name nil))
+ (underlying-stream nil :type stream :read-only t)
+ (rack 0 :type (unsigned-byte 8))
+ (mask #b10000000 :type (unsigned-byte 8)))
-(defmethod close ((stream bit-stream) &key abort)
- (when (open-stream-p (underlying-stream stream))
- (close (underlying-stream stream) :abort abort)))
-
-(defmethod stream-element-type ((stream bit-stream))
- 'bit)
-
-(defmethod stream-file-position ((stream bit-stream))
- (error "Cannot change position of a bit stream."))
+(declaim (inline write-bit% read-bit%))
-;;;; Output -------------------------------------------------------------------
-(defclass bit-output-stream (bit-stream trivial-gray-streams:fundamental-binary-output-stream) ())
-
-(defun make-bit-output-stream (stream)
- (make-instance 'bit-output-stream :underlying-stream stream))
-
+;;;; Write --------------------------------------------------------------------
+(defun write-bit% (b bit)
+ (declare (type bits b))
+ (when (plusp bit)
+ (logiorf (rack b) (mask b)))
+ (when (zerop (ashf (mask b) -1))
+ (write-byte (rack b) (underlying-stream b))
+ (setf (rack b) 0
+ (mask b) #b10000000)))
-(declaim (inline write-bit%))
-(defun write-bit% (stream bit)
- (when (plusp bit)
- (logiorf (rack stream) (mask stream)))
- (when (zerop (ashf (mask stream) -1))
- (write-byte (rack stream) (underlying-stream stream))
- (setf (rack stream) 0
- (mask stream) #b10000000)))
-(defun write-bits (stream byte &optional (count 1))
+(defun write-bit (b bit)
+ (write-bit% b bit)
+ bit)
+
+(defun write-bits (b byte count)
(loop :with mask = (ash 1 (1- count))
:until (zerop mask)
- :do (progn (write-bit% stream (logand mask byte))
+ :do (progn (write-bit% b (logand mask byte))
(ashf mask -1)))
byte)
-
-(defmethod trivial-gray-streams:stream-write-byte ((stream bit-output-stream) bit)
- (write-bit% stream bit))
-
-(defmethod close ((stream bit-output-stream) &key abort)
- (declare (ignore abort))
- (unless (= (mask stream) #b10000000)
- (write-byte (rack stream) (underlying-stream stream)))
- (call-next-method))
-
-(with-open-stream (s (make-bit-output-stream *standard-output*)) (write-byte #b00101010 s))
+(defun flush (b)
+ (unless (= (mask b) #x80)
+ (write-byte (rack b) (underlying-stream b))))
-;;;; Input -------------------------------------------------------------------
-(defclass bit-input-stream (bit-stream trivial-gray-streams:fundamental-binary-input-stream) ())
-
-(defun make-bit-input-stream (stream)
- (make-instance 'bit-input-stream :underlying-stream stream))
-
-
-(declaim (inline read-bit))
-(defun read-bit (stream)
- (when (= (mask stream) #b10000000)
- (setf (rack stream) (read-byte (underlying-stream stream))))
- (prog1 (if (zerop (logand (mask stream) (rack stream)))
+;;;; Read ---------------------------------------------------------------------
+(defun read-bit% (b)
+ (declare (type bits b))
+ (when (= (mask b) #b10000000)
+ (setf (rack b) (read-byte (underlying-stream b))))
+ (prog1 (if (zerop (logand (mask b) (rack b)))
0
1)
- (when (zerop (ashf (mask stream) -1))
- (setf (mask stream) #b10000000))))
+ (when (zerop (ashf (mask b) -1))
+ (setf (mask b) #b10000000))))
-(defun read-bits (stream count)
+(defun read-bit (b)
+ (read-bit% b))
+
+(defun read-bits (b count)
(loop :with result = 0
:with mask = (ash 1 (1- count))
:until (zerop mask)
- :do (progn (when (plusp (read-bit stream))
+ :do (progn (when (plusp (read-bit b))
(logiorf result mask))
(ashf mask -1))
:finally (return result)))
-(defmethod trivial-gray-streams:stream-read-byte ((stream bit-input-stream))
- (read-bit stream))
-
-
-#; Scratch --------------------------------------------------------------------
+;;;; Create -------------------------------------------------------------------
+(defmacro with-bits-output ((var stream) &body body)
+ `(let ((,var (make-bits% ,stream)))
+ (unwind-protect (progn ,@body)
+ (flush ,var))))
-(defparameter *o* (make-bit-output-stream *standard-output*))
+(defmacro with-bits-input ((var stream) &body body)
+ `(let ((,var (make-bits% ,stream)))
+ ,@body))
-(defparameter *s* (flexi-streams:make-in-memory-input-stream #(#b00101010 #b01010100)))
-(defparameter *i* (make-bit-input-stream *s*))
-
-(losh:bits (read-bits *i* 4))
-
-(read-byte *s*)--- a/tdcb.asd Sat Jul 18 22:27:52 2020 -0400
+++ b/tdcb.asd Sat Jul 18 22:46:32 2020 -0400
@@ -4,7 +4,7 @@
:license "MIT"
- :depends-on (:trivial-gray-streams)
+ :depends-on ()
:serial t
:components ((:module "src" :serial t