Fix wordy numbers in swedish!

3 files changed, 216 insertions, 177 deletions

diff --git a/module/text/numbers/sv.scm b/module/text/numbers/sv.scm
index 5d6e8952..858668a5 100644
--- a/module/text/numbers/sv.scm
+++ b/module/text/numbers/sv.scm
@@ -2,180 +2,193 @@
   :use-module ((srfi srfi-1) :select (every))
   :use-module (srfi srfi-71)
   :use-module (hnh util)
+  :use-module (hnh util type)
   :export (number->string-cardinal
            number->string-ordinal
            each-string))
 
-;; only used in number->string-cardinal
-(define (large-prefix e)
-  (cond
-   [(<=  6 e 11) "m"]
-   [(<= 12 e 17) "b"]
-   [(<= 18 e 23) "tr"]
-   [(<= 24 e 29) "kvadr"]
-   [(<= 30 e 35) "kvint"]
-   [(<= 36 e 41) "sext"]
-   [(<= 42 e 47) "sept"]
-   [(<= 48 e 53) "okt"]
-   [(<= 54 e 59) "non"]
-   [(<= 60 e 65) "dec"]
-   ))
-
-(define (number->string-cardinal n . _)
+(define (exp-name x)
+  (case x
+    ((0)  "")
+    ((1)  "tusen")
+    ((2)  " miljon")
+    ((3)  " miljard")
+    ((4)  " biljon")
+    ((5)  " biljard")
+    ((6)  " triljon")
+    ((7)  " triljard")
+    ((8)  " kvadriljon")
+    ((9)  " kvadriljard")
+    ((10) " kvintiljon")
+    ((11) " kvintiljard")
+    ((12) " sextiljon")
+    ((13) " sextiljard")
+    ((14) " septiljon")
+    ((15) " septiljard")
+    ((16) " oktiljon")
+    ((17) " oktiljard")
+    ((18) " noniljon")
+    ((19) " noniljard")
+    ((20) " deciljon")
+    ((21) " deciljard")))
+
+(define* (number->string-cardinal n key: (e3 0) allow-other-keys:)
   (cond [(< n 0) (string-append "minus " (number->string-cardinal (- n)))]
-        [(= n 0) "noll"]
-        [(= n 1) "ett"]
-        [(= n 2) "två"]
-        [(= n 3) "tre"]
-        [(= n 4) "fyra"]
-        [(= n 5) "fem"]
-        [(= n 6) "sex"]
-        [(= n 7) "sju"]
-        [(= n 8) "åtta"]
-        [(= n 9) "nio"]
-        [(= n 10) "tio"]
-        [(= n 11) "elva"]
-        [(= n 12) "tolv"]
-        [(= n 13) "tretton"]
-        [(= n 14) "fjorton"]
-        [(= n 15) "femton"]
-        [(= n 16) "sexton"]
-        [(= n 17) "sjutton"]
-        [(= n 18) "arton"]
-        [(= n 19) "nitton"]
-        [(= n 20) "tjugo"]
-        [(<= 21 n 29) (string-append "tjugo" (number->string-cardinal
-                                             (- n 20)))]
-        [(= n 30) "trettio"]
-        [(<= 31 n 39) (string-append "trettio" (number->string-cardinal
-                                               (- n 30)))]
-        [(= n 40) "fyrtio"]
-        [(<= 31 n 49) (string-append "fyrtio" (number->string-cardinal
-                                              (- n 40)))]
-        [(<= 50 n 69) (let ((big small (floor/ n 10)))
-                       (string-append
-                        (number->string-cardinal big)
-                        "tio"
-                        (if (zero? small)
-                            "" (number->string-cardinal small))))]
-        [(= n 70) "sjuttio"]
-        [(<= 71 n 79) (string-append "sjuttio" (number->string-cardinal (- n 70)))]
-        [(= n 80) "åttio"]
-        [(<= 81 n 89) (string-append "åttio" (number->string-cardinal (- n 80)))]
-        [(= n 90) "nittio"]
-        [(<= 91 n 99) (string-append "nittio" (number->string-cardinal (- n 90)))]
-        [(= n 100) "etthundra"]
-        [(< 100 n 200) (string-append "etthundra" (number->string-cardinal (- n 100)))]
-        [(= n 200) "tvåhundra"]
-        [(< 200 n 1000) (let ((big small (floor/ n 100)))
-                          (string-append
-                           (number->string-cardinal big)
-                           "hundra"
-                           (if (zero? small)
-                               "" (number->string-cardinal small))))]
-
-        [(<= 1000 n 999999)
-         (let ((big small (floor/ n 1000)))
-           (let ((big* (number->string-cardinal big)))
-             (string-append
-              (if (= 1 big) "et" big*)
-              (if (<= 18 (string-length big*)) " " "")
-              "tusen"
-              (if (zero? small)
-                  ""
-                  (string-append
-                   " " (number->string-cardinal small))))))]
-
-        [(<= #e1e6 n (1- #e1e66))
-         (let ((e (inexact->exact (floor (log10 n))))
-               (big small (floor/ n #e1e6)))
-           (if (zero? big)
-               (number->string-cardinal (modulo small 1000))
+        [else
+         (let loop ((n n)          ; Remaining part of number
+                    (e3 e3)         ; tenth exporent, divided by three
+                    (have-larger #f)  ; Is there a larger part of this number
+                    )
+           (cond
+            [(= n 0) "noll"]
+            [(and (= n 1) (= e3 0)) "ett"]
+            [(and (= n 1) (= e3 1)) "ettusen"]
+            [(= n 1)  (string-append "en"      (exp-name e3))]
+            [(= n 2)  (string-append "två"     (exp-name e3))]
+            [(= n 3)  (string-append "tre"     (exp-name e3))]
+            [(= n 4)  (string-append "fyra"    (exp-name e3))]
+            [(= n 5)  (string-append "fem"     (exp-name e3))]
+            [(= n 6)  (string-append "sex"     (exp-name e3))]
+            [(= n 7)  (string-append "sju"     (exp-name e3))]
+            [(= n 8)  (string-append "åtta"    (exp-name e3))]
+            [(= n 9)  (string-append "nio"     (exp-name e3))]
+            [(= n 10) (string-append "tio"     (exp-name e3))]
+            [(= n 11) (string-append "elva"    (exp-name e3))]
+            [(= n 12) (string-append "tolv"    (exp-name e3))]
+            [(= n 13) (string-append "tretton" (exp-name e3))]
+            [(= n 14) (string-append "fjorton" (exp-name e3))]
+            [(= n 15) (string-append "femton"  (exp-name e3))]
+            [(= n 16) (string-append "sexton"  (exp-name e3))]
+            [(= n 17) (string-append "sjutton" (exp-name e3))]
+            [(= n 18) (string-append "arton"   (exp-name e3))]
+            [(= n 19) (string-append "nitton"  (exp-name e3))]
+
+            [(<= 20 n 99)
+             (let ((tens ones (floor/ n 10)))
+               (string-append
+                (case tens
+                  ((2) "tjugo")
+                  ((3) "trettio")
+                  ((4) "fyrtio")
+                  ((5) "femtio")
+                  ((6) "sextio")
+                  ((7) "sjuttio")
+                  ((8) "åttio")
+                  ((9) "nittio"))
+                (if (zero? ones)
+                    "" (number->string-cardinal ones))
+                (exp-name e3)))]
+
+            [(<= 100 n 999)
+             (let ((big small (floor/ n 100)))
                (string-append
-                (if (or (= 1 big)
-                        (= 0 (modulo big 1000)))
-                    "en"
-                    (number->string-cardinal
-                     (floor-quotient
-                      big (if (even? (floor-quotient e 3))
-                              1 1000))))
-                " "
-                (large-prefix e)
-                (if (even? (floor-quotient e 3))
-                    "iljon" "iljard")
-                (if (or (= 1 big)
-                        (= 0 (modulo big 1000)))
-                    "" "er")
+                (number->string-cardinal big)
+                "hundra"
                 (if (zero? small)
                     ""
-                    (string-append
-                     " "
-                     (number->string-cardinal small))))))]
-        [else
-         ;; I give up, don't have larger numbers that that!
-         (string-append "det stora talet "
-                        (number->string n))]))
+                    (number->string-cardinal small))
+                (if (and have-larger (= e3 1)) " " "")
+                (exp-name e3)))]
+
+            [(< n (1- #e1e66))
+             (let ((head tail (floor/ n 1000)))
+               (string-append
+                (loop head (+ e3 1) #f)
+                (cond ((= 1 head) "")
+                      ((= 0 (floor-remainder head 1000)) "")
+                      ((>= e3 1) "er")
+                      (else ""))
+                (cond ((= 0 tail) "")
+                      (else (string-append
+                             " " (loop tail e3 #t))))))]
+
+
+            [else
+             ;; I give up, don't have larger numbers that that!
+             (string-append "det stora talet "
+                            (number->string n))]))]))
 
 (define* (number->string-ordinal
                  n key: a-form? allow-other-keys:)
   (define a-string (if a-form? "a" "e"))
-  (cond [(>= -3 n) (string-append (number->string-ordinal (- n)) " sista" )]
-        [(= -2 n) "näst sista"]
-        [(= -1 n) "sista"]
-        [(= 0 n) "nollte"]              ;
-        [(= 1 n) (string-append "först" a-string)]
-        [(= 2 n) (string-append "andr" a-string)]
-        [(= 3 n) "tredje"]
-        [(= 4 n) "fjärde"]
-        [(= 5 n) "femte"]
-        [(= 6 n) "sjätte"]
-        [(= 7 n) "sjunde"]
-        [(= 8 n) "åttonde"]
-        [(= 9 n) "nionde"]
-        [(= 10 n) "tionde"]
-        [(= 11 n) "elfte"]
-        [(= 12 n) "tolfte"]
-        [(= 13 n) "trettonde"]
-        [(= 14 n) "fjortonde"]
-        [(= 15 n) "femtonde"]
-        [(= 16 n) "sextonde"]
-        [(= 17 n) "sjuttonde"]
-        [(= 18 n) "artonde"]
-        [(= 19 n) "nittonde"]
-        [(= 20 n) "tjugonde"]
-        [(<= 20 n 29) (string-append "tjugo"
-                                    (number->string-ordinal
-                                     (- n 20)
-                                     a-form?: a-form?))]
-
-        [(<= 30 n 99)
-         (let ((big small (floor/ n 10)))
-           (string-append
-            (case big
-              [(3) "tret"]
-              [(4) "fyr"]
-              [(8) "åt"]
-              [(7) "sjut"]
-              [(9) "nit"]
-              [else (number->string-cardinal big)])
-            "tio"
-            (if (zero? (modulo small 10))
-                "nde"
-                (number->string-ordinal
-                 small a-form?: a-form?))))]
-        [(= n 100) "etthundrade"]
-        [(= n 1000) "etttusende"]
-        [(= n #e1e6) "miljonte"]
-        [(= n #e1e9) "miljarde"]
-        [(= n #e1e12) "biljonte"]
 
-        [else
-         (let ((big small (floor/ n 100)))
-           (string-append (number->string-cardinal (* big 100))
-                          (if (zero? small)
-                              "de"
-                              (number->string-ordinal
-                               small a-form?: a-form?))))]))
+  (define (main-part n e)
+    (case e
+      ((0) (cond [(>= -3 n) (string-append (number->string-ordinal (- n) a-form?: a-form?) " sista" )]
+                 [(= -2 n) "näst sista"]
+                 [(= -1 n) "sista"]
+                 [(= 0 n)  "nollte"]      ;
+                 [(= 1 n)  (string-append "först" a-string)]
+                 [(= 2 n)  (string-append "andr" a-string)]
+                 [(= 3 n)  "tredje"]
+                 [(= 4 n)  "fjärde"]
+                 [(= 5 n)  "femte"]
+                 [(= 6 n)  "sjätte"]
+                 [(= 7 n)  "sjunde"]
+                 [(= 8 n)  "åttonde"]
+                 [(= 9 n)  "nionde"]
+                 [(= 10 n) "tionde"]
+                 [(= 11 n) "elfte"]
+                 [(= 12 n) "tolfte"]
+                 [(= 13 n) "trettonde"]
+                 [(= 14 n) "fjortonde"]
+                 [(= 15 n) "femtonde"]
+                 [(= 16 n) "sextonde"]
+                 [(= 17 n) "sjuttonde"]
+                 [(= 18 n) "artonde"]
+                 [(= 19 n) "nittonde"]
+                 [(= 20 n) "tjugonde"]
+                 [(<= 20 n 29) (string-append "tjugo"
+                                             (number->string-ordinal
+                                              (- n 20)
+                                              a-form?: a-form?))]
+
+                 [(<= 30 n 99)
+                  (let ((big small (floor/ n 10)))
+                    (string-append
+                     (case big
+                       [(3) "tret"]
+                       [(4) "fyr"]
+                       [(8) "åt"]
+                       [(7) "sjut"]
+                       [(9) "nit"]
+                       [else (number->string-cardinal big)])
+                     "tio"
+                     (number->string-ordinal
+                      small a-form?: a-form?)))]
+
+                 [(= n 100) "etthundrade"]
+
+                 [else
+                  (let ((big small (floor/ n 100)))
+                    (string-append (number->string-cardinal (* big 100))
+                                   (if (zero? small)
+                                       "de"
+                                       (number->string-ordinal
+                                        small a-form?: a-form?))))]))
+
+      ((1) (string-append (number->string-cardinal n) "tusende"))
+      (else (string-append
+             (if (= n 1) "" (string-append (number->string-cardinal n) " "))
+             (case e
+               ((2) "miljonte")
+               ((3) "miljarde")
+               ((4) "biljonte"))))))
+
+  (if (>= n #e1e15)
+      (string-append (number->string n) ":e")
+      (let loop ((n n) (e 0))
+        (if (> 1000 n)
+            (main-part n e)
+            (let ((a b (floor/ n 1000)))
+              (cond ((zero? b)
+                     (loop a (1+ e)))
+                    (else
+                     (string-append
+                      (number->string-cardinal a e3: (1+ e))
+                      " "
+                      (number->string-ordinal b a-form?: a-form?)))))))))
+
 
 ;; (each-string 1) ; => "varje"
 ;; (each-string 2) ; => "varannan"
diff --git a/tests/unit/text/numbers-sv-short.scm b/tests/unit/text/numbers-sv-short.scm
index 1633d8e6..266553ad 100644
--- a/tests/unit/text/numbers-sv-short.scm
+++ b/tests/unit/text/numbers-sv-short.scm
@@ -1,8 +1,14 @@
 (define-module (test text-numbers-sv)
+  :use-module (srfi srfi-1)
   :use-module (srfi srfi-64)
   :use-module (srfi srfi-71)
   :use-module (text numbers))
 
+;;; Readable integer "literals", until srfi-169 gets ported to Guile
+(define (n s)
+  (fold (lambda (x p) (+ x (* 1000 p)))
+        0 (map string->number (string-split s #\_))))
+
 (test-group "Cardinal numbers"
 
   (test-equal "minus två"                     (number->string-cardinal -2 'sv))
@@ -70,14 +76,30 @@
   (test-equal "etthundra miljoner" (number->string-cardinal 100000000 'sv))
   (test-equal "niohundraåttiosju miljoner sexhundrafemtiofyra tusen trehundratjugoett"
     (number->string-cardinal 987654321 'sv))
-  (test-equal "en miljard"         (number->string-cardinal 1000000000 'sv))
-  (test-equal "en biljon"          (number->string-cardinal 1000000000000 'sv))
-  (test-equal "en biljard"         (number->string-cardinal #e10e15 'sv))
-  (test-equal "en triljon"         (number->string-cardinal #e10e18 'sv))
-  (test-equal "en triljard"        (number->string-cardinal #e10e21 'sv))
-  (test-equal "en kvadriljon"      (number->string-cardinal #e10e24 'sv))
-  (test-equal "en kvadriljard"     (number->string-cardinal #e10e27 'sv))
-  (test-equal "en kvintiljon"      (number->string-cardinal #e10e30 'sv))
+  (test-equal "en miljard"         (number->string-cardinal (n "1_000_000_000") 'sv))
+  (test-equal "en biljon"          (number->string-cardinal (n "1_000_000_000_000") 'sv))
+  (test-equal "en biljard"         (number->string-cardinal #e1e15 'sv))
+  (test-equal "tio biljarder"      (number->string-cardinal #e1e16 'sv))
+  (test-equal "etthundra biljarder" (number->string-cardinal #e1e17 'sv))
+  (test-equal "en biljard"         (number->string-cardinal (n "1_000_000_000_000_000") 'sv))
+  (test-equal "en triljon"         (number->string-cardinal #e1e18 'sv))
+  (test-equal "en triljard"        (number->string-cardinal #e1e21 'sv))
+  (test-equal "en kvadriljon"      (number->string-cardinal #e1e24 'sv))
+  (test-equal "en kvadriljard"     (number->string-cardinal #e1e27 'sv))
+  (test-equal "en kvintiljon"      (number->string-cardinal #e1e30 'sv))
+  (test-equal "en kvintiljard"     (number->string-cardinal #e1e33 'sv))
+  (test-equal "en sextiljon"       (number->string-cardinal #e1e36 'sv))
+  (test-equal "en sextiljard"      (number->string-cardinal #e1e39 'sv))
+  (test-equal "en septiljon"       (number->string-cardinal #e1e42 'sv))
+  (test-equal "en septiljard"      (number->string-cardinal #e1e45 'sv))
+  (test-equal "en oktiljon"        (number->string-cardinal #e1e48 'sv))
+  (test-equal "en oktiljard"       (number->string-cardinal #e1e51 'sv))
+  (test-equal "en noniljon"        (number->string-cardinal #e1e54 'sv))
+  (test-equal "en noniljard"       (number->string-cardinal #e1e57 'sv))
+  (test-equal "en deciljon"        (number->string-cardinal #e1e60 'sv))
+  (test-equal "en deciljard"       (number->string-cardinal #e1e63 'sv))
+  (test-equal "det stora talet 1000000000000000000000000000000000000000000000000000000000000000000"
+    (number->string-cardinal #e1e66 'sv))
   )
 
 (test-group "Ordinal numbers"
@@ -113,11 +135,12 @@
   (test-equal "åttioåttonde"             (number->string-ordinal 88 'sv a-form?: #t))
   (test-equal "nittionionde"             (number->string-ordinal 99 'sv a-form?: #t))
   (test-equal "etthundrade"              (number->string-ordinal 100 'sv a-form?: #t))
+  (test-equal "tvåhundrade"              (number->string-ordinal 200 'sv a-form?: #t))
   (test-equal "etthundratrettiofjärde"   (number->string-ordinal 134 'sv a-form?: #t))
   (test-equal "sjuhundratrettiosjätte"   (number->string-ordinal 736 'sv a-form?: #t))
   (test-equal "etttusende"                       (number->string-ordinal 1000 'sv a-form?: #t))
   (test-equal "ettusen sjätte"                   (number->string-ordinal 1006 'sv a-form?: #t))
-  (test-equal "ettusen hundrade"                 (number->string-ordinal 1100 'sv a-form?: #t))
+  (test-equal "ettusen etthundrade"                 (number->string-ordinal 1100 'sv a-form?: #t))
   (test-equal "ettusen niohundratjugoandra"      (number->string-ordinal 1922 'sv a-form?: #t))
   (test-equal "ettusen niohundranittionionde"    (number->string-ordinal 1999 'sv a-form?: #t))
   (test-equal "tvåtusende"                       (number->string-ordinal 2000 'sv a-form?: #t))
@@ -173,6 +196,9 @@
     (number->string-ordinal 987654321 'sv a-form?: #t))
   (test-equal "miljarde"           (number->string-ordinal 1000000000 'sv a-form?: #t))
   (test-equal "biljonte"           (number->string-ordinal 1000000000000 'sv a-form?: #t)))
+(test-equal "niohundranittionio biljoner niohundranittionio miljarder niohundranittionio miljoner niohundranittionio tusen niohundranittionionde"
+  (number->string-ordinal (1- #e1e15) 'sv))
+(test-equal "1000000000000000:e" (number->string-ordinal #e1e15 'sv))
 
 '((text numbers)
   (text numbers sv))
diff --git a/tests/unit/text/numbers-sv.scm.disabled b/tests/unit/text/numbers-sv.scm.disabled
index 31048ba1..91fbe63b 100644
--- a/tests/unit/text/numbers-sv.scm.disabled
+++ b/tests/unit/text/numbers-sv.scm.disabled
@@ -1233,12 +1233,12 @@
   (test-equal "niohundraåttiosju miljoner sexhundrafemtiofyra tusen trehundratjugoett" (number->string-cardinal 987654321 'sv))
   (test-equal "en miljard"         (number->string-cardinal 1000000000 'sv))
   (test-equal "en biljon"          (number->string-cardinal 1000000000000 'sv))
-  (test-equal "en biljard"         (number->string-cardinal #e10e15 'sv))
-  (test-equal "en triljon"         (number->string-cardinal #e10e18 'sv))
-  (test-equal "en triljard"        (number->string-cardinal #e10e21 'sv))
-  (test-equal "en kvadriljon"      (number->string-cardinal #e10e24 'sv))
-  (test-equal "en kvadriljard"     (number->string-cardinal #e10e27 'sv))
-  (test-equal "en kvintiljon"      (number->string-cardinal #e10e30 'sv)))
+  (test-equal "en biljard"         (number->string-cardinal #e1e15 'sv))
+  (test-equal "en triljon"         (number->string-cardinal #e1e18 'sv))
+  (test-equal "en triljard"        (number->string-cardinal #e1e21 'sv))
+  (test-equal "en kvadriljon"      (number->string-cardinal #e1e24 'sv))
+  (test-equal "en kvadriljard"     (number->string-cardinal #e1e27 'sv))
+  (test-equal "en kvintiljon"      (number->string-cardinal #e1e30 'sv)))
 
 
 ;;; Ordningstal – Ordinal numbers
@@ -2256,7 +2256,7 @@
   (test-equal "ettusen åttonde"                  (number->string-ordinal 1008 'sv a-form?: #t))
   (test-equal "ettusen nionde"                   (number->string-ordinal 1009 'sv a-form?: #t))
   (test-equal "ettusen tionde"                   (number->string-ordinal 1010 'sv a-form?: #t))
-  (test-equal "ettusen hundrade"                 (number->string-ordinal 1100 'sv a-form?: #t))
+  (test-equal "ettusen etthundrade"              (number->string-ordinal 1100 'sv a-form?: #t))
   (test-equal "ettusen tvåhundrade"              (number->string-ordinal 1200 'sv a-form?: #t))
   (test-equal "ettusen trehundrade"              (number->string-ordinal 1300 'sv a-form?: #t))
   (test-equal "ettusen fyrahundrade"             (number->string-ordinal 1400 'sv a-form?: #t))