# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1595126792 14400
# Node ID 725fdf7522c84690e921c9da66adbdc27a29174f
# Parent  adcbdf9b281a396aff6539803b92f61ff9299e49
Use a struct instead

diff -r adcbdf9b281a -r 725fdf7522c8 src/bit-streams.lisp
--- 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*)
diff -r adcbdf9b281a -r 725fdf7522c8 tdcb.asd
--- 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