guile-examples/web-development/base64-encode-decode/bit-integers.scm

(define-module (bit-integers)
  #:use-module (rnrs base)
  #:use-module ((guile)
                #:select (lambda* λ
                           unless
                           call-with-output-string
                           display
                           string->list))
  ;; SRFI 1: list procedures
  #:use-module (srfi srfi-1)
  ;; SRFI 60: procedures for treating integers as bits
  #:use-module (srfi srfi-60)
  #:use-module (ice-9 textual-ports)
  #:export (bits-left-shift
            bits-right-shift
            max-int
            bit-integer-get-range
            format-as-bits
            format-as-bits-with-separators
            concat-integers))


(define bits-left-shift
  (λ (bits count)
    "Left shift BITS, an integer, by COUNT positions."
    (arithmetic-shift bits count)))


(define bits-right-shift
  (λ (bits count)
    "Right shift BITS, an integer, by COUNT positions."
    (arithmetic-shift bits (* -1 count))))


(define max-int
  (λ (num-of-squares)
    "Return the maximum integer, for a given number of bits."
    (- (expt 2 num-of-squares) 1)))


(define bit-integer-get-range
  (λ (bits width offset)
    "Treat an integer as bits and get WIDTH bits as a new integer. Start
at OFFSET from the least significant bits. Example: If the least
significant bit is on the left:

01101010 11101001
width: 6
offset: 8
Then this would look as follows:

offset:  87654321
         |
         v
01101010 11101001

bit shift by offset:
01101010

then mask with max integer of width bits:

bits: 01101010
mask: 00111111
res:  00101010"
    (let ([mask (max-int width)])
      (bitwise-and (bits-right-shift bits offset) mask))))


(define char->string
  (λ (char)
    (list->string (list char))))


(define insert-separators
  (lambda* (string
            #:key
            (chunk-width 8)
            (separator "|"))
    (call-with-output-string
      (λ (port)
        (let iter ([index 0]
                   [binary-chars° (string->list string)])
          (unless (null? binary-chars°)
            (cond
             [(and (not (= index 0))
                   (= (remainder index chunk-width) 0))
              (put-string port separator)
              (put-char port (car binary-chars°))
              (iter (+ index 1)
                    (cdr binary-chars°))]
             [else
              (put-char port (car binary-chars°))
              (iter (+ index 1)
                    (cdr binary-chars°))])))))))


(define format-as-bits
  (lambda* (bit-int #:key (padding-length 8) (padding-char #\0))
    (let ([format-string
           (string-append "~"
                          (number->string padding-length)
                          ",'"
                          (char->string padding-char)
                          "b")])
      (format #f format-string bit-int))))


(define format-as-bits-with-separators
  (lambda* (bit-int
            #:key
            (padding-length 8)
            (padding-char #\0)
            (chunk-width 8)
            (separator "|"))
    (insert-separators (format-as-bits bit-int
                                       #:padding-length padding-length
                                       #:padding-char padding-char)
                       #:chunk-width chunk-width
                       #:separator separator)))


(define concat-integers
  (λ (ints ints-width)
    "Take a list of integers representing characters and
\"concattenate\". Treat those integers as bits. Shift and add them, to
get one longer sequence of bits. Treat that longer sequence of bits as
a single integer."
    (let iter ([ints° (cdr ints)]
               [concattenated° (car ints)])
      (cond
       [(null? ints°) concattenated°]
       [else
        (iter (drop ints° 1)
              (+ (bits-left-shift concattenated° ints-width)
                 (first ints°)))]))))