
(* This file is part of Numerix.  Numerix is free software; you can
   redistribute it and/or modify it under the terms of the GNU General
   Public License as published by the Free Software Foundation; either
   version 2 of the License, or (at your option) any later version.

   This program is distributed in the hope that it will be useful, but
   WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
   USA *)

(* +------------------------------------------------------------------------+
   |                                                                        |
   |        Recherche du premier nombre pseudopremier à N chifres           |
   |                                                                        |
   +------------------------------------------------------------------------+ *)

(* M. Quercia, le 06/02/2001 *)
(* Rmq : Gmp est plus rapide que Numerix sur ce programme car son algorithme
   de pgcd (Lehmer) est plus performant que le mien pour des nombres de petite
   taille. *)

open Printf
open Numerix

module Main(E:Int_type) = struct
  open E

  let zero = of_int 0
  and un   = of_int 1
  and deux = of_int 2
  and dix  = of_int 10


  (* Produit des nombres premiers impairs <= n *)
  let pprime(n) =

    (* crible d'Eratosthène : t.(i) <=> 2i+3 est premier *)
    let l = (n-1)/2               in
    let t = Array.create l true   in
    let i = ref(0) and j = ref(3) in
    while !j < l do
      t.(!j) <- false;
      j := !j + !i*2 + 3;
      if !j >= l then begin
	incr i;
	while !i < l & not t.(!i) do incr i done;
	j := !i*2*(!i+3)+3
      end
    done;
    
    (* effectue le produit *)
    let p = make_ref(un) in
    for i=0 to l-1 do if t.(i) then mul_1_in p (look p) (2*i+3) done;
    copy_out p

  (* Test de Rabin-Miller *)
  let rabin =
    let p = make_ref(zero)
    and q = make_ref(zero)
    and r = make_ref(zero) in
    
    fun n a ->

      (* cherche la 2-valuation de n-1 *)
      let n1 = sub n un in
      let i = ref(0) in while not(nth_bit n1 !i) do incr i; done;

      (* calcule a^((n-1)/2^i) (mod n) *)
      powmod_in p a (shr n1 !i) n;

      (* élève au carré jusqu'à trouver 1 ou -1 *)
      if eq (look p) un then true
      else begin
	while (neq (look p) un) & (neq (look p) n1) & (!i > 1) do
	  sqr_in p (look p);
	  quomod_in q p (look p) n;
	  decr i
	done;
	eq (look p) n1
      end


  (* fonction principale *)
  let main arglist =
    try
      (* décode les arguments *)
      let (n,a) = match arglist with
	| ["-test"] -> (100,of_int(2))
	| [sn;sa] -> (int_of_string sn, of_string sa)
	| _       -> raise Exit
      in

      (* 10^n *)
      let n = pow dix n in

      (* produit des premiers premiers *)
      let p = pprime(1000) in

      (* boucle sur n *)
      let rec loop(x) =
	if (eq (gcd p x) un) && (rabin x a) then x else loop (add x deux)
      in
      let n1 = loop(add n un) in

      (* l'affiche *)
      printf "%s\n" (string_of (sub n1 n)); flush stdout

    with ex ->
      fprintf stderr "syntaxe : nextpp <n> <a> [-e entiers] [-count]\n";
      flush stderr;
      raise ex

end

module S = Numcount.Start(Main)
let _ = S.start()
