url-encode implemented in scheme, r6rs. Behaves more-or-less the same as the JavaScript equivalent decodeURIComponent()

url-encode.rkt

#!r6rs
(import (rnrs arithmetic bitwise (6))
        (rnrs base (6))
        (rnrs control)
        (rnrs io simple (6))
        )

; url-encode implemented in scheme, r6rs
; Behaves more-or-less the same as the JavaScript equivalent decodeURIComponent()

(define (convert-to-hex value)
  (define low-part (bitwise-and value #x0F))
  (define high-part (bitwise-and (bitwise-arithmetic-shift value -4) #x0F))

  (string-append
   "%"
   (number->string high-part 16)
   (number->string low-part 16)
   )
  )

(define (url-encode str)
  
  (define encoded "")
  (do ((i 0 (+ 1 i)))
    ((>= i (string-length str)))
    (let* (
           (char (string-ref str i))
           (c (char->integer char))
           )

      (cond
        ((or
          (and (>= c (char->integer #\0)) (<= c (char->integer #\9)))
          (and (>= c (char->integer #\A)) (<= c (char->integer #\Z)))
          (and (>= c (char->integer #\a)) (<= c (char->integer #\z)))
          (eq? char #\.)
          (eq? char #\_)
          (eq? char #\~)
          )
         (set! encoded (string-append encoded (string char)))
         )
        ;((eq? char #\ )
        ; (set! encoded (string-append encoded "+"))
        ; )
        (else
         (cond
           ((<= c #x00007F)
            (let ((byte1 (bitwise-and c #x007F)))
              (set! encoded (string-append encoded (convert-to-hex byte1)))
              )
            )
           ((<= c #x0007FF)
            (let ((byte1 (bitwise-ior #x00C0 (bitwise-and (bitwise-arithmetic-shift c -6) #x001F)))
                  (byte2 (bitwise-ior #x0080 (bitwise-and c #x003F))))
              (set! encoded (string-append encoded (convert-to-hex byte1)))
              (set! encoded (string-append encoded (convert-to-hex byte2)))
              )
            )
           ((<= c #x00FFFF)
            (let ((byte1 (bitwise-ior #x00E0 (bitwise-and (bitwise-arithmetic-shift c -12) #x000F)))
                  (byte2 (bitwise-ior #x0080 (bitwise-and (bitwise-arithmetic-shift c -6) #x003F)))
                  (byte3 (bitwise-ior #x0080 (bitwise-and c #x003F))))
              (set! encoded (string-append encoded (convert-to-hex byte1)))
              (set! encoded (string-append encoded (convert-to-hex byte2)))
              (set! encoded (string-append encoded (convert-to-hex byte3)))
              )
            )
           (else
            (let ((byte1 (bitwise-ior #x00F0 (bitwise-and (bitwise-arithmetic-shift c -18) #x0007)))
                  (byte2 (bitwise-ior #x0080 (bitwise-and (bitwise-arithmetic-shift c -12) #x003F)))
                  (byte3 (bitwise-ior #x0080 (bitwise-and (bitwise-arithmetic-shift c -6) #x003F)))
                  (byte4 (bitwise-ior #x0080 (bitwise-and c #x003F))))
              (set! encoded (string-append encoded (convert-to-hex byte1)))
              (set! encoded (string-append encoded (convert-to-hex byte2)))
              (set! encoded (string-append encoded (convert-to-hex byte3)))
              (set! encoded (string-append encoded (convert-to-hex byte4)))
              )
            )
           )
         )
        )
      )
    )
  encoded
  )

; TEST
(display (url-encode "abc<>cd\nEFG"))