Move unit handling into separate file.

Author: ruricolist

numbers.lisp

@@ -290,77 +290,3 @@ returned is the same as the number of arguments given."
          (zero (apply #'+ zeros)))
     (mapcar (op (+ _ zero))
             ns)))
-
-(defconst si-prefixes
-  '((-24 "yocto" "y")
-    (-21 "zepto" "z")
-    (-18 "atto"  "a")
-    (-15 "femto" "f")
-    (-12 "pico"  "p")
-    ( -9 "nano"  "n")
-    ( -6 "micro" "μ")
-    ( -3 "milli" "m")
-    ( -2 "centi" "c")
-    ( -1 "deci"  "d")
-    (  0 ""      "" )
-    (  1 "deca"  "da")
-    (  2 "hecto" "h")
-    (  3 "kilo"  "k")
-    (  6 "mega"  "M")
-    (  9 "giga"  "G")
-    ( 12 "tera"  "T")
-    ( 15 "peta"  "P")
-    ( 18 "exa"   "E")
-    ( 21 "zetta" "Z")
-    ( 24 "yotta" "Y"))
-  "List as SI prefixes: power of ten, long form, short form.")
-
-(defconst si-prefixes-base-1000
-  (loop for (pow long short) in si-prefixes
-        unless (and (not (zerop pow))
-                    (< (abs pow) 3))
-          collect (list (truncate pow 3) long short))
-  "The SI prefixes as powers of 1000, with centi, deci, deca and hecto omitted.")
-
-(defconst iec-prefixes
-  '(( 0 ""     "")
-    (10 "kibi" "Ki")
-    (20 "mebi" "Mi")
-    (30 "gibi" "Gi")
-    (40 "tebi" "Ti")
-    (50 "pebi" "Pi")
-    (60 "exbi" "Ei"))
-  "The IEC binary prefixes, as powers of 2.")
-
-(defmacro si-prefix-rec (n base prefixes)
-  (cond ((null prefixes) (error "No prefixes!"))
-        ((single prefixes)
-         (destructuring-bind ((power long short)) prefixes
-           `(values ,long ,short ,(expt base power))))
-        (t
-         (multiple-value-bind (lo hi) (halves prefixes)
-           (let ((split (* (expt base (caar hi)))))
-             `(if (< ,n ,split)
-                  (si-prefix-rec ,n ,base ,lo)
-                  (si-prefix-rec ,n ,base ,hi)))))))
-
-(defun si-prefix (n &key (base 1000))
-  "Given a number, return the prefix of the nearest SI unit.
-
-Three values are returned: the long form, the short form, and the
-multiplying factor.
-
-    (si-prefix 1001) => \"kilo\", \"k\", 1000d0
-
-BASE can be 1000, 10, 1024, or 2. 1000 is the default, and prefixes
-start at kilo and milli. Base 10 is mostly the same, except the
-prefixes centi, deci, deca and hecto are also used. Base 1024 uses the
-same prefixes as 1000, but with 1024 as the base, as in vulgar file
-sizes. Base 2 uses the IEC binary prefixes."
-  (if (zerop n) (values "" "" 1d0)
-      (let ((n (abs (coerce n 'double-float))))
-        (ecase base
-          (2 (si-prefix-rec n 2d0 #.iec-prefixes))
-          (10 (si-prefix-rec n 10d0 #.si-prefixes))
-          (1000 (si-prefix-rec n 1000d0 #.si-prefixes-base-1000))
-          (1024 (si-prefix-rec n 1024d0 #.si-prefixes-base-1000))))))

serapeum.asd

@@ -57,7 +57,7 @@
                  (:file "box"
                   :depends-on ("types" "definitions"))
                  (:file "numbers"
-                  :depends-on ("types" "op" "definitions"))
+                  :depends-on ("types" "op"))
                  (:file "octets"
                   :depends-on ("types"))
                  (:file "time")
@@ -97,7 +97,8 @@
                  (:file "tree-case")
                  (:file "dispatch-case")
                  (:file "range" :depends-on ("dispatch-case"))
-                 (:file "generalized-arrays" :depends-on ("range"))))))
+                 (:file "generalized-arrays" :depends-on ("range"))
+                 (:file "units")))))
 
 (defsystem "serapeum/tests"
   :description "Test suite for Serapeum."
@@ -148,4 +149,5 @@
                  (:file "dispatch-case")
                  (:file "range")
                  (:file "generalized-arrays")
-                 (:file "quicklisp")))))
+                 (:file "quicklisp")
+                 (:file "units")))))

tests/numbers.lisp

@@ -52,24 +52,3 @@
                                 most-positive-double-float)))))
         (values results1 results2))
     (is (every #'= results1 results2))))
-
-(test si-prefix
-  (is (equal "yocto" (si-prefix least-positive-double-float)))
-  (is (equal "yotta" (si-prefix most-positive-double-float)))
-  (is-true (every (equals "") (mapcar #'si-prefix '(0 1 0s0 1s0 0d0 1d0))))
-  (is (equal "deca" (si-prefix 10 :base 10)))
-  (is (equal "deca" (si-prefix 12 :base 10)))
-  (is (equal "kilo" (si-prefix 1001)))
-  (is (equal "kibi" (si-prefix 2048 :base 2)))
-  (is (equal "kibi" (si-prefix 1024 :base 2)))
-  (is (equal "" (si-prefix 1000 :base 2)))
-  (is (equal "" (si-prefix 1000 :base 1024)))
-  (is (equal "kilo" (si-prefix 1024)))
-  (is (equal "kilo" (si-prefix 1000)))
-  (is (equal "pico" (si-prefix 1s-9)))
-  (is (equal "nano" (si-prefix 1s-9 :base 1024)))
-  (is (equal "kilo" (si-prefix -20000)))
-  (is (equal "" (si-prefix -20)))
-  (is (equal "kilo" (si-prefix (expt 2 10))))
-  (is (equal "kibi" (si-prefix (expt 2 10) :base 2)))
-  (is (equal "yocto" (si-prefix (expt 10 -23)))))

tests/units.lisp

@@ -0,0 +1,25 @@
+(in-package :serapeum.tests)
+
+(def-suite units :in serapeum)
+(in-suite units)
+
+(test si-prefix
+  (is (equal "yocto" (si-prefix least-positive-double-float)))
+  (is (equal "yotta" (si-prefix most-positive-double-float)))
+  (is-true (every (equals "") (mapcar #'si-prefix '(0 1 0s0 1s0 0d0 1d0))))
+  (is (equal "deca" (si-prefix 10 :base 10)))
+  (is (equal "deca" (si-prefix 12 :base 10)))
+  (is (equal "kilo" (si-prefix 1001)))
+  (is (equal "kibi" (si-prefix 2048 :base 2)))
+  (is (equal "kibi" (si-prefix 1024 :base 2)))
+  (is (equal "" (si-prefix 1000 :base 2)))
+  (is (equal "" (si-prefix 1000 :base 1024)))
+  (is (equal "kilo" (si-prefix 1024)))
+  (is (equal "kilo" (si-prefix 1000)))
+  (is (equal "pico" (si-prefix 1s-9)))
+  (is (equal "nano" (si-prefix 1s-9 :base 1024)))
+  (is (equal "kilo" (si-prefix -20000)))
+  (is (equal "" (si-prefix -20)))
+  (is (equal "kilo" (si-prefix (expt 2 10))))
+  (is (equal "kibi" (si-prefix (expt 2 10) :base 2)))
+  (is (equal "yocto" (si-prefix (expt 10 -23)))))

units.lisp

@@ -0,0 +1,75 @@
+(in-package :serapeum)
+
+(defconst si-prefixes
+  '((-24 "yocto" "y")
+    (-21 "zepto" "z")
+    (-18 "atto"  "a")
+    (-15 "femto" "f")
+    (-12 "pico"  "p")
+    ( -9 "nano"  "n")
+    ( -6 "micro" "μ")
+    ( -3 "milli" "m")
+    ( -2 "centi" "c")
+    ( -1 "deci"  "d")
+    (  0 ""      "" )
+    (  1 "deca"  "da")
+    (  2 "hecto" "h")
+    (  3 "kilo"  "k")
+    (  6 "mega"  "M")
+    (  9 "giga"  "G")
+    ( 12 "tera"  "T")
+    ( 15 "peta"  "P")
+    ( 18 "exa"   "E")
+    ( 21 "zetta" "Z")
+    ( 24 "yotta" "Y"))
+  "List as SI prefixes: power of ten, long form, short form.")
+
+(defconst si-prefixes-base-1000
+  (loop for (pow long short) in si-prefixes
+        unless (and (not (zerop pow))
+                    (< (abs pow) 3))
+          collect (list (truncate pow 3) long short))
+  "The SI prefixes as powers of 1000, with centi, deci, deca and hecto omitted.")
+
+(defconst iec-prefixes
+  '(( 0 ""     "")
+    (10 "kibi" "Ki")
+    (20 "mebi" "Mi")
+    (30 "gibi" "Gi")
+    (40 "tebi" "Ti")
+    (50 "pebi" "Pi")
+    (60 "exbi" "Ei"))
+  "The IEC binary prefixes, as powers of 2.")
+
+(defmacro si-prefix-rec (n base prefixes)
+  (cond ((null prefixes) (error "No prefixes!"))
+        ((single prefixes)
+         (destructuring-bind ((power long short)) prefixes
+           `(values ,long ,short ,(expt base power))))
+        (t
+         (multiple-value-bind (lo hi) (halves prefixes)
+           (let ((split (* (expt base (caar hi)))))
+             `(if (< ,n ,split)
+                  (si-prefix-rec ,n ,base ,lo)
+                  (si-prefix-rec ,n ,base ,hi)))))))
+
+(defun si-prefix (n &key (base 1000))
+  "Given a number, return the prefix of the nearest SI unit.
+
+Three values are returned: the long form, the short form, and the
+multiplying factor.
+
+    (si-prefix 1001) => \"kilo\", \"k\", 1000d0
+
+BASE can be 1000, 10, 1024, or 2. 1000 is the default, and prefixes
+start at kilo and milli. Base 10 is mostly the same, except the
+prefixes centi, deci, deca and hecto are also used. Base 1024 uses the
+same prefixes as 1000, but with 1024 as the base, as in vulgar file
+sizes. Base 2 uses the IEC binary prefixes."
+  (if (zerop n) (values "" "" 1d0)
+      (let ((n (abs (coerce n 'double-float))))
+        (ecase base
+          (2 (si-prefix-rec n 2d0 #.iec-prefixes))
+          (10 (si-prefix-rec n 10d0 #.si-prefixes))
+          (1000 (si-prefix-rec n 1000d0 #.si-prefixes-base-1000))
+          (1024 (si-prefix-rec n 1024d0 #.si-prefixes-base-1000))))))