Add humanize library
This commit is contained in:
parent
b06fbba540
commit
363aa8d1c3
|
@ -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)))
|
|
@ -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))
|
||||||
|
|
||||||
|
))
|
Loading…
Reference in New Issue