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
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
|
(* file kernel/ocaml/ml/cmp.ml: Comparison between 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 entre modules |
| |
+-----------------------------------------------------------------------*)
(* +-----------------------------+
| Comparaison entre modules |
+-----------------------------+ *)
module Cmp(A:Int_type)(B:Int_type) = struct
open Printf
type t = A.t * B.t
type tref = A.tref * B.tref
let aname = A.name()
and bname = B.name()
let name() = sprintf "Cmp(%s,%s)" aname bname
let zero = (A.zero,B.zero)
let one = (A.one, B.one)
(* conversion entre lments de type A et de type B *)
let a_of_b(x) = A.of_string(B.hstring_of x)
let b_of_a(x) = B.of_string(A.hstring_of x)
(* compare une valeur de A et une valeur de B *)
let egal a b = (A.hstring_of a) = (B.hstring_of b)
(* copie d'une valeur suceptible d'tre crase *)
let acopy a = let ra = A.make_ref a in A.look ra
let bcopy b = let rb = B.make_ref b in B.look rb
(* noms des modes d'arrondi *)
let mstring_of = function
| Floor -> "Floor"
| Ceil -> "Ceil"
| Nearest_up -> "Nearest_up"
| Nearest_down -> "Nearest_down"
(* noms des rsultats tristate *)
let cstring_of = function
| False -> "False"
| Unknown -> "Unknown"
| True -> "True"
(*
comparaison et agrgation de rsultats calculs dans A et B :
on compare smantiquement les rsultats et en cas d''accord on
retourne le couple de ces rsultats (ou un seul si le rsultat
est un int,string,bool). S'il n'y a pas galit on dclenche
l''exception Differ.
abrviations pour les types des arguments/rsultats
tref = r
t = t
int = i
unit = u
round_mode = m
string = s
bool = b
tristate = c
*)
exception Error of string
(* affiche le nom de la fonction et les paramtres/rsultats *)
let dif_m_t_i_i fn m a1 ia2 ia3 b1 ib2 ib3 =
sprintf "%s.%s = (%s,%s,%d,%d) %s.%s = (%s,%s,%d,%d)"
aname fn (mstring_of m) (A.string_of a1) ia2 ia3
bname fn (mstring_of m) (B.string_of b1) ib2 ib3
let dif_m_t_i_t fn m a1 ia2 a3 b1 ib2 b3 =
sprintf "%s.%s = (%s,%s,%d,%s) %s.%s = (%s,%s,%d,%s)"
aname fn (mstring_of m) (A.string_of a1) ia2 (A.string_of a3)
bname fn (mstring_of m) (B.string_of b1) ib2 (B.string_of b3)
let dif_m_t_i_t_i fn m a1 ia2 a3 ia4 b1 ib2 b3 ib4 =
sprintf "%s.%s = (%s,%s,%d,%s,%d) %s.%s = (%s,%s,%d,%s,%d)"
aname fn (mstring_of m) (A.string_of a1) ia2 (A.string_of a3) ia4
bname fn (mstring_of m) (B.string_of b1) ib2 (B.string_of b3) ib4
let dif_m_t_t fn m a1 a2 b1 b2 =
sprintf "%s.%s = (%s,%s,%s) %s.%s = (%s,%s,%s)"
aname fn (mstring_of m) (A.string_of a1) (A.string_of a2)
bname fn (mstring_of m) (B.string_of b1) (B.string_of b2)
let dif_m_t_t_t fn m a1 a2 a3 b1 b2 b3 =
sprintf "%s.%s = (%s,%s,%s,%s) %s.%s = (%s,%s,%s,%s)"
aname fn (mstring_of m) (A.string_of a1) (A.string_of a2) (A.string_of a3)
bname fn (mstring_of m) (B.string_of b1) (B.string_of b2) (B.string_of b3)
let dif_m_t_t_t_t fn m a1 a2 a3 a4 b1 b2 b3 b4 =
sprintf "%s.%s = (%s,%s,%s,%s,%s) %s.%s = (%s,%s,%s,%s,%s)"
aname fn (mstring_of m) (A.string_of a1) (A.string_of a2) (A.string_of a3) (A.string_of a4)
bname fn (mstring_of m) (B.string_of b1) (B.string_of b2) (B.string_of b3) (B.string_of b4)
let dif_i_c fn ia1 ca2 ib1 cb2 =
sprintf "%s.%s = (%d,%s) %s.%s = (%d,%s)"
aname fn ia1 (cstring_of ca2)
bname fn ib1 (cstring_of cb2)
let dif_i_i_t fn ia1 ia2 a3 ib1 ib2 b3 =
sprintf "%s.%s = (%d,%d,%s) %s.%s = (%d,%d,%s)"
aname fn ia1 ia2 (A.string_of a3)
bname fn ib1 ib2 (B.string_of b3)
let dif_i_t fn ia1 a2 ib1 b2 =
sprintf "%s.%s = (%d,%s) %s.%s = (%d,%s)"
aname fn ia1 (A.string_of a2)
bname fn ib1 (B.string_of b2)
let dif_s fn sa1 sb1 =
sprintf "%s.%s = (%s) %s.%s = (%s)"
aname fn sa1
bname fn sb1
let dif_s_t fn sa1 a2 sb1 b2 =
sprintf "%s.%s = (%s,%s) %s.%s = (%s,%s)"
aname fn sa1 (A.string_of a2)
bname fn sb1 (B.string_of b2)
let dif_t_c fn a1 ca2 b1 cb2 =
sprintf "%s.%s = (%s,%s) %s.%s = (%s,%s)"
aname fn (A.string_of a1) (cstring_of ca2)
bname fn (B.string_of b1) (cstring_of cb2)
let dif_t_i fn a1 ia2 b1 ib2 =
sprintf "%s.%s = (%s,%d) %s.%s = (%s,%d)"
aname fn (A.string_of a1) ia2
bname fn (B.string_of b1) ib2
let dif_t_i_b fn a1 ia2 ba3 b1 ib2 bb3 =
sprintf "%s.%s = (%s,%d,%b) %s.%s = (%s,%d,%b)"
aname fn (A.string_of a1) ia2 ba3
bname fn (B.string_of b1) ib2 bb3
let dif_t_i_i fn a1 ia2 ia3 b1 ib2 ib3 =
sprintf "%s.%s = (%s,%d,%d) %s.%s = (%s,%d,%d)"
aname fn (A.string_of a1) ia2 ia3
bname fn (B.string_of b1) ib2 ib3
let dif_t_i_t fn a1 ia2 a3 b1 ib2 b3 =
sprintf "%s.%s = (%s,%d,%s) %s.%s = (%s,%d,%s)"
aname fn (A.string_of a1) ia2 (A.string_of a3)
bname fn (B.string_of b1) ib2 (B.string_of b3)
let dif_t_i_t_i fn a1 ia2 a3 ia4 b1 ib2 b3 ib4 =
sprintf "%s.%s = (%s,%d,%s,%d) %s.%s = (%s,%d,%s,%d)"
aname fn (A.string_of a1) ia2 (A.string_of a3) ia4
bname fn (B.string_of b1) ib2 (B.string_of b3) ib4
let dif_t_i_t_t fn a1 ia2 a3 a4 b1 ib2 b3 b4 =
sprintf "%s.%s = (%s,%d,%s,%s) %s.%s = (%s,%d,%s,%s)"
aname fn (A.string_of a1) ia2 (A.string_of a3) (A.string_of a4)
bname fn (B.string_of b1) ib2 (B.string_of b3) (B.string_of b4)
let dif_t_s fn a1 sa2 b1 sb2 =
sprintf "%s.%s = (%s,%s) %s.%s = (%s,%s)"
aname fn (A.string_of a1) sa2
bname fn (B.string_of b1) sb2
let dif_t_t fn a1 a2 b1 b2 =
sprintf "%s.%s = (%s,%s) %s.%s = (%s,%s)"
aname fn (A.string_of a1) (A.string_of a2)
bname fn (B.string_of b1) (B.string_of b2)
let dif_t_t_b fn a1 a2 ba3 b1 b2 bb3 =
sprintf "%s.%s = (%s,%s,%b) %s.%s = (%s,%s,%b)"
aname fn (A.string_of a1) (A.string_of a2) ba3
bname fn (B.string_of b1) (B.string_of b2) bb3
let dif_t_t_i fn a1 a2 ia3 b1 b2 ib3 =
sprintf "%s.%s = (%s,%s,%d) %s.%s = (%s,%s,%d)"
aname fn (A.string_of a1) (A.string_of a2) ia3
bname fn (B.string_of b1) (B.string_of b2) ib3
let dif_t_t_i_t fn a1 a2 ia3 a4 b1 b2 ib3 b4 =
sprintf "%s.%s = (%s,%s,%d,%s) %s.%s = (%s,%s,%d,%s)"
aname fn (A.string_of a1) (A.string_of a2) ia3 (A.string_of a4)
bname fn (B.string_of b1) (B.string_of b2) ib3 (B.string_of b4)
let dif_t_t_t fn a1 a2 a3 b1 b2 b3 =
sprintf "%s.%s = (%s,%s,%s) %s.%s = (%s,%s,%s)"
aname fn (A.string_of a1) (A.string_of a2) (A.string_of a3)
bname fn (B.string_of b1) (B.string_of b2) (B.string_of b3)
let dif_t_t_t_t fn a1 a2 a3 a4 b1 b2 b3 b4 =
sprintf "%s.%s = (%s,%s,%s,%s) %s.%s = (%s,%s,%s,%s)"
aname fn (A.string_of a1) (A.string_of a2) (A.string_of a3) (A.string_of a4)
bname fn (B.string_of b1) (B.string_of b2) (B.string_of b3) (B.string_of b4)
let dif_t_t_t_t_t fn a1 a2 a3 a4 a5 b1 b2 b3 b4 b5 =
sprintf "%s.%s = (%s,%s,%s,%s,%s) %s.%s = (%s,%s,%s,%s,%s)"
aname fn (A.string_of a1) (A.string_of a2) (A.string_of a3) (A.string_of a4) (A.string_of a5)
bname fn (B.string_of b1) (B.string_of b2) (B.string_of b3) (B.string_of b4) (B.string_of b5)
let dif_t_t_t_t_t_t_t fn a1 a2 a3 a4 a5 a6 a7 b1 b2 b3 b4 b5 b6 b7 =
sprintf "%s.%s = (%s,%s,%s,%s,%s,%s,%s) %s.%s = (%s,%s,%s,%s,%s,%s,%s)"
aname fn (A.string_of a1) (A.string_of a2) (A.string_of a3) (A.string_of a4) (A.string_of a5) (A.string_of a6) (A.string_of a7)
bname fn (B.string_of b1) (B.string_of b2) (B.string_of b3) (B.string_of b4) (B.string_of b5) (B.string_of b6) (B.string_of b7)
(*
construction des fonctions de comparaison :
x_y_z fa fb fn prend les fonctions fa (module A), fb (module B),
de signatures x -> y -> z, et retourne une fonction de mme signature
qui effectue les calculs en double puis compare les rsultats.
Les contenus des rfrences sont compars en sortie seulement
Les paramtres qui risquent d'tre crass en cas d'opration sur place
sont sauvegards avant calcul
*)
let i_i_t fa fb fn = fun i1 i2 ->
let a3 = fa i1 i2
and b3 = fb i1 i2 in
if egal a3 b3 then (a3,b3)
else raise (Error (dif_i_i_t fn i1 i2 a3 i1 i2 b3))
let i_t fa fb fn = fun i1 ->
let a2 = fa i1
and b2 = fb i1 in
if egal a2 b2 then (a2,b2)
else raise (Error (dif_i_t fn i1 a2 i1 b2))
let i_u fa fb fn = fun i1 ->
fa i1;
fb i1
let m_r_r_t_t_u fa fb fn = fun m (ra1,rb1) (ra2,rb2) (a3,b3) (a4,b4) ->
let aa3 = acopy a3 and aa4 = acopy a4
and bb3 = bcopy b3 and bb4 = bcopy b4 in
fa m ra1 ra2 a3 a4;
fb m rb1 rb2 b3 b4;
let a1 = A.look ra1 and a2 = A.look ra2
and b1 = B.look rb1 and b2 = B.look rb2 in
if (egal a1 b1) & (egal a2 b2) then ()
else raise (Error(dif_m_t_t_t_t fn m aa3 aa4 a1 a2 bb3 bb4 b1 b2))
let m_r_t_i_i fa fb fn = fun m (ra1,rb1) (a2,b2) i3 ->
let aa2 = acopy a2
and bb2 = bcopy b2 in
let ia4 = fa m ra1 a2 i3 and a1 = A.look ra1
and ib4 = fb m rb1 b2 i3 and b1 = B.look rb1 in
if (egal a1 b1) & (ia4 = ib4) then ia4
else raise (Error (dif_m_t_i_t_i fn m aa2 i3 a1 ia4 bb2 i3 b1 ib4))
let m_r_t_i_u fa fb fn = fun m (ra1,rb1) (a2,b2) i3 ->
let aa2 = acopy a2
and bb2 = bcopy b2 in
fa m ra1 a2 i3; let a1 = A.look ra1 in
fb m rb1 b2 i3; let b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_m_t_i_t fn m aa2 i3 a1 bb2 i3 b1))
let m_r_t_t_t_u fa fb fn = fun m (ra1,rb1) (a2,b2) (a3,b3) (a4,b4) ->
let aa2 = acopy a2 and aa3 = acopy a3 and aa4 = acopy a4
and bb2 = bcopy b2 and bb3 = bcopy b3 and bb4 = bcopy b4 in
fa m ra1 a2 a3 a4;
fb m rb1 b2 b3 b4;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_m_t_t_t_t fn m aa2 aa3 aa4 a1 bb2 bb3 bb4 b1))
let m_r_t_t_u fa fb fn = fun m (ra1,rb1) (a2,b2) (a3,b3) ->
let aa2 = acopy a2 and aa3 = acopy a3
and bb2 = bcopy b2 and bb3 = bcopy b3 in
fa m ra1 a2 a3;
fb m rb1 b2 b3;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_m_t_t_t fn m aa2 aa3 a1 bb2 bb3 b1))
let m_r_t_u fa fb fn = fun m (ra1,rb1) (a2,b2) ->
let aa2 = acopy a2
and bb2 = bcopy b2 in
fa m ra1 a2;
fb m rb1 b2;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_m_t_t fn m aa2 a1 bb2 b1))
let m_t_i_i fa fb fn = fun m (a1,b1) i2 ->
let ia3 = fa m a1 i2
and ib3 = fb m b1 i2 in
if ia3 = ib3 then ia3
else raise (Error (dif_m_t_i_i fn m a1 i2 ia3 b1 i2 ib3))
let m_t_i_t fa fb fn = fun m (a1,b1) i2 ->
let a3 = fa m a1 i2
and b3 = fb m b1 i2 in
if egal a3 b3 then (a3,b3)
else raise (Error (dif_m_t_i_t fn m a1 i2 a3 b1 i2 b3))
let m_t_i_ti fa fb fn = fun m (a1,b1) i2 ->
let a3,ia4 = fa m a1 i2
and b3,ib4 = fb m b1 i2 in
if (egal a3 b3) & (ia4 = ib4) then (a3,b3),ia4
else raise (Error (dif_m_t_i_t_i fn m a1 i2 a3 ia4 b1 i2 b3 ib4))
let m_t_t fa fb fn = fun m (a1,b1) ->
let a2 = fa m a1
and b2 = fb m b1 in
if egal a2 b2 then (a2,b2)
else raise (Error (dif_m_t_t fn m a1 a2 b1 b2))
let m_t_t_t fa fb fn = fun m (a1,b1) (a2,b2) ->
let a3 = fa m a1 a2
and b3 = fb m b1 b2 in
if egal a3 b3 then (a3,b3)
else raise (Error (dif_m_t_t_t fn m a1 a2 a3 b1 b2 b3))
let m_t_t_t_t fa fb fn = fun m (a1,b1) (a2,b2) (a3,b3) ->
let a4 = fa m a1 a2 a3
and b4 = fb m b1 b2 b3 in
if egal a4 b4 then (a4,b4)
else raise (Error (dif_m_t_t_t_t fn m a1 a2 a3 a4 b1 b2 b3 b4))
let m_t_t_tt fa fb fn = fun m (a1,b1) (a2,b2) ->
let a3,a4 = fa m a1 a2
and b3,b4 = fb m b1 b2 in
if (egal a3 b3) & (egal a4 b4) then (a3,b3),(a4,b4)
else raise (Error (dif_m_t_t_t_t fn m a1 a2 a3 a4 b1 b2 b3 b4))
let r_i_i_u fa fb fn = fun (ra1,rb1) i2 i3 ->
fa ra1 i2 i3;
fb rb1 i2 i3;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_i_i_t fn i2 i3 a1 i2 i3 b1))
let r_i_u fa fb fn = fun (ra1,rb1) i2 ->
fa ra1 i2;
fb rb1 i2;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_i_t fn i2 a1 i2 b1))
let r_r_r_r_r_t_t_u fa fb fn = fun (ra1,rb1) (ra2,rb2) (ra3,rb3) (ra4,rb4) (ra5,rb5) (a6,b6) (a7,b7) ->
let aa6 = acopy a6 and aa7 = acopy a7
and bb6 = bcopy b6 and bb7 = bcopy b7 in
fa ra1 ra2 ra3 ra4 ra5 a6 a7;
fb rb1 rb2 rb3 rb4 rb5 b6 b7;
let a1 = A.look ra1 and a2 = A.look ra2 and a3 = A.look ra3 and a4 = A.look ra4 and a5 = A.look ra5
and b1 = B.look rb1 and b2 = B.look rb2 and b3 = B.look rb3 and b4 = B.look rb4 and b5 = B.look rb5 in
if (egal a1 b1) & (egal a2 b2) & (egal a3 b3) & (egal a4 b4) & (egal a5 b5) then ()
else raise (Error (dif_t_t_t_t_t_t_t fn aa6 aa7 a1 a2 a3 a4 a5 bb6 bb7 b1 b2 b3 b4 b5))
let r_r_r_t_t_u fa fb fn = fun (ra1,rb1) (ra2,rb2) (ra3,rb3) (a4,b4) (a5,b5) ->
let aa4 = acopy a4 and aa5 = acopy a5
and bb4 = bcopy b4 and bb5 = bcopy b5 in
fa ra1 ra2 ra3 a4 a5;
fb rb1 rb2 rb3 b4 b5;
let a1 = A.look ra1 and a2 = A.look ra2 and a3 = A.look ra3
and b1 = B.look rb1 and b2 = B.look rb2 and b3 = B.look rb3 in
if (egal a1 b1) & (egal a2 b2) & (egal a3 b3) then ()
else raise (Error (dif_t_t_t_t_t fn aa4 aa5 a1 a2 a3 bb4 bb5 b1 b2 b3))
let r_r_t_i_u fa fb fn = fun (ra1,rb1) (ra2,rb2) (a3,b3) i4 ->
let aa3 = acopy a3
and bb3 = bcopy b3 in
fa ra1 ra2 a3 i4;
fb rb1 rb2 b3 i4;
let a1 = A.look ra1 and a2 = A.look ra2
and b1 = B.look rb1 and b2 = B.look rb2 in
if (egal a1 b1) & (egal a2 b2) then ()
else raise (Error (dif_t_i_t_t fn aa3 i4 a1 a2 bb3 i4 b1 b2))
let r_r_t_t_u fa fb fn = fun (ra1,rb1) (ra2,rb2) (a3,b3) (a4,b4) ->
let aa3 = acopy a3 and aa4 = acopy a4
and bb3 = bcopy b3 and bb4 = bcopy b4 in
fa ra1 ra2 a3 a4;
fb rb1 rb2 b3 b4;
let a1 = A.look ra1 and a2 = A.look ra2
and b1 = B.look rb1 and b2 = B.look rb2 in
if (egal a1 b1) & (egal a2 b2) then ()
else raise (Error (dif_t_t_t_t fn aa3 aa4 a1 a2 bb3 bb4 b1 b2))
let r_s_u fa fb fn = fun (ra1,rb1) s2 ->
fa ra1 s2;
fb rb1 s2;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_s_t fn s2 a1 s2 b1))
let r_t fa fb fn = fun (ra1,rb1) ->
let a2 = A.look ra1
and b2 = B.look rb1 in (a2,b2)
let r_t_i_i fa fb fn = fun (ra1,rb1) (a2,b2) i3 ->
let aa2 = acopy a2
and bb2 = bcopy b2 in
let ia4 = fa ra1 a2 i3
and ib4 = fb rb1 b2 i3 in
let a1 = A.look ra1
and b1 = B.look rb1 in
if (egal a1 b1) & (ia4 = ib4) then ia4
else raise (Error (dif_t_i_t_i fn aa2 i3 a1 ia4 bb2 i3 b1 ib4))
let r_t_i_u fa fb fn = fun (ra1,rb1) (a2,b2) i3 ->
let aa2 = acopy a2
and bb2 = bcopy b2 in
fa ra1 a2 i3;
fb rb1 b2 i3;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_t_i_t fn aa2 i3 a1 bb2 i3 b1))
let r_t_t_i_u fa fb fn = fun (ra1,rb1) (a2,b2) (a3,b3) i4 ->
let aa2 = acopy a2 and aa3 = acopy a3
and bb2 = bcopy b2 and bb3 = bcopy b3 in
fa ra1 a2 a3 i4;
fb rb1 b2 b3 i4;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_t_t_i_t fn aa2 aa3 i4 a1 bb2 bb3 i4 b1))
let r_t_t_t_u fa fb fn = fun (ra1,rb1) (a2,b2) (a3,b3) (a4,b4) ->
let aa2 = acopy a2 and aa3 = acopy a3 and aa4 = acopy a4
and bb2 = bcopy b2 and bb3 = bcopy b3 and bb4 = bcopy b4 in
fa ra1 a2 a3 a4;
fb rb1 b2 b3 b4;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_t_t_t_t fn aa2 aa3 aa4 a1 bb2 bb3 bb4 b1))
let r_t_t_u fa fb fn = fun (ra1,rb1) (a2,b2) (a3,b3) ->
let aa2 = acopy a2 and aa3 = acopy a3
and bb2 = bcopy b2 and bb3 = bcopy b3 in
fa ra1 a2 a3;
fb rb1 b2 b3;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_t_t_t fn aa2 aa3 a1 bb2 bb3 b1))
let r_t_u fa fb fn = fun (ra1,rb1) (a2,b2) ->
let aa2 = acopy a2
and bb2 = bcopy b2 in
fa ra1 a2;
fb rb1 b2;
let a1 = A.look ra1
and b1 = B.look rb1 in
if egal a1 b1 then ()
else raise (Error (dif_t_t fn aa2 a1 bb2 b1))
let s_t fa fb fn = fun s1 ->
let a2 = fa s1
and b2 = fb s1 in
if egal a2 b2 then (a2,b2)
else raise (Error (dif_s_t fn s1 a2 s1 b2))
let t_i fa fb fn = fun (a1,b1) ->
let ia2 = fa a1
and ib2 = fb b1 in
if ia2 = ib2 then ia2
else raise (Error (dif_t_i fn a1 ia2 b1 ib2))
let t_i_b fa fb fn = fun (a1,b1) i2 ->
let ba3 = fa a1 i2
and bb3 = fb b1 i2 in
if ba3 = bb3 then ba3
else raise (Error (dif_t_i_b fn a1 i2 ba3 b1 i2 bb3))
let t_i_i fa fb fn = fun (a1,b1) i2 ->
let ia3 = fa a1 i2
and ib3 = fb b1 i2 in
if ia3 = ib3 then ia3
else raise (Error (dif_t_i_i fn a1 i2 ia3 b1 i2 ib3))
let t_i_t fa fb fn = fun (a1,b1) i2 ->
let a3 = fa a1 i2
and b3 = fb b1 i2 in
if egal a3 b3 then (a3,b3)
else raise (Error (dif_t_i_t fn a1 i2 a3 b1 i2 b3))
let t_i_ti fa fb fn = fun (a1,b1) i2 ->
let a3,ia4 = fa a1 i2
and b3,ib4 = fb b1 i2 in
if (egal a3 b3) & (ia4 = ib4) then (a3,b3),ia4
else raise (Error (dif_t_i_t_i fn a1 i2 a3 ia4 b1 i2 b3 ib4))
let t_i_tt fa fb fn = fun (a1,b1) i2 ->
let a3,a4 = fa a1 i2
and b3,b4 = fb b1 i2 in
if (egal a3 b3) & (egal a4 b4) then (a3,b3),(a4,b4)
else raise (Error (dif_t_i_t_t fn a1 i2 a3 a4 b1 i2 b3 b4))
let t_r fa fb fn = fun (a1,b1) ->
let ra2 = fa a1
and rb2 = fb b1 in (ra2,rb2)
let t_s fa fb fn = fun (a1,b1) ->
let sa2 = fa a1
and sb2 = fb b1 in
if sa2 = sb2 then sa2
else raise (Error (dif_t_s fn a1 sa2 b1 sb2))
let t_t fa fb fn = fun (a1,b1) ->
let a2 = fa a1
and b2 = fb b1 in
if egal a2 b2 then (a2,b2)
else raise (Error (dif_t_t fn a1 a2 b1 b2))
let t_t_b fa fb fn = fun (a1,b1) (a2,b2) ->
let ba3 = fa a1 a2
and bb3 = fb b1 b2 in
if ba3 = bb3 then ba3
else raise (Error (dif_t_t_b fn a1 a2 ba3 b1 b2 bb3))
let t_t_i fa fb fn = fun (a1,b1) (a2,b2) ->
let ia3 = fa a1 a2
and ib3 = fb b1 b2 in
if ia3 = ib3 then ia3
else raise (Error (dif_t_t_i fn a1 a2 ia3 b1 b2 ib3))
let t_t_i_t fa fb fn = fun (a1,b1) (a2,b2) i3 ->
let a4 = fa a1 a2 i3
and b4 = fb b1 b2 i3 in
if egal a4 b4 then (a4,b4)
else raise (Error (dif_t_t_i_t fn a1 a2 i3 a4 b1 b2 i3 b4))
let t_t_t fa fb fn = fun (a1,b1) (a2,b2) ->
let a3 = fa a1 a2
and b3 = fb b1 b2 in
if egal a3 b3 then (a3,b3)
else raise (Error (dif_t_t_t fn a1 a2 a3 b1 b2 b3))
let t_t_t_t fa fb fn = fun (a1,b1) (a2,b2) (a3,b3) ->
let a4 = fa a1 a2 a3
and b4 = fb b1 b2 b3 in
if egal a4 b4 then (a4,b4)
else raise (Error (dif_t_t_t_t fn a1 a2 a3 a4 b1 b2 b3 b4))
let t_t_tt fa fb fn = fun (a1,b1) (a2,b2) ->
let a3,a4 = fa a1 a2
and b3,b4 = fb b1 b2 in
if (egal a3 b3) & (egal a4 b4) then (a3,b3),(a4,b4)
else raise (Error (dif_t_t_t_t fn a1 a2 a3 a4 b1 b2 b3 b4))
let t_t_ttt fa fb fn = fun (a1,b1) (a2,b2) ->
let a3,a4,a5 = fa a1 a2
and b3,b4,b5 = fb b1 b2 in
if (egal a3 b3) & (egal a4 b4) & (egal a5 b5) then (a3,b3),(a4,b4),(a5,b5)
else raise (Error (dif_t_t_t_t_t fn a1 a2 a3 a4 a5 b1 b2 b3 b4 b5))
let t_t_ttttt fa fb fn = fun (a1,b1) (a2,b2) ->
let a3,a4,a5,a6,a7 = fa a1 a2
and b3,b4,b5,b6,b7 = fb b1 b2 in
if (egal a3 b3) & (egal a4 b4) & (egal a5 b5) & (egal a6 b6) & (egal a7 b7) then (a3,b3),(a4,b4),(a5,b5),(a6,b6),(a7,b7)
else raise (Error (dif_t_t_t_t_t_t_t fn a1 a2 a3 a4 a5 a6 a7 b1 b2 b3 b4 b5 b6 b7))
(* oprations implmenter *)
let make_ref = t_r A.make_ref B.make_ref "make_ref"
let copy_in = r_t_u A.copy_in B.copy_in "copy_in"
let copy_out = r_t A.copy_out B.copy_out "copy_out"
let look = r_t A.look B.look "look"
let add = t_t_t A.add B.add "add"
let add_1 = t_i_t A.add_1 B.add_1 "add_1"
let add_in = r_t_t_u A.add_in B.add_in "add_in"
let add_1_in = r_t_i_u A.add_1_in B.add_1_in "add_1_in"
let sub = t_t_t A.sub B.sub "sub"
let sub_1 = t_i_t A.sub_1 B.sub_1 "sub_1"
let sub_in = r_t_t_u A.sub_in B.sub_in "sub_in"
let sub_1_in = r_t_i_u A.sub_1_in B.sub_1_in "sub_1_in"
let mul = t_t_t A.mul B.mul "mul"
let mul_1 = t_i_t A.mul_1 B.mul_1 "mul_1"
let mul_in = r_t_t_u A.mul_in B.mul_in "mul_in"
let mul_1_in = r_t_i_u A.mul_1_in B.mul_1_in "mul_1_in"
let quomod = t_t_tt A.quomod B.quomod "quomod"
let quo = t_t_t A.quo B.quo "quo"
let modulo = t_t_t A.modulo B.modulo "modulo"
let gquomod = m_t_t_tt A.gquomod B.gquomod "gquomod"
let gquo = m_t_t_t A.gquo B.gquo "gquo"
let gmod = m_t_t_t A.gmod B.gmod "gmod"
let quomod_in = r_r_t_t_u A.quomod_in B.quomod_in "quomod_in"
let quo_in = r_t_t_u A.quo_in B.quo_in "quo_in"
let mod_in = r_t_t_u A.mod_in B.mod_in "mod_in"
let gquomod_in = m_r_r_t_t_u A.gquomod_in B.gquomod_in "gquomod_in"
let gquo_in = m_r_t_t_u A.gquo_in B.gquo_in "gquo_in"
let gmod_in = m_r_t_t_u A.gmod_in B.gmod_in "gmod_in"
let quomod_1 = t_i_ti A.quomod_1 B.quomod_1 "quomod_1"
let quo_1 = t_i_t A.quo_1 B.quo_1 "quo_1"
let mod_1 = t_i_i A.mod_1 B.mod_1 "mod_1"
let gquomod_1 = m_t_i_ti A.gquomod_1 B.gquomod_1 "gquomod_1"
let gquo_1 = m_t_i_t A.gquo_1 B.gquo_1 "gquo_1"
let gmod_1 = m_t_i_i A.gmod_1 B.gmod_1 "gmod_1"
let quomod_1_in = r_t_i_i A.quomod_1_in B.quomod_1_in "quomod_1_in"
let quo_1_in = r_t_i_u A.quo_1_in B.quo_1_in "quo_1_in"
let gquomod_1_in= m_r_t_i_i A.gquomod_1_in B.gquomod_1_in "gquomod_1_in"
let gquo_1_in = m_r_t_i_u A.gquo_1_in B.gquo_1_in "gquo_1_in"
let abs = t_t A.abs B.abs "abs"
let abs_in = r_t_u A.abs_in B.abs_in "abs_in"
let neg = t_t A.neg B.neg "neg"
let neg_in = r_t_u A.neg_in B.neg_in "neg_in"
let sqr = t_t A.sqr B.sqr "sqr"
let pow = t_i_t A.pow B.pow "pow"
let pow_1 = i_i_t A.pow_1 B.pow_1 "pow_1"
let powmod = t_t_t_t A.powmod B.powmod "powmod"
let gpowmod = m_t_t_t_t A.gpowmod B.gpowmod "gpowmod"
let sqr_in = r_t_u A.sqr_in B.sqr_in "sqr_in"
let pow_in = r_t_i_u A.pow_in B.pow_in "pow_in"
let pow_1_in = r_i_i_u A.pow_1_in B.pow_1_in "pow_1_in"
let powmod_in = r_t_t_t_u A.powmod_in B.powmod_in "powmod_in"
let gpowmod_in = m_r_t_t_t_u A.gpowmod_in B.gpowmod_in "gpowmod_in"
let sqrt = t_t A.sqrt B.sqrt "sqrt"
let root = t_i_t A.root B.root "root"
let gsqrt = m_t_t A.gsqrt B.gsqrt "gsqrt"
let groot = m_t_i_t A.groot B.groot "groot"
let sqrt_in = r_t_u A.sqrt_in B.sqrt_in "sqrt_in"
let root_in = r_t_i_u A.root_in B.root_in "root_in"
let gsqrt_in = m_r_t_u A.gsqrt_in B.gsqrt_in "gsqrt_in"
let groot_in = m_r_t_i_u A.groot_in B.groot_in "groot_in"
let fact = i_t A.fact B.fact "fact"
let fact_in = r_i_u A.fact_in B.fact_in "fact_in"
let gcd = t_t_t A.gcd B.gcd "gcd"
(*let gcd_ex = t_t_ttt A.gcd_ex B.gcd_ex "gcd_ex" *)
(*let cfrac = t_t_ttttt A.cfrac B.cfrac "cfrac" *)
let gcd_in = r_t_t_u A.gcd_in B.gcd_in "gcd_in"
(*let gcd_ex_in = r_r_r_t_t_u A.gcd_ex_in B.gcd_ex_in "gcd_ex_in"*)
(*let cfrac_in = r_r_r_r_r_t_t_u A.cfrac_in B.cfrac_in "cfrac_in" *)
let sgn = t_i A.sgn B.sgn "sgn"
let cmp = t_t_i A.cmp B.cmp "cmp"
let cmp_1 = t_i_i A.cmp_1 B.cmp_1 "cmp_1"
let eq = t_t_b A.eq B.eq "eq"
let eq_1 = t_i_b A.eq_1 B.eq_1 "eq_1"
let neq = t_t_b A.neq B.neq "neq"
let neq_1 = t_i_b A.neq_1 B.neq_1 "neq_1"
let inf = t_t_b A.inf B.inf "inf"
let inf_1 = t_i_b A.inf_1 B.inf_1 "inf_1"
let infeq = t_t_b A.infeq B.infeq "infeq"
let infeq_1 = t_i_b A.infeq_1 B.infeq_1 "infeq_1"
let sup = t_t_b A.sup B.sup "sup"
let sup_1 = t_i_b A.sup_1 B.sup_1 "sup_1"
let supeq = t_t_b A.supeq B.supeq "supeq"
let supeq_1 = t_i_b A.supeq_1 B.supeq_1 "supeq_1"
let of_int = i_t A.of_int B.of_int "of_int"
let of_string = s_t A.of_string B.of_string "of_string"
let of_int_in = r_i_u A.of_int_in B.of_int_in "of_int_in"
let of_string_in= r_s_u A.of_string_in B.of_string_in "of_string_in"
let int_of = t_i A.int_of B.int_of "int_of"
let string_of = t_s A.string_of B.string_of "string_of"
let bstring_of = t_s A.bstring_of B.bstring_of "bstring_of"
let hstring_of = t_s A.hstring_of B.hstring_of "hstring_of"
let ostring_of = t_s A.ostring_of B.ostring_of "ostring_of"
(*let nrandom = i_t A.nrandom B.nrandom "nrandom" *)
(*let zrandom = i_t A.zrandom B.zrandom "zrandom" *)
(*let nrandom1 = i_t A.nrandom1 B.nrandom1 "nrandom1" *)
(*let zrandom1 = i_t A.zrandom1 B.zrandom1 "zrandom1" *)
(*let nrandom_in = r_i_u A.nrandom_in B.nrandom_in "nrandom_in" *)
(*let zrandom_in = r_i_u A.zrandom_in B.zrandom_in "zrandom_in" *)
(*let nrandom1_in = r_i_u A.nrandom1_in B.nrandom1_in "nrandom1_in"*)
(*let zrandom1_in = r_i_u A.zrandom1_in B.zrandom1_in "zrandom1_in"*)
(*let random_init = i_u A.random_init B.random_init "random_init"*)
let nbits = t_i A.nbits B.nbits "nbits"
let lowbits = t_i A.lowbits B.lowbits "lowbits"
let highbits = t_i A.highbits B.highbits "highbits"
let nth_word = t_i_i A.nth_word B.nth_word "nth_word"
let nth_bit = t_i_b A.nth_bit B.nth_bit "nth_bit"
let shl = t_i_t A.shl B.shl "shl"
let shr = t_i_t A.shr B.shr "shr"
let split = t_i_tt A.split B.split "split"
let join = t_t_i_t A.join B.join "join"
let shl_in = r_t_i_u A.shl_in B.shl_in "shl_in"
let shr_in = r_t_i_u A.shr_in B.shr_in "shr_in"
let split_in = r_r_t_i_u A.split_in B.split_in "split_in"
let join_in = r_t_t_i_u A.join_in B.join_in "join_in"
(* Coefficients de Bzout : on ne compare pas u,v mais on vrifie que ua-vb = d *)
let gcd_ex (a1,b1) (a2,b2) =
let a3,a4,a5 = A.gcd_ex a1 a2
and b3,b4,b5 = B.gcd_ex b1 b2 in
if (egal a3 b3) & (B.eq b3 (B.sub (B.mul b4 b1) (B.mul b5 b2)))
then (a3,b3),(a4,(b_of_a a4)),(a5,(b_of_a a5))
else raise (Error (dif_t_t_t_t_t "gcd_ex" a1 a2 a3 a4 a5 b1 b2 b3 b4 b5))
let cfrac (a1,b1) (a2,b2) =
let a3,a4,a5,a6,a7 = A.cfrac a1 a2
and b3,b4,b5,b6,b7 = B.cfrac b1 b2 in
if (egal a3 b3) & (B.eq b3 (B.sub (B.mul b4 b1) (B.mul b5 b2))) & (egal a6 b6) & (egal a7 b7)
then (a3,b3),(a4,(b_of_a a4)),(a5,(b_of_a a5)),(a6,b6),(a7,b7)
else raise (Error (dif_t_t_t_t_t_t_t "cfrac" a1 a2 a3 a4 a5 a6 a7 b1 b2 b3 b4 b5 b6 b7))
let gcd_ex_in (ra1,rb1) (ra2,rb2) (ra3,rb3) (a4,b4) (a5,b5) =
let aa4 = acopy a4 and aa5 = acopy a5
and bb4 = bcopy b4 and bb5 = bcopy b5 in
A.gcd_ex_in ra1 ra2 ra3 a4 a5;
B.gcd_ex_in rb1 rb2 rb3 b4 b5;
let a1 = A.look ra1 and a2 = A.look ra2 and a3 = A.look ra3
and b1 = B.look rb1 and b2 = B.look rb2 and b3 = B.look rb3 in
if (egal a1 b1) & (B.eq b1 (B.sub (B.mul b2 bb4) (B.mul b3 bb5)))
then begin
B.copy_in rb2 (b_of_a a2);
B.copy_in rb3 (b_of_a a3)
end
else raise (Error (dif_t_t_t_t_t "gcd_ex_in" aa4 aa5 a1 a2 a3 bb4 bb5 b1 b2 b3))
let cfrac_in (ra1,rb1) (ra2,rb2) (ra3,rb3) (ra4,rb4) (ra5,rb5) (a6,b6) (a7,b7) =
let aa6 = acopy a6 and aa7 = acopy a7
and bb6 = bcopy b6 and bb7 = bcopy b7 in
A.cfrac_in ra1 ra2 ra3 ra4 ra5 a6 a7;
B.cfrac_in rb1 rb2 rb3 rb4 rb5 b6 b7;
let a1 = A.look ra1 and a2 = A.look ra2 and a3 = A.look ra3 and a4 = A.look ra4 and a5 = A.look ra5
and b1 = B.look rb1 and b2 = B.look rb2 and b3 = B.look rb3 and b4 = B.look rb4 and b5 = B.look rb5 in
if (egal a1 b1) & (B.eq b1 (B.sub (B.mul b2 bb6) (B.mul b3 bb7))) & (egal a4 b4) & (egal a5 b5)
then begin
B.copy_in rb2 (b_of_a a2);
B.copy_in rb3 (b_of_a a3)
end
else raise (Error (dif_t_t_t_t_t_t_t "cfrac_in" aa6 aa7 a1 a2 a3 a4 a5 bb6 bb7 b1 b2 b3 b4 b5))
(* test de primalit : on prend le rsultat le plus prcis *)
let isprime (a,b) = match (A.isprime a),(B.isprime b) with
| Unknown,r -> r
| r,Unknown -> r
| r,s -> if r = s then r else raise (Error (dif_t_c "isprime" a r b s))
let isprime_1 i = match (A.isprime_1 i),(B.isprime_1 i) with
| Unknown,r -> r
| r,Unknown -> r
| r,s -> if r = s then r else raise (Error (dif_i_c "isprime_1" i r i s))
(* nombres alatoires : on prend le gnrateur de A *)
let nrandom n = let a = A.nrandom n in a,(b_of_a a)
let zrandom n = let a = A.zrandom n in a,(b_of_a a)
let nrandom1 n = let a = A.nrandom1 n in a,(b_of_a a)
let zrandom1 n = let a = A.zrandom1 n in a,(b_of_a a)
let nrandom_in (ra,rb) n = A.nrandom_in ra n; B.copy_in rb (b_of_a (A.look ra))
let zrandom_in (ra,rb) n = A.zrandom_in ra n; B.copy_in rb (b_of_a (A.look ra))
let nrandom1_in (ra,rb) n = A.nrandom1_in ra n; B.copy_in rb (b_of_a (A.look ra))
let zrandom1_in (ra,rb) n = A.zrandom1_in ra n; B.copy_in rb (b_of_a (A.look ra))
let random_init n = A.random_init n
(* affichage *)
let toplevel_print(a,b) = A.toplevel_print(a)
let toplevel_print_tref(a,b) = A.toplevel_print_tref(a)
end
|
