[gnunet-scheme] 03/08: data-string: Make string->data do less mutation.

[gnunet]

This is an automated email from the git hooks/post-receive script.

maxime-devos pushed a commit to branch master
in repository gnunet-scheme.

commit 60cabfe201381b13eb6c2a53694ec14bb352097e
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Sun Aug 28 22:49:49 2022 +0200

    data-string: Make string->data do less mutation.
    
    Guile's compiler can work better in the absence of set!.
---
 gnu/gnunet/data-string.scm | 116 +++++++++++++++++++++++----------------------
 1 file changed, 59 insertions(+), 57 deletions(-)

diff --git a/gnu/gnunet/data-string.scm b/gnu/gnunet/data-string.scm
index df32ff5..e69d454 100644
--- a/gnu/gnunet/data-string.scm
+++ b/gnu/gnunet/data-string.scm
@@ -31,12 +31,16 @@
   (export data->string string->data
          &bogus-crockford-base32hex
          make-bogus-crockford-base32hex bogus-crockford-base32hex?)
-  (import (rnrs base)
+  (import (only (rnrs base) ; TODO: fix _ interpretation to shrink .go (or 
optimisation settings?)
+               define begin let set! < - > quote if or and + assert = mod * 
cons
+               string-ref apply string reverse cond char<=? char->integer else
+               lambda string-length let* values not / <=)
           (rnrs control)
           (rnrs conditions)
           (rnrs exceptions)
          (rnrs bytevectors)
-         (rnrs arithmetic bitwise))
+         (rnrs arithmetic bitwise)
+         (gnu gnunet utils hat-let))
 
   (define charset "0123456789ABCDEFGHJKMNPQRSTVWXYZ")
 
@@ -113,59 +117,57 @@ Return the data as a bytevector on success, or raise a
 
 @var{enc} the encoding
 @var{out-size} size of output buffer"
-      (let ((rpos (string-length enc))
-           (bits #f)
-           (vbit #f)
-           (ret #f)
-           (shift #f)
-           (encoded-len (* 8 out-size))
-           (uout (make-bytevector out-size)))
-       (if (= 0 (string-length enc))
-           (if (= 0 out-size)
-               #vu8()
+      (let^ ((! rpos (string-length enc))
+            (! bits #f)
+            (! vbit #f)
+            (! ret #f)
+            (! shift #f)
+            (! encoded-len (* 8 out-size))
+            (! uout (make-bytevector out-size))
+            (? (= 0 (string-length enc))
+               (if (= 0 out-size)
+                   #vu8()
+                   (raise-bogus-crockford-base32hex)))
+            (<-- (vbit shift rpos ret bits)
+                 (if (< 0 (mod encoded-len 5))
+                     ;; padding!
+                     (let* ((vbit (mod encoded-len 5))
+                            (shift (- 5 vbit))
+                            (rpos (- rpos 1))
+                            (ret (get-value (string-ref enc rpos)))
+                            (bits (bitwise-arithmetic-shift-right ret shift)))
+                       (values vbit shift rpos ret bits))
+                     (let* ((vbit 5)
+                            (shift 0)
+                            (rpos (- rpos 1))
+                            (ret (get-value (string-ref enc rpos)))
+                            (bits ret))
+                       (values vbit shift rpos ret bits))))
+            (? (not (= (/ (+ encoded-len shift) 5)
+                       (string-length enc)))
                (raise-bogus-crockford-base32hex))
-           (begin
-             (if (< 0 (mod encoded-len 5))
-                 (begin ; padding!
-                   (set! vbit (mod encoded-len 5))
-                   (set! shift (- 5 vbit))
-                   (set! rpos (- rpos 1))
-                   (set! ret (get-value (string-ref enc rpos)))
-                   (set! bits (bitwise-arithmetic-shift-right ret shift)))
-                 (begin
-                   (set! vbit 5)
-                   (set! shift 0)
-                   (set! rpos (- rpos 1))
-                   (set! ret (get-value (string-ref enc rpos)))
-                   (set! bits ret)))
-             (cond ((not (= (/ (+ encoded-len shift) 5)
-                            (string-length enc)))
-                    (raise-bogus-crockford-base32hex))
-                   ((not ret)
-                    (raise-bogus-crockford-base32hex))
-                   (else
-                    (let loop ((wpos out-size))
-                      (if (> wpos 0)
-                          (begin
-                            (assert (not (= 0 rpos)))
-                            (set! rpos (- rpos 1))
-                            (set! ret (get-value (string-ref enc rpos)))
-                            (set! bits (bitwise-ior
-                                        (bitwise-arithmetic-shift-left
-                                         ret vbit)
-                                        bits))
-                            (unless ret
-                              (raise-bogus-crockford-base32hex))
-                            (set! vbit (+ vbit 5))
-                            (when (>= vbit 8)
-                              (set! wpos (- wpos 1))
-                              (bytevector-u8-set! uout wpos
-                                                  (bitwise-and bits
-                                                               255))
-                              (set! bits
-                                    (bitwise-arithmetic-shift-right bits 8))
-                              (set! vbit (- vbit 8)))
-                            (loop wpos))
-                          (if (and (= 0 rpos) (= 0 vbit))
-                              uout
-                              (raise-bogus-crockford-base32hex))))))))))))
+            (? (not ret)
+               (raise-bogus-crockford-base32hex))
+            (/o/ loop
+                 (wpos out-size)
+                 (rpos rpos)
+                 (bits bits)
+                 (vbit vbit))
+            (? (<= wpos 0)
+               (if (and (= 0 rpos) (= 0 vbit))
+                   uout
+                   (raise-bogus-crockford-base32hex)))
+            (!! (not (= 0 rpos)))
+            (! rpos (- rpos 1))
+            (! ret (get-value (string-ref enc rpos)))
+            (! bits (bitwise-ior
+                     (bitwise-arithmetic-shift-left ret vbit)
+                     bits))
+            (! vbit (+ vbit 5))
+            (? (< vbit 8)
+               (loop wpos rpos bits vbit))
+            (! wpos (- wpos 1))
+            (_ (bytevector-u8-set! uout wpos (bitwise-and bits 255)))
+            (! bits (bitwise-arithmetic-shift-right bits 8))
+            (! vbit (- vbit 8)))
+           (loop wpos rpos bits vbit)))))

-- 
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.