From 0613d01fcca9bd458820a39a993369e23c6bc9c0 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@jjjj.local>
Date: Sun, 13 Jan 2008 07:51:46 -1000
Subject: [PATCH] other algorithms use factor-2s, put it back to normal

---
 extra/math/miller-rabin/miller-rabin.factor | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor
index 66d5793f93..4f139e38e6 100644
--- a/extra/math/miller-rabin/miller-rabin.factor
+++ b/extra/math/miller-rabin/miller-rabin.factor
@@ -20,12 +20,19 @@ SYMBOL: trials
 
 : random-bits ( m -- n ) 2^ random ; foldable
 
-: factor-2s ( zero n -- r s )
-    #! factor an even number into 2 ^ s * m
-    dup even? [ -1 shift >r 1+ r> factor-2s ] when ;
+TUPLE: positive-even-expected n ;
+
+: (factor-2s) ( r s -- r s )
+    dup even? [ -1 shift >r 1+ r> (factor-2s) ] when ;
+
+: factor-2s ( n -- r s )
+    #! factor an even number into s * 2 ^ r
+    dup even? over 0 > and [
+        positive-even-expected construct-boa throw
+    ] unless 0 swap (factor-2s) ;
 
 :: (miller-rabin) | n prime?! |
-    0 n 1- factor-2s s set r set
+    n 1- factor-2s s set r set
     trials get [
         n 1- [1,b] random a set
         a get s get n ^mod 1 = [