
(* 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 *)

(* +------------------------------------------------------------------------+
   |                                                                        |
   |               Tests systématiques des bibliothèques Numerix            |
   |                                                                        |
   +------------------------------------------------------------------------+ *)

(* M. Quercia le 05/02/2001 *)

open Numerix
open Printf

module Main(E:Int_type) = struct
  open E

  let zero = of_int 0


  let r = make_ref zero
  and s = make_ref zero
  and t = make_ref zero
  and u = make_ref zero
  and v = make_ref zero

  (* tire un nombre au hasard et renvoie le tref le contenant *)
  let random_num(n) =
    let x = match Random.int(5) with
      | 0 -> r
      | 1 -> s
      | 2 -> t
      | 3 -> u
      | _ -> v
    in
    copy_in x (random_bits n);
    if Random.int(2) <> 0 then neg_in x (look x);
    x

  (* nombre entier aléatoire *)
  let random_int() = Random.int(1000000000) - 500000000

  (* opérations testées *)
  type op = {nom:string; action:int->unit}

  (* n *)
  let op_n op n =
    let aref = random_num(n) in
    let a    = look aref     in
    let _    = op a          in ()

  (* n x n *)
  let op_n_n op n = 
    let aref = random_num(n)
    and bref = random_num(n) in
    let a    = look aref
    and b    = look bref     in
    let _    = op a b        in ()

  (* 2n * n *)
  let op_n_2n op n = 
    let aref = random_num(2*n)
    and bref = random_num(n) in
    let a    = look aref
    and b    = look bref     in
    let _    = op a b        in ()

  (* n x 1 *)
  let op_n_1 op n = 
    let aref = random_num(n) in
    let a    = look aref
    and b    = random_int()  in
    let _    = op a b        in ()

  (* 0 x 1 *)
  let op_1 op n = let _ = op (random_int()) in ()

  (* divisions *)
  let tstquo op a b =
    if neq b zero then let _ = op a b in ()

  let tstquoe op a b =
    if neq b zero then let _ = op (add_1 (mul a b) (random_int())) b in ()

  let tstquo1 op a b =
    if b <> 0 then let _ = op a b in ()

  (* racines *)
  let tstsqrt op n =
    let aref = random_num(n) in
    abs_in aref (look aref);
    let _ = op (look aref) in ()

  let tstsqrte op n =
    let aref = random_num(n) in
    sqr_in aref (look aref);
    add_1_in aref (look aref) (random_int());
    abs_in aref (look aref);
    let _ = op (look aref) in ()

  let tstroot op n =
    let aref = random_num(n) in
    abs_in aref (look aref);
    let b = random_int() land 0xff in
    if b <> 0 then let _ = op (look aref) in ()

  (* puissances et décalages *)
  let tstpow  op a b = let _ = op a (b land 0xff) in ()
  let tstfact op   b = let _ = op   (b land 0xff) in ()
  let tstsh   op a b = let _ = op a ((b land 0xff) - 128) in ()
  let tstjoin op a b = let _ = op a b (random_int() land 0xff) in ()
  let tstbit  op a b = let _ = op a (Pervasives.abs b) in ()
  let tstint  op a   = let _ = op (shr a (nbits(a)-30)) in ()
    
  (* powmod *)
  let tstpowm op n =
    let aref = random_num(n)
    and bref = random_num(n)
    and cref = random_num(n) in
    abs_in bref (look bref);
    let a    = look aref
    and b    = look bref
    and c    = look cref     in
    if neq c zero then let _ = op a b c in ()

(* of_string/string/of *)
  let tststring a = let _ = of_string(string_of a) in ()

  let ops = [|
    {nom = "abs";         action = op_n    abs};
    {nom = "abs_in";      action = op_n    (abs_in r)};
    {nom = "add";         action = op_n_n  add};
    {nom = "add_1";       action = op_n_1  add_1};
    {nom = "add_1_in";    action = op_n_1  (add_1_in r)};
    {nom = "add_in";      action = op_n_n  (add_in r)};
    {nom = "cfrac";       action = op_n_n  cfrac};
    {nom = "cfrac_in";    action = op_n_n  (cfrac_in r s t u v)};
    {nom = "cmp";         action = op_n_n  cmp};
    {nom = "cmp_1";       action = op_n_1  cmp_1};
    {nom = "eq";          action = op_n_n  eq};
    {nom = "eq_1";        action = op_n_1  eq_1};
    {nom = "fact";        action = op_1    (tstfact fact)};
    {nom = "fact_in";     action = op_1    (tstfact (fact_in r))};
    {nom = "gcd";         action = op_n_n  gcd};
    {nom = "gcd_ex";      action = op_n_n  gcd_ex};
    {nom = "gcd_ex_in";   action = op_n_n  (gcd_ex_in r s t)};
    {nom = "gcd_in";      action = op_n_n  (gcd_in r)};
    {nom = "highbits";    action = op_n    highbits};
    {nom = "inf";         action = op_n_n  inf};
    {nom = "inf_1";       action = op_n_1  inf_1};
    {nom = "infeq";       action = op_n_n  infeq};
    {nom = "infeq_1";     action = op_n_1  infeq_1};
    {nom = "int_of";      action = op_n    (tstint int_of)};
    {nom = "join";        action = op_n_n  (tstjoin join)};
    {nom = "join_in";     action = op_n_n  (tstjoin (join_in r))};
    {nom = "lowbits";     action = op_n    lowbits};
    {nom = "max";         action = op_n_n  max};
    {nom = "min";         action = op_n_n  min};
    {nom = "mod";         action = op_n_2n (tstquo  modulo)};
    {nom = "mod_1";       action = op_n_1  (tstquo1 mod_1)};
    {nom = "mul";         action = op_n_n  mul};
    {nom = "mul_1";       action = op_n_1  mul_1};
    {nom = "mul_1_in";    action = op_n_1  (mul_1_in r)};
    {nom = "mul_in";      action = op_n_n  (mul_in r)};
    {nom = "nbits";       action = op_n    nbits};
    {nom = "neg";         action = op_n    neg};
    {nom = "neg_in";      action = op_n    (neg_in r)};
    {nom = "neq";         action = op_n_n  neq};
    {nom = "neq_1";       action = op_n_1  neq_1};
    {nom = "nth_bit";     action = op_n_1  (tstbit nth_bit)};
    {nom = "nth_word";    action = op_n_1  (tstbit nth_word)};
    {nom = "of_int";      action = op_1    of_int};
    {nom = "of_string";   action = op_n    tststring};
    {nom = "pow";         action = op_n_1  (tstpow  pow)};
    {nom = "pow_in";      action = op_n_1  (tstpow  (pow_in r))};
    {nom = "powmod";      action = tstpowm powmod};
    {nom = "powmod_in";   action = tstpowm (powmod_in r)};
    {nom = "quo";         action = op_n_2n (tstquo  quo)};
    {nom = "quo_1";       action = op_n_1  (tstquo1 quo_1)};
    {nom = "quo_in";      action = op_n_2n (tstquo  (quo_in r))};
    {nom = "quoe";        action = op_n_n  (tstquoe quo)};
    {nom = "quomod";      action = op_n_2n (tstquo  quomod)};
    {nom = "quomod_1";    action = op_n_1  (tstquo1 quomod_1)};
    {nom = "quomod_1_in"; action = op_n_1  (tstquo1 (quomod_1_in r))};
    {nom = "quomod_in";   action = op_n_2n (tstquo  (quomod_in r s))};
    {nom = "root";        action = tstroot root};
    {nom = "root_in";     action = tstroot (root_in r)};
    {nom = "sgn";         action = op_n    sgn};
    {nom = "shl";         action = op_n_1  (tstsh   shl)};
    {nom = "shl_in";      action = op_n_1  (tstsh   (shl_in r))};
    {nom = "shr";         action = op_n_1  (tstsh   shr)};
    {nom = "shr_in";      action = op_n_1  (tstsh   (shr_in r))};
    {nom = "split";       action = op_n_1  (tstpow  split)};
    {nom = "split_in";    action = op_n_1  (tstpow  (split_in r s))};
    {nom = "sqr";         action = op_n    sqr};
    {nom = "sqr_in";      action = op_n    (sqr_in r)};
    {nom = "sqrt";        action = tstsqrt  sqrt};
    {nom = "sqrt_in";     action = tstsqrt (sqrt_in r)};
    {nom = "sqrte";       action = tstsqrte sqrt};
    {nom = "sub";         action = op_n_n  sub};
    {nom = "sub_1";       action = op_n_1  sub_1};
    {nom = "sub_1_in";    action = op_n_1  (sub_1_in r)};
    {nom = "sub_in";      action = op_n_n  (sub_in r)};
    {nom = "sup";         action = op_n_n  sup};
    {nom = "sup_1";       action = op_n_1  sup_1};
    {nom = "supeq";       action = op_n_n  supeq};
    {nom = "supeq_1";     action = op_n_1  supeq_1}
  |]

  (* opération aléatoire *)
  let random_op = ops.(Random.int (Array.length ops)).action

  (* opération nommée *)
  let op_of_string(s) =
    let i = ref(Array.length(ops)-1) in
    while (!i >= 0) & (ops.(!i).nom <> s) do decr i done;
    if !i >= 0 then ops.(!i).action
    else failwith ("unknown operation: "^s)
      
  let help() =
    fprintf stderr "usage : cmp [-e entiers] [-n bits] [-op operation] [-r compte] [-s seed]\n";
    fprintf stderr "operations :\n";
    for i = 0 to Array.length(ops)-1 do
      fprintf stderr "%-15s " ops.(i).nom;
      if i mod 5 = 4 then fprintf stderr "\n"
    done;
    fprintf stderr "\n";
    exit 0
    
  let main arglist =

    fprintf stderr "%s\n" (E.name()); flush stderr;
    let (n,r,op) =
      let rec parse (n,r,op) = function
      | "-test"::s    -> parse (100, 1000, op) s
      | "-op"::oo::s  -> parse (n, r, op_of_string oo ) s
      | "-n" ::nn::s  -> parse (int_of_string nn, r, op) s
      | "-r" ::rr::s  -> parse (n, int_of_string rr, op) s
      | "-seed"::x::s -> Random.init(int_of_string x); parse (n,r,op) s
      | "-h"::_       -> help()
      | "-op"::_      -> failwith "no operation specified"
      | "-n"::_       -> failwith "no bit size specified"
      | "-r"::_       -> failwith "no repeat count specified"
      | x::_          -> failwith ("unknown option: "^x)
      | []            -> (n,r,op)
    in parse (100,10000,random_op) arglist in

    for i=1 to r do
      if (i mod 1000 == 0) then begin
	fprintf stderr "\ri=%d\027[K" i;
	flush stderr;
      end;
      op n;
    done;
    fprintf stderr "\n"; flush stderr
end

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