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)))))))))))
  )

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)