1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
|
(* file exemples/ocaml/cmp.ml: compare two modules
*-----------------------------------------------------------------------+
| Copyright 2005-2006, Michel Quercia (michel.quercia@prepas.org) |
| |
| This file is part of Numerix. Numerix is free software; you can |
| redistribute it and/or modify it under the terms of the GNU Lesser |
| General Public License as published by the Free Software Foundation; |
| either version 2.1 of the License, or (at your option) any later |
| version. |
| |
| The Numerix Library 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 |
| Lesser General Public License for more details. |
| |
| You should have received a copy of the GNU Lesser General Public |
| License along with the GNU MP Library; see the file COPYING. If not, |
| write to the Free Software Foundation, Inc., 59 Temple Place - |
| Suite 330, Boston, MA 02111-1307, USA. |
+-----------------------------------------------------------------------+
| |
| Comparaison de deux modules |
| |
+-----------------------------------------------------------------------*)
open Numerix
open Printf
module Main(E:Int_type) = struct
open E
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
zrandom_in x n;
x
(* nombre entier alatoire *)
let random_int() = Random.int(1000000000) - 500000000
(* mode d'arrondi alatoire *)
let random_mode() =
match Random.int(4) with
| 0 -> Floor
| 1 -> Ceil
| 2 -> Nearest_up
| _ -> Nearest_down
(* oprations testes *)
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 ()
(* 1 x 1 *)
let op_1_1 op n =
let a = random_int()
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 dcalages *)
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 f a = let _ = of_string (f a) in ()
let tststring_in f a = let _ = of_string_in r (f a) in ()
(* ajoute un mode d'arrondi *)
let rmode op a = op (random_mode()) a
let rmode_in op a = op (random_mode()) r a
let rmode_ii op a = op (random_mode()) r s a
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 = "bstring_of"; action = op_n (tststring bstring_of) };
{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 = "gmod"; action = op_n_2n (tstquo (rmode gmod)) };
{nom = "gmod_1"; action = op_n_1 (tstquo1 (rmode gmod_1)) };
{nom = "gmod_in"; action = op_n_2n (tstquo (rmode_in gmod_in)) };
{nom = "gpowmod"; action = tstpowm (rmode gpowmod) };
{nom = "gpowmod_in"; action = tstpowm (rmode_in gpowmod_in) };
{nom = "gquo"; action = op_n_2n (tstquo (rmode gquo)) };
{nom = "gquo_1"; action = op_n_1 (tstquo1 (rmode gquo_1)) };
{nom = "gquo_1_in"; action = op_n_1 (tstquo1 (rmode_in gquo_1_in)) };
{nom = "gquo_in"; action = op_n_2n (tstquo (rmode_in gquo_in)) };
{nom = "gquomod"; action = op_n_2n (tstquo (rmode gquomod)) };
{nom = "gquomod_1"; action = op_n_1 (tstquo1 (rmode gquomod_1)) };
{nom = "gquomod_1_in";action = op_n_1 (tstquo1 (rmode_in gquomod_1_in)) };
{nom = "gquomod_in"; action = op_n_2n (tstquo (rmode_ii gquomod_in)) };
{nom = "groot"; action = tstroot (rmode groot) };
{nom = "groot_in"; action = tstroot (rmode_in groot_in) };
{nom = "gsqrt"; action = tstsqrt (rmode gsqrt) };
{nom = "gsqrt_in"; action = tstsqrt (rmode_in gsqrt_in) };
{nom = "highbits"; action = op_n highbits };
{nom = "hstring_of"; action = op_n (tststring hstring_of) };
{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 = "mod"; action = op_n_2n (tstquo modulo) };
{nom = "mod_1"; action = op_n_1 (tstquo1 mod_1) };
{nom = "mod_in"; action = op_n_2n (tstquo (mod_in r)) };
{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_int_in"; action = op_1 (of_int_in r) };
{nom = "of_string"; action = op_n (tststring string_of) };
{nom = "of_string_in";action = op_n (tststring_in string_of) };
{nom = "ostring_of"; action = op_n (tststring ostring_of) };
{nom = "pow"; action = op_n_1 (tstpow pow) };
{nom = "pow_1"; action = op_1_1 (tstpow pow_1) };
{nom = "pow_1_in"; action = op_1_1 (tstpow (pow_1_in r)) };
{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_1_in"; action = op_n_1 (tstquo1 (quo_1_in r)) };
{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 }
|]
(* opration alatoire *)
let random_op() = ops.(Random.int (Array.length ops)).action
(* opration nomme *)
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 cmd =
printf "usage: %s [-n bits] [-op operation] [-r compte] [-s seed]\n" cmd;
printf "operations :\n";
for i = 0 to Array.length(ops)-1 do
printf "%-15s " ops.(i).nom;
if i mod 5 = 4 then printf "\n"
done;
printf "\n"; flush stdout;
exit 0
let main arglist =
printf "%s\n" (E.name()); flush stdout;
let (n,r,op) =
let rec parse (n,r,op) = function
| "-test"::s -> parse (100, 1000, op) s
| "-op"::oo::s -> parse (n, r, Some(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
| "-s" ::x::s -> random_init(int_of_string x); parse (n,r,op) s
| "-h"::_ -> help(List.hd arglist)
| x::_ -> failwith ("invalid option: "^x)
| [] -> (n,r,op)
in parse (100,10000,None) (List.tl arglist) in
try
for i=1 to r do
if i mod 1000 = 0 then begin printf "\ri=%d\027[K" i; flush stdout end;
(match op with None -> random_op() | Some(f) -> f) n;
done;
printf "\n"; flush stdout
with Error(s) -> printf "%s\n" s; flush stdout
end
let _ = let module S = Start(Main) in S.start()
|
