Geo3x3 in Scheme (R6RS)

geo3x3.sls

#!r6rs
(library (geo3x3)
  (export encode decode)
  (import (rnrs))

  (define (encode lat lng level)
    (assert (real? lat))
    (assert (real? lng))
    (assert (integer? level))
    (assert (> level 0))
    (call-with-string-output-port
      (lambda(port)
        (display (if (>= lng 0) "E" "W") port)
        (let loop ((i 1)
                   (lng (exact (mod lng 180)))
                   (lat (- 90 (exact lat)))
                   (unit (/ 180 3)))
          (when (< i level)
            (let-values (((x xr) (div-and-mod lng unit))
                         ((y yr) (div-and-mod lat unit)))
              (display (+ x (* y 3) 1) port)
              (loop (+ i 1) xr yr (/ unit 3))))))))

  (define (digit->integer ch)
    (- (char->integer ch)
       (char->integer #\0)))

  (define (decode code)
    (assert (string? code))
    (call-with-port (open-string-input-port code)
      (lambda(port)
        (let ((head (read-char port)))
          (assert (or (char=? head #\W) (char=? head #\E)))
          (let loop ((level 1)
                     (lng 0)
                     (lat 0)
                     (unit 180)
                     (ch (read-char port)))
            (cond ((eof-object? ch)
                   (values (inexact (- 90 (+ lat (/ unit 2))))
                           (- (inexact (+ lng (/ unit 2)))
                              (if (char=? head #\W) 180 0))
                           level
                           (inexact unit)))
                  (else
                   (assert (char<=? #\1 ch #\9))
                   (let* ((n (- (digit->integer ch) 1)))
                     (let-values (((y x) (div-and-mod n 3))
                                  ((unit) (/ unit 3)))
                       (loop (+ level 1)
                             (+ lng (* x unit))
                             (+ lat (* y unit))
                             unit
                             (read-char port)))))))))))
  )

simple_geo3x3.scm

#!r6rs
(import (rnrs)
        (geo3x3))

(write (encode 35.65858 139.745433 14))
(newline)

(let-values ((result (decode "E3793653391822")))
  (write result))
(newline)

testcase.scm

#!r6rs
(import (rnrs)
        (geo3x3))

(let-values ((result (decode "W28644")))
  (write result))
(newline)

(let-values ((result (decode "E28644")))
  (write result))
(newline)

(write (encode 40 -86.2962962962963 6)) (newline)
(write (encode 40 93.7037037037037 6))  (newline)

(write (encode 40 93.7037037037037 1)) (newline)
(write (encode 40 93.7037037037037 2)) (newline)
(write (encode 40 93.7037037037037 3)) (newline)
(write (encode 40 93.7037037037037 4)) (newline)
(write (encode 40 93.7037037037037 5)) (newline)
(write (encode 40 93.7037037037037 6)) (newline)
(write (encode 40 93.7037037037037 7)) (newline)
(write (encode 40 93.7037037037037 8)) (newline)