From 0069547e908daf030ae1d493995b9fa4073f5993 Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Tue, 3 Feb 2009 00:33:04 +0100
Subject: [PATCH] Fix suboptimal prime number factoring

---
 basis/math/primes/factors/factors-tests.factor | 1 +
 basis/math/primes/factors/factors.factor       | 6 +++++-
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/basis/math/primes/factors/factors-tests.factor b/basis/math/primes/factors/factors-tests.factor
index f247683c1c..983de51216 100644
--- a/basis/math/primes/factors/factors-tests.factor
+++ b/basis/math/primes/factors/factors-tests.factor
@@ -6,3 +6,4 @@ USING: math.primes.factors tools.test ;
 { { 999983 1000003 } } [ 999969000187000867 unique-factors ] unit-test
 { 999967000236000612 } [ 999969000187000867 totient ] unit-test
 { 0 } [ 1 totient ] unit-test
+{ { 425612003 } } [ 425612003 factors ] unit-test
diff --git a/basis/math/primes/factors/factors.factor b/basis/math/primes/factors/factors.factor
index 05d6b26010..4c36fc0a85 100644
--- a/basis/math/primes/factors/factors.factor
+++ b/basis/math/primes/factors/factors.factor
@@ -16,7 +16,11 @@ IN: math.primes.factors
 PRIVATE>
 
 : group-factors ( n -- seq )
-    [ 2 [ over 1 > ] [ write-factor next-prime ] [ ] while 2drop ] { } make ;
+    [
+        2
+        [ 2dup sq < ] [ write-factor next-prime ] [ ] until
+        drop dup 2 < [ drop ] [ 1 2array , ] if
+    ] { } make ;
 
 : unique-factors ( n -- seq ) group-factors [ first ] map ;