math.parser: move (format-float) to formatting.private

mrjbq7 · Feb 13, 2024 · fb0342e · fb0342e
1 parent 4a21a2c
commit fb0342e
Show file tree

Hide file tree

Showing 6 changed files with 51 additions and 58 deletions.
diff --git a/basis/bootstrap/image/primitives/primitives.factor b/basis/bootstrap/image/primitives/primitives.factor
@@ -204,6 +204,17 @@ CONSTANT: all-primitives {
             }
         }
     }
+    {
+        "formatting.private"
+        {
+            {
+                "(format-float)" ( n fill width precision format locale -- byte-array )
+                "format_float"
+                { float byte-array fixnum fixnum byte-array byte-array } { byte-array }
+                make-flushable
+            }
+        }
+    }
     {
         "generic.single.private"
         {
@@ -393,17 +404,6 @@ CONSTANT: all-primitives {
             }
         }
     }
-    {
-        "math.parser.private"
-        {
-            {
-                "(format-float)" ( n fill width precision format locale -- byte-array )
-                "format_float"
-                { float byte-array fixnum fixnum byte-array byte-array } { byte-array }
-                make-flushable
-            }
-        }
-    }
     {
         "math.private"
         {

diff --git a/basis/bootstrap/primitives.factor b/basis/bootstrap/primitives.factor
@@ -66,6 +66,7 @@ call( -- ) ! syntax-quot
     "classes.predicate"
     "compiler.units"
     "continuations.private"
+    "formatting.private"
     "generic.single"
     "generic.single.private"
     "growable"

diff --git a/basis/formatting/formatting-tests.factor b/basis/formatting/formatting-tests.factor
@@ -4,6 +4,36 @@ USING: calendar formatting kernel literals math math.functions
 sequences strings system tools.test ;
 IN: formatting.tests
 
+{
+    B{ 49 46 53 53 69 43 48 53 }
+} [
+    155000.0 B{ 0 } -1 3 B{ 69 0 } B{ 67 0 } (format-float)
+] unit-test
+
+{
+    B{ 32 32 32 32 32 32 32 49 46 53 53 69 43 48 53 }
+} [
+    155000.0 B{ 0 } 15 3 B{ 69 0 } B{ 67 0 } (format-float)
+] unit-test
+
+! Missing locale
+{ "" } [
+    33.4 "" 4 4 "f" "missing" format-float
+] unit-test
+
+! Literal byte arrays are mutable, so (format-float) isn't foldable.
+: trouble ( -- str ba )
+    155000.0 B{ } -1 3 B{ 69 0 } [
+        B{ 67 0 } (format-float) >string
+    ] keep ;
+
+{
+    "1.55E+05"
+    "1.550e+05"
+} [
+    trouble CHAR: e 0 rot set-nth trouble drop
+] unit-test
+
 [ "%s" printf ] must-infer
 [ "%s" sprintf ] must-infer
 

diff --git a/basis/formatting/formatting.factor b/basis/formatting/formatting.factor
@@ -5,13 +5,20 @@ calendar.private combinators combinators.smart generalizations
 io io.streams.string kernel math math.functions math.parser
 multiline namespaces peg.ebnf present prettyprint quotations
 sequences sequences.generalizations splitting strings unicode ;
-FROM: math.parser.private => format-float ;
 IN: formatting
 
 ERROR: unknown-format-directive value ;
 
 <PRIVATE
 
+PRIMITIVE: (format-float) ( n fill width precision format locale -- byte-array )
+
+: pad-null ( format -- format )
+    0 over length 1 + <byte-array> [ copy ] keep ; foldable
+
+: format-float ( n fill width precision format locale -- string )
+    [ pad-null ] 4dip [ pad-null ] bi@ (format-float) >string ; inline
+
 : compose-all ( seq -- quot )
     [ ] [ compose ] reduce ; inline
 
@@ -72,8 +79,7 @@ ERROR: unknown-format-directive value ;
     [ "e" format-float-fast ] [ format-scientific-simple ] if ;
 
 : format-fast-decimal? ( x digits -- x' digits ? )
-    over float? [ t ]
-    [
+    over float? [ t ] [
         2dup
         [ drop dup integer?  [ abs 53 2^ < ] [ drop f ] if ]
         [ over ratio?

diff --git a/core/math/parser/parser-tests.factor b/core/math/parser/parser-tests.factor
@@ -482,36 +482,6 @@ unit-test
 { B{ 222 173 190 239 } } [ "deADbeEF" hex-string>bytes ] unit-test
 [ "0" hex-string>bytes ] [ invalid-hex-string-length? ] must-fail-with
 
-{
-    B{ 49 46 53 53 69 43 48 53 }
-} [
-    155000.0 B{ 0 } -1 3 B{ 69 0 } B{ 67 0 } (format-float)
-] unit-test
-
-{
-    B{ 32 32 32 32 32 32 32 49 46 53 53 69 43 48 53 }
-} [
-    155000.0 B{ 0 } 15 3 B{ 69 0 } B{ 67 0 } (format-float)
-] unit-test
-
-! Missing locale
-{ "" } [
-    33.4 "" 4 4 "f" "missing" format-float
-] unit-test
-
-! Literal byte arrays are mutable, so (format-float) isn't foldable.
-: trouble ( -- str ba )
-    155000.0 B{ } -1 3 B{ 69 0 } [
-        B{ 67 0 } (format-float) >string
-    ] keep ;
-
-{
-    "1.55E+05"
-    "1.550e+05"
-} [
-    trouble CHAR: e 0 rot set-nth trouble drop
-] unit-test
-
 { "143.99999999999997" } [ 0x1.1ffffffffffffp7 number>string ] unit-test
 { "144.0" } [ 0x1.2p7 number>string ] unit-test
 { "144.00000000000003" } [ 0x1.2000000000001p7 number>string ] unit-test

diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor
@@ -5,20 +5,6 @@ layouts make math math.order math.private sbufs sequences
 sequences.private strings ;
 IN: math.parser
 
-<PRIVATE
-PRIMITIVE: (format-float) ( n fill width precision format locale -- byte-array )
-
-: format-string ( format -- format )
-    0 suffix >byte-array ; foldable
-
-! Used as primitive for formatting vocabulary
-: format-float ( n fill width precision format locale -- string )
-    [ format-string ] 4dip
-    [ format-string ] bi@
-    (format-float) >string ; inline
-
-PRIVATE>
-
 : digit> ( ch -- n )
     {
         { [ dup CHAR: 9 <= ] [ CHAR: 0 -      dup  0 < [ drop 255 ] when ] }