; packed ascii

(define (drop n xs)
  (let loop ((n n) (xs xs))
    (if (or (zero? n) (null? xs)) xs
      (loop (- n 1) (cdr xs)))))

(define (cons* first . rest)
  (let loop ((curr first) (rest rest))
    (if (null? rest) curr
        (cons curr (loop (car rest) (cdr rest))))))

(define (bitwise-and a b)
  (if (or (zero? a) (zero? b)) 0
    (+ (* (bitwise-and (floor (/ a 2)) (floor (/ b 2))) 2)
       (if (or (even? a) (even? b)) 0 1))))

(define (bitwise-xor a b)
  (cond ((zero? a) b)
        ((zero? b) a)
        (else
         (+ (* (bitwise-xor (floor (/ a 2)) (floor (/ b 2))) 2)
            (if (even? a)
                (if (even? b) 0 1)
                (if (even? b) 1 0))))))

(define (ash int cnt)
  (if (negative? cnt)
      (let ((n (expt 2 (- cnt))))
        (if (negative? int)
            (+ -1 (quotient (+ 1 int) n))
            (quotient int n)))
      (* (expt 2 cnt) int)))

(define (pack str)
  (define (compress c) (bitwise-and c #x3F))
  (define (c cs n) (let ((xs (drop n cs))) (if (null? xs) 32 (car xs))))
  (define (b n) (bitwise-and n #xFF))
  (let loop ((cs (map char->integer (string->list str))) (out (list)))
    (if (null? cs) (list->string (map integer->char (reverse out)))
      (let* ((p (+ (ash (compress (c cs 0)) 18) (ash (compress (c cs 1)) 12)
                   (ash (compress (c cs 2)) 6) (compress (c cs 3))))
             (out1 (b (ash p -16))) (out2 (b (ash p -8))) (out3 (b p)))
        (loop (drop 4 cs) (cons* out3 out2 out1 out))))))

(define (unpack str)
  (define (expand p) (+ (ash (bitwise-xor 1 (ash p -5)) 6) p))
  (define (b n) (bitwise-and n #x3F))
  (let loop ((cs (map char->integer (string->list str))) (out (list)))
    (if (null? cs) (list->string (map integer->char (reverse out)))
      (let* ((p (+ (ash (car cs) 16) (ash (cadr cs) 8) (caddr cs)))
             (out1 (expand (b (ash p -18)))) (out2 (expand (b (ash p -12))))
             (out3 (expand (b (ash p -6)))) (out4 (expand (b p))))
        (loop (cdddr cs) (cons* out4 out3 out2 out1 out))))))

(write (unpack (pack "PROGRAMMING PRAXIS")))

"PROGRAMMING PRAXIS  "