The aim of this task is to write functions (or create a class if your
language is Object Oriented and you prefer) for reading and writing sequences of
bits, most significant bit first. While the output of a asciiprint "STRING" is the ASCII byte sequence
"S", "T", "R", "I", "N", "G", the output of a "print" of the bits sequence
0101011101010 (13 bits) must be 0101011101010; real I/O is performed always
quantized by byte (avoiding endianness issues and relying on underlying
buffering for performance), therefore you must obtain as output the bytes
0101 0111 0101 0000 (bold bits are padding bits), i.e. in hexadecimal 57 50.

As test, you can implement a rough (e.g. don't care about error handling or
other issues) compression/decompression program for ASCII sequences
of bytes, i.e. bytes for which the most significant bit is always unused, so that you can write
seven bits instead of eight (each 8 bytes of input, we write 7 bytes of output).

These bit oriented I/O functions can be used to implement compressors and
decompressors; e.g. Dynamic and Static Huffman encodings use variable length
bits sequences, while LZW (see LZW compression) use fixed or variable words
nine (or more) bits long.

 Limits in the maximum number of bits that can be written/read in a single read/write operation are allowed.
 Errors handling is not mandatory


 
(defpackage :rosetta.bitwise-i/o
  (:use :common-lisp)
  (:export :bitwise-i/o-demo))
(in-package :rosetta.bitwise-i/o)
 
(defun byte->bit-vector (byte byte-bits)
  "Convert one BYTE into a bit-vector of BYTE-BITS length."
  (let ((vector (make-array byte-bits :element-type 'bit))
        (bit-value 1)) 
    (declare (optimize (speed 3)))
    (dotimes (bit-index byte-bits vector) 
      (setf (aref vector bit-index)
            (if (plusp (logand byte (the (unsigned-byte 8) bit-value)))
                1 0))
      (setq bit-value (ash bit-value 1)))))
 
(defun bytes->bit-vector (byte-vector byte-bits)
  "Convert a BYTE-VECTOR into a bit-vector, with each byte taking BYTE-BITS.
 
For  optimization's sake,  I  limit the  size of  the  vector to  (FLOOR
MOST-POSITIVE-FIXNUM  BYTE-BITS), which  is somewhat  ridiculously long,
but allows the compiler to trust that indices will fit in a FIXNUM." 
  (reduce (lambda (a b) (concatenate 'bit-vector a b))
          (map 'list (lambda (byte) (byte->bit-vector byte byte-bits)) byte-vector)))
 
(defun ascii-char-p (char)
  "True if CHAR is an ASCII character"
  (< (char-code char) #x80))
 
(defun assert-ascii-string (string)
  "`ASSERT' that STRING is an ASCII string."
  (assert (every #'ascii-char-p string)
          (string)
          "STRING must contain only ASCII (7-bit) characters;~%“~a”
…contains non-ASCII character~p~:*: ~{~% • ~c ~:*— ~@c ~}"
          string (coerce (remove-duplicates (remove-if #'ascii-char-p string)
                                            :test #'char=) 
                         'list)))
 
(defun ascii-string->bit-vector (string)
  "Convert a STRING consisting only  of characters in the ASCII \(7-bit)
range into a bit-vector of 7 bits per character.
 
This assumes \(as is now, in  2017, I believe universally the case) that
the local character code system \(as for `CHAR-CODE' and `CODE-CHAR') is
Unicode, or at least, a superset of ASCII \(eg: ISO-8859-*)
"
  (check-type string simple-string) 
  (assert-ascii-string string)
  (bytes->bit-vector (map 'vector #'char-code string) 7))
 
(defun pad-bit-vector-to-8 (vector)
  "Ensure that VECTOR is a multiple of 8 bits in length."
  (adjust-array vector (* 8 (ceiling (length vector) 8))))
 
(defun bit-vector->byte (vector)
  "Convert VECTOR into a single byte."
  (declare (optimize (speed 3)))
  (check-type vector bit-vector)
  (assert (<= (length vector) 8))
  (reduce (lambda (x y) 
            (logior (the (unsigned-byte 8)
                         (ash (the (unsigned-byte 8) x) 1)) 
                    (the bit y)))
          (reverse vector) :initial-value 0))
 
(defun bit-vector->bytes (vector byte-size &key (truncatep nil))
  "Convert a bit vector VECTOR into a vector of bytes of BYTE-SIZE bits each.
 
If TRUNCATEP, then discard any trailing bits."
  (let* ((out-length (funcall (if truncatep 'floor 'ceiling)
                              (length vector)
                              byte-size))
         (output (make-array out-length
                             :element-type (list 'unsigned-byte byte-size))))
    (loop for byte from 0 below out-length
          for start-bit = 0 then end-bit
          for end-bit = byte-size then (min (+ byte-size end-bit)
                                            (length vector))
          do (setf (aref output byte)
                   (bit-vector->byte (subseq vector start-bit end-bit))))
    output))
 
(defun ascii-pack-to-8-bit (string)
  "Pack an ASCII STRING into 8-bit bytes (7→8 bit packing)"
  (bit-vector->bytes (ascii-string->bit-vector string)
                     8))
 
(defun unpack-ascii-from-8-bits (byte-vector)
  "Convert an 8-bit BYTE-VECTOR into an array of (unpacked) 7-bit bytes." 
  (map 'string #'code-char
       (bit-vector->bytes 
        (pad-bit-vector-to-8 (bytes->bit-vector byte-vector 8))
        7
        :truncatep t)))
 
(defun write-7->8-bit-string-to-file (string pathname)
  "Given a string of 7-bit character STRING, create a new file at PATHNAME
with the contents of that string packed into 8-bit bytes."
  (format *trace-output* "~&Writing string to ~a in packed 7→8 bits…~%“~a”"
          pathname string)
  (assert-ascii-string string)
  (with-open-file (output pathname 
                          :direction :output
                          :if-exists :supersede
                          :element-type '(unsigned-byte 8))
    (write-sequence (ascii-pack-to-8-bit string) output) 
    (finish-output output)
    (let ((expected-length (ceiling (* (length string) 7) 8)))
      (assert (= (file-length output) expected-length) ()
              "The file written was ~:d byte~:p in length, ~
but the string supplied should have written ~:d byte~:p."
              (file-length output) expected-length))))
 
(defun read-file-into-byte-array (pathname)
  "Read a binary file into a byte array"
  (with-open-file (input pathname
                         :direction :input
                         :if-does-not-exist :error
                         :element-type '(unsigned-byte 8))
    (let ((buffer (make-array (file-length input)
                              :element-type '(unsigned-byte 8))))
      (read-sequence buffer input)
      buffer)))
 
(defun read-8->7-bit-string-from-file (pathname)
  "Read   8-bit   packed  data   from   PATHNAME   and  return   it   as
a 7-bit string."
  (unpack-ascii-from-8-bits (read-file-into-byte-array pathname)))
 
(defun bitwise-i/o-demo (&key (string "Hello, World.")
                              (pathname #p"/tmp/demo.bin"))
  "Writes STRING  to PATHNAME after  7→8 bit  packing, then reads  it back
to validate."
  (write-7->8-bit-string-to-file string pathname)
  (let ((read-back (read-8->7-bit-string-from-file pathname)))
    (assert (equal string read-back) ()
            "Reading back string got:~%“~a”~%…expected:~%“~a”" read-back string)
    (format *trace-output* "~&String read back matches:~%“~a”" read-back))
  (finish-output *trace-output*))
 
 