Apply 1990 French orthographic reform for writing numbers

diff --git a/extra/math/text/french/french-tests.factor b/extra/math/text/french/french-tests.factor
index 4bac7d90ae59a3c968f6a6827e9ea3c36871670d..f76ee3a9f0864a4ca822a0873575ada702d0ff5f 100644 (file)
--- a/extra/math/text/french/french-tests.factor
+++ b/extra/math/text/french/french-tests.factor
@@ -1,19 +1,19 @@
 USING: math math.functions math.parser math.text.french sequences tools.test ;
 
 { "zéro" } [ 0 number>text ] unit-test
-{ "vingt et un" } [ 21 number>text ] unit-test
+{ "vingt-et-un" } [ 21 number>text ] unit-test
 { "vingt-deux" } [ 22 number>text ] unit-test
-{ "deux mille" } [ 2000 number>text ] unit-test
-{ "soixante et un" } [ 61 number>text ] unit-test
+{ "deux-mille" } [ 2000 number>text ] unit-test
+{ "soixante-et-un" } [ 61 number>text ] unit-test
 { "soixante-deux" } [ 62 number>text ] unit-test
 { "quatre-vingts" } [ 80 number>text ] unit-test
 { "quatre-vingt-un" } [ 81 number>text ] unit-test
 { "quatre-vingt-onze" } [ 91 number>text ] unit-test
-{ "deux cents" } [ 200 number>text ] unit-test
-{ "mille deux cents" } [ 1200 number>text ] unit-test
-{ "mille deux cent quatre-vingts" } [ 1280 number>text ] unit-test
-{ "mille deux cent quatre-vingt-un" } [ 1281 number>text ] unit-test
-{ "un billion deux cent vingt milliards quatre-vingts millions trois cent quatre-vingt mille deux cents" } [ 1220080380200 number>text ] unit-test
+{ "deux-cents" } [ 200 number>text ] unit-test
+{ "mille-deux-cents" } [ 1200 number>text ] unit-test
+{ "mille-deux-cent-quatre-vingts" } [ 1280 number>text ] unit-test
+{ "mille-deux-cent-quatre-vingt-un" } [ 1281 number>text ] unit-test
+{ "un billion deux-cent-vingt milliards quatre-vingts millions trois-cent-quatre-vingt-mille-deux-cents" } [ 1220080380200 number>text ] unit-test
 { "un million" } [ 1000000 number>text ] unit-test
 { "un million un" } [ 1000001 number>text ] unit-test
 { "moins vingt" } [ -20 number>text ] unit-test

diff --git a/extra/math/text/french/french.factor b/extra/math/text/french/french.factor
index 5b6f9039a3345d03a96f539ae710fa68c660c2b1..e7927a2d7cfb3562d7c88bfad2489edd090fdc7a 100644 (file)
--- a/extra/math/text/french/french.factor
+++ b/extra/math/text/french/french.factor
@@ -33,34 +33,33 @@ MEMO: units ( -- seq ) ! up to 10^99
 
 : space-append ( str1 str2 -- str ) " " glue ;
 
-! Small numbers (below 100) use dashes between them unless they are
-! separated with "et". Pluralized prefixes must be unpluralized.
-: complete-small ( str n -- str )
+: dash-append ( str1 str2 -- str ) "-" glue ;
+
+! Numbers below 1000000 use dashes between them. Pluralized prefixes
+! must be unpluralized.
+: complete ( str n -- str )
     { { 0 [ ] }
-      { 1 [ " et un" append ] }
+      { 1 [ "-et-un" append ] }
       [ [ unpluralize ] dip basic "-" glue ] } case ;
 
 : smaller-than-60 ( n -- str )
-    dup 10 mod [ - ] keep [ basic ] dip complete-small ;
+    dup 10 mod [ - ] keep [ basic ] dip complete ;
 
-: base-onto ( n b -- str ) [ nip literals at ] [ - ] 2bi complete-small ;
+: base-onto ( n b -- str ) [ nip literals at ] [ - ] 2bi complete ;
 
 : smaller-than-80 ( n -- str ) 60 base-onto ;
 
 : smaller-than-100 ( n -- str ) 80 base-onto ;
 
-: complete ( str n -- newstr )
-    [ basic space-append ] unless-zero ;
-
 : smaller-than-1000 ( n -- str )
     100 /mod
-    [ "cent" swap dup 1 = [ drop ] [ basic swap space-append ] if ]
-    [ [ pluralize ] [ basic space-append ] if-zero ] bi* ;
+    [ "cent" swap dup 1 = [ drop ] [ basic swap dash-append ] if ]
+    [ [ pluralize ] [ basic dash-append ] if-zero ] bi* ;
 
 : smaller-than-2000 ( n -- str ) "mille" swap 1000 - complete ;
 
 : smaller-than-1000000 ( n -- str )
-    1000 /mod [ basic unpluralize " mille" append ] dip complete ;
+    1000 /mod [ basic unpluralize "-mille" append ] dip complete ;
 
 : n-units ( n unit -- str/f )
     {
@@ -73,7 +72,8 @@ MEMO: units ( -- seq ) ! up to 10^99
     3 digit-groups [ 1 + units nth n-units ] map-index sift
     reverse " " join ;
 
-: decompose ( n -- str ) 1000000 /mod [ over-1000000 ] dip complete ;
+: decompose ( n -- str ) 1000000 /mod [ over-1000000 ] dip
+    dup 0 > [ basic space-append ] [ drop ] if ;
 
 : basic ( n -- str )
     {