Added bits functions

library/bits.lisp

@@ -15,7 +15,11 @@
    #:or
    #:xor
    #:not
-   #:shift))
+   #:shift
+   #:Byte
+   #:dpb
+   #:ldb
+   #:print-bits))
 
 (in-package #:coalton-library/bits)
 
@@ -36,7 +40,30 @@
     (not   "The bitwise logical `not` of two integers"
            (:int -> :int))
     (shift "The arithmetic left-shift of an integer by an integer number of bits"
-           (Integer -> :int -> :int))))
+           (Integer -> :int -> :int)))
+
+  (define-struct Byte
+    "A Byte object, modeled after Common Lisp's `Bytespec`."
+    (size UFix)
+    (position UFix))
+
+  (declare dpb (Bits :a => (:a -> Byte -> UFix -> :a)))
+  (define (dpb bitstring (Byte size position) newbyte)
+    "Deposits a byte `newbyte` of size `size` into a bitstring `bitstring` at a position `position`."
+    (lisp :a (newbyte bitstring size position)
+      (cl:dpb newbyte (cl:byte size position) bitstring)))
+
+  (declare ldb (Bits :a => :a -> Byte -> :a))
+  (define (ldb bitstring (Byte size position))
+    "Deposits a byte of size `size` into a bitstring at a position `position`."
+    (lisp :a (bitstring size position)
+      (cl:ldb (cl:byte size position) bitstring)))
+
+  (declare print-bits (Bits :a => UFix -> :a -> String))
+  (define (print-bits width x)
+    "Prints an integer to a binary string, preserving leading zeros to a given width."
+    (lisp String (x width)
+               (cl:format cl:nil (cl:format cl:nil "~~~a,'0b" width) x))))
 
 #+sb-package-locks
 (sb-ext:lock-package "COALTON-LIBRARY/BITS")