;; this code is extracted from a serialization library, the control
;; flow is kind of tortured to support leb128 encoding using the
;; primitives available in that library.

;; The clojure code and ocmmmon lisp code implement the same
;; algorithm, but the clojure code generates signed bytes and the
;; common lisp code generates unsigned bytes.

;; You can see the CL code in situ here:
;; https://git.sr.ht/~hiredman/some-like-it-hot/tree/master/item/control.lisp#L190-209

;; clojure 
(def leb128P
  ((fn leb128P* [shift result]
     (->Sequ (fn [b]
               (let [b (unsigned-bit-shift-right b shift)]
                 (bit-or (bit-and b 2r1111111)
                         (if (pos? (unsigned-bit-shift-right b 7))
                           (bit-shift-left 1 7)
                           0))))
             byteP
             (partial (fn [result b]
                        (let [result (bit-or
                                      result
                                      (bit-shift-left
                                       (bit-and b 2r1111111)
                                       shift))
                              continue (bit-and 1 (bit-shift-right b 7))]
                          (if (zero? continue)
                            (->Lift result)
                            (leb128P* (+ shift 7) result))))
                      result)))
   0
   0))

;; common lisp
(defparameter uleb128-pickler ; [7]
  (labels ((f (shift result)
              (lambda (b)
                (let ((result (logior result (ash (logand b #b1111111) shift)))
                      (continue (logand 1 (ash b -7))))
                  (if (= continue 0)
                      (lift-pickler result)
                    (leb128 (+ shift 7) result)))))
           (leb128 (shift result)
                   (sequ-pickler
                    (lambda (b)
                      (let ((b (ash b (- 0 shift))))
                        (logior (logand b #b1111111)
                                (if (> (ash b -7) 0)
                                    (ash 1 7)
                                  0))))
                    byte-pickler
                    (f shift result))))
    (leb128 0 0)))

Generated At 2023-05-12T11:17:43-0700 original