Add humanize library

humanize-test.scm

@@ -0,0 +1,28 @@
+(import (scheme base) (scheme write))
+(import (humanize))
+
+(define-syntax pp
+  (syntax-rules ()
+    ((_ x) (begin (write 'x)
+                  (display " => ")
+                  (write (call-with-values (lambda () x) list))
+                  (newline)))))
+
+(pp (human-size letteri 0))
+(pp (human-size letteri 100))
+(pp (human-size letteri 1023))
+(pp (human-size letteri 1024))
+(pp (human-size letteri (- (* 1024 1024) 1)))
+(pp (human-size letteri (* 1024 1024)))
+(pp (human-size letteri (- (* 1024 1024 1024) 1)))
+(pp (human-size letteri (* 1024 1024 1024)))
+(pp (human-size letteri (- (* 1024 1024 1024 1024) 1)))
+(pp (human-size letteri (* 10 1024 1024 1024)))
+(pp (human-size letteri (- (* 1024 1024 1024 1024) 1)))
+(pp (human-size letteri (* 1024 1024 1024 1024)))
+(pp (human-size letteri (- (* 1024 1024 1024 1024 1024) 1)))
+(pp (human-size letteri (* 1024 1024 1024 1024 1024)))
+
+(pp (human-size-si letteri (* 1000 1000 1000 1000)))
+(pp (human-size-si letteri (* 1000 1000 1000 1000 1000)))
+(pp (human-size-si letteri (* 1024 1024 1024 1024 1024)))

humanize.sld

@@ -0,0 +1,29 @@
+(define-library (humanize)
+  (export human-size human-size-si
+          letteri)
+  (import (scheme base) (scheme write))
+  (begin
+
+    (define letters '("B" "K" "M" "G" "T"))
+    (define letterb '("B" "KB" "MB" "GB" "TB"))
+    (define letteri '("B" "KiB" "MiB" "GiB" "TiB"))
+    (define long-si
+      '("bytes" "kilobytes" "megabytes" "gigabytes" "terabytes"))
+    (define long-bi
+      '("bytes" "kibibytes" "mebibytes" "gibibytes" "tebibytes"))
+
+    (define (human-size-generic step units bytes)
+      (let ((bytes (exact (truncate bytes))) (two-steps (* step step)))
+        (if (or (< bytes step) (not (pair? (cdr units))))
+            (values bytes 0 (car units))
+            (let loop ((units (cdr units)) (bytes bytes))
+              (if (or (< bytes two-steps) (not (pair? (cdr units))))
+                  (let-values (((whole rem) (truncate/ bytes step)))
+                    (let ((fractional-digit (floor-quotient (* 10 rem) step)))
+                      (values whole fractional-digit (car units))))
+                  (loop (cdr units) (truncate-quotient bytes step)))))))
+
+    (define (human-size    units bytes) (human-size-generic 1024 units bytes))
+    (define (human-size-si units bytes) (human-size-generic 1000 units bytes))
+
+    ))