← Back to branch summary

~ubuntu-branches/ubuntu/precise/gnat-gps/precise

« back to all changes in this revision

Viewing changes to gnatlib/src/gmp/gnatcoll-gmp-integers.adb

  • Committer: Package Import Robot
  • Author(s): Ludovic Brenta
  • Date: 2012-01-15 15:42:21 UTC
  • mfrom: (10.1.10 sid)
  • Revision ID: package-import@ubuntu.com-20120115154221-ccysuzvh02pkhuwq
Tags: 5.0-6
Rebuild against libgtkada 2.24.1.

Show diffs side-by-side

added added

removed removed

Lines of Context:
gnatlib/src/gmp/gnatcoll-gmp-integers.adb
 
1
-----------------------------------------------------------------------
 
2
--                          G N A T C O L L                          --
 
3
--                                                                   --
 
4
--                      Copyright (C) 2009, AdaCore                  --
 
5
--                                                                   --
 
6
-- GPS is free  software;  you can redistribute it and/or modify  it --
 
7
-- under the terms of the GNU General Public License as published by --
 
8
-- the Free Software Foundation; either version 2 of the License, or --
 
9
-- (at your option) any later version.                               --
 
10
--                                                                   --
 
11
-- This program is  distributed in the hope that it will be  useful, --
 
12
-- but  WITHOUT ANY WARRANTY;  without even the  implied warranty of --
 
13
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
 
14
-- General Public License for more details. You should have received --
 
15
-- a copy of the GNU General Public License along with this library; --
 
16
-- if not,  write to the  Free Software Foundation, Inc.,  59 Temple --
 
17
-- Place - Suite 330, Boston, MA 02111-1307, USA.                    --
 
18
-----------------------------------------------------------------------
 
19
 
 
20
with Interfaces.C.Strings;
 
21
 
 
22
package body GNATCOLL.GMP.Integers is
 
23
 
 
24
   use GNATCOLL.GMP.Lib;
 
25
 
 
26
   ----------------
 
27
   -- Initialize --
 
28
   ----------------
 
29
 
 
30
   procedure Initialize (This : in out Big_Integer) is
 
31
   begin
 
32
      mpz_init (This.Value'Access);
 
33
   end Initialize;
 
34
 
 
35
   --------------
 
36
   -- Finalize --
 
37
   --------------
 
38
 
 
39
   procedure Finalize (This : in out Big_Integer) is
 
40
   begin
 
41
      mpz_clear (This.Value'Access);
 
42
   end Finalize;
 
43
 
 
44
   ---------
 
45
   -- Set --
 
46
   ---------
 
47
 
 
48
   procedure Set
 
49
     (This : out Big_Integer;
 
50
      To   : String;
 
51
      Base : Int := 10)
 
52
   is
 
53
      use Interfaces.C.Strings;
 
54
 
 
55
      Result : Int;
 
56
      Input  : chars_ptr := New_String (To);
 
57
   begin
 
58
      Result := mpz_set_str (This.Value'Access, Input, Base);
 
59
      Free (Input);
 
60
      if Result /= 0 then
 
61
         raise Failure;
 
62
      end if;
 
63
   end Set;
 
64
 
 
65
   ----------
 
66
   -- Make --
 
67
   ----------
 
68
 
 
69
   function Make (This : String;  Base : Int := 10) return Big_Integer is
 
70
   begin
 
71
      return Result : Big_Integer do
 
72
         Set (Result, This, Base);
 
73
      end return;
 
74
   end Make;
 
75
 
 
76
   ---------
 
77
   -- Set --
 
78
   ---------
 
79
 
 
80
   procedure Set (This : out Big_Integer;  To : Big_Integer) is
 
81
   begin
 
82
      mpz_set (This.Value'Access, To.Value'Access);
 
83
   end Set;
 
84
 
 
85
   ---------
 
86
   -- Set --
 
87
   ---------
 
88
 
 
89
   procedure Set (This : out Big_Integer;  To : Long) is
 
90
   begin
 
91
      mpz_set_si (This.Value'Access, To);
 
92
   end Set;
 
93
 
 
94
   ---------
 
95
   -- Set --
 
96
   ---------
 
97
 
 
98
   procedure Set_UL (This : out Big_Integer;  To : Unsigned_Long) is
 
99
   begin
 
100
      mpz_set_ui (This.Value'Access, To);
 
101
   end Set_UL;
 
102
 
 
103
   ---------
 
104
   -- "=" --
 
105
   ---------
 
106
 
 
107
   function "=" (Left : Big_Integer;  Right : Big_Integer)
 
108
      return Boolean
 
109
   is
 
110
   begin
 
111
      return mpz_cmp (Left.Value'Access, Right.Value'Access) = 0;
 
112
   end "=";
 
113
 
 
114
   ---------
 
115
   -- "=" --
 
116
   ---------
 
117
 
 
118
   function "=" (Left : Big_Integer;  Right : Long)
 
119
      return Boolean
 
120
   is
 
121
   begin
 
122
      return mpz_cmp_si (Left.Value'Access, Right) = 0;
 
123
   end "=";
 
124
 
 
125
   ---------
 
126
   -- "=" --
 
127
   ---------
 
128
 
 
129
   function "=" (Left : Long;  Right : Big_Integer)
 
130
      return Boolean
 
131
   is
 
132
   begin
 
133
      return mpz_cmp_si (Right.Value'Access, Left) = 0;
 
134
   end "=";
 
135
 
 
136
   ---------
 
137
   -- ">" --
 
138
   ---------
 
139
 
 
140
   function ">" (Left : Big_Integer;  Right : Big_Integer)
 
141
      return Boolean
 
142
   is
 
143
   begin
 
144
      return mpz_cmp (Left.Value'Access, Right.Value'Access) > 0;
 
145
   end ">";
 
146
 
 
147
   ---------
 
148
   -- ">" --
 
149
   ---------
 
150
 
 
151
   function ">" (Left : Big_Integer;  Right : Long)
 
152
      return Boolean
 
153
   is
 
154
   begin
 
155
      return mpz_cmp_si (Left.Value'Access, Right) > 0;
 
156
   end ">";
 
157
 
 
158
   ---------
 
159
   -- ">" --
 
160
   ---------
 
161
 
 
162
   function ">" (Left : Long;  Right : Big_Integer)
 
163
      return Boolean
 
164
   is
 
165
   begin
 
166
      return mpz_cmp_si (Right.Value'Access, Left) > 0;
 
167
   end ">";
 
168
 
 
169
   ----------
 
170
   -- ">=" --
 
171
   ----------
 
172
 
 
173
   function ">=" (Left : Big_Integer;  Right : Big_Integer)
 
174
      return Boolean
 
175
   is
 
176
   begin
 
177
      return mpz_cmp (Left.Value'Access, Right.Value'Access) >= 0;
 
178
   end ">=";
 
179
 
 
180
   ----------
 
181
   -- ">=" --
 
182
   ----------
 
183
 
 
184
   function ">=" (Left : Big_Integer;  Right : Long)
 
185
      return Boolean
 
186
   is
 
187
   begin
 
188
      return mpz_cmp_si (Left.Value'Access, Right) >= 0;
 
189
   end ">=";
 
190
 
 
191
   ----------
 
192
   -- ">=" --
 
193
   ----------
 
194
 
 
195
   function ">=" (Left : Long; Right : Big_Integer)
 
196
      return Boolean
 
197
   is
 
198
   begin
 
199
      return mpz_cmp_si (Right.Value'Access, Left) >= 0;
 
200
   end ">=";
 
201
 
 
202
   ---------
 
203
   -- "<" --
 
204
   ---------
 
205
 
 
206
   function "<" (Left : Big_Integer;  Right : Big_Integer)
 
207
      return Boolean
 
208
   is
 
209
   begin
 
210
      return mpz_cmp (Left.Value'Access, Right.Value'Access) < 0;
 
211
   end "<";
 
212
 
 
213
   ---------
 
214
   -- "<" --
 
215
   ---------
 
216
 
 
217
   function "<" (Left : Big_Integer;  Right : Long)
 
218
      return Boolean
 
219
   is
 
220
   begin
 
221
      return mpz_cmp_si (Left.Value'Access, Right) < 0;
 
222
   end "<";
 
223
 
 
224
   ---------
 
225
   -- "<" --
 
226
   ---------
 
227
 
 
228
   function "<" (Left : Long;  Right : Big_Integer)
 
229
      return Boolean
 
230
   is
 
231
   begin
 
232
      return mpz_cmp_si (Right.Value'Access, Left) < 0;
 
233
   end "<";
 
234
 
 
235
   ----------
 
236
   -- "<=" --
 
237
   ----------
 
238
 
 
239
   function "<=" (Left : Big_Integer;  Right : Big_Integer)
 
240
      return Boolean
 
241
   is
 
242
   begin
 
243
      return mpz_cmp (Left.Value'Access, Right.Value'Access) <= 0;
 
244
   end "<=";
 
245
 
 
246
   ----------
 
247
   -- "<=" --
 
248
   ----------
 
249
 
 
250
   function "<=" (Left : Big_Integer;  Right : Long)
 
251
      return Boolean
 
252
   is
 
253
   begin
 
254
      return mpz_cmp_si (Left.Value'Access, Right) <= 0;
 
255
   end "<=";
 
256
 
 
257
   ----------
 
258
   -- "<=" --
 
259
   ----------
 
260
 
 
261
   function "<=" (Left : Long; Right : Big_Integer)
 
262
      return Boolean
 
263
   is
 
264
   begin
 
265
      return mpz_cmp_si (Right.Value'Access, Left) <= 0;
 
266
   end "<=";
 
267
 
 
268
   ---------
 
269
   -- Add --
 
270
   ---------
 
271
 
 
272
   procedure Add (To : in out Big_Integer;  This : Unsigned_Long) is
 
273
   begin
 
274
      mpz_add_ui (To.Value'Access, To.Value'Access, This);
 
275
   end Add;
 
276
 
 
277
   ---------
 
278
   -- Add --
 
279
   ---------
 
280
 
 
281
   procedure Add (To : in out Big_Integer;  This : Big_Integer) is
 
282
   begin
 
283
      mpz_add (To.Value'Access, To.Value'Access, This.Value'Access);
 
284
   end Add;
 
285
 
 
286
   ---------
 
287
   -- Add --
 
288
   ---------
 
289
 
 
290
   procedure Add (Result : out Big_Integer;  Op1, Op2 : Big_Integer) is
 
291
   begin
 
292
      mpz_add (Result.Value'Access, Op1.Value'Access, Op2.Value'Access);
 
293
   end Add;
 
294
 
 
295
   ---------
 
296
   -- "+" --
 
297
   ---------
 
298
 
 
299
   function "+" (Left, Right : Big_Integer)
 
300
      return Big_Integer
 
301
   is
 
302
   begin
 
303
      return Result : Big_Integer do
 
304
         mpz_add (Result.Value'Access, Left.Value'Access, Right.Value'Access);
 
305
      end return;
 
306
   end "+";
 
307
 
 
308
   ---------
 
309
   -- "+" --
 
310
   ---------
 
311
 
 
312
   function "+" (Left : Big_Integer; Right : Unsigned_Long)
 
313
      return Big_Integer
 
314
   is
 
315
   begin
 
316
      return Result : Big_Integer do
 
317
         mpz_add_ui (Result.Value'Access,
 
318
                     Left.Value'Access,
 
319
                     Right);
 
320
      end return;
 
321
   end "+";
 
322
 
 
323
   ---------
 
324
   -- "+" --
 
325
   ---------
 
326
 
 
327
   function "+" (Left : Unsigned_Long; Right : Big_Integer)
 
328
      return Big_Integer
 
329
   is
 
330
   begin
 
331
      return Result : Big_Integer do
 
332
         mpz_add_ui (Result.Value'Access,
 
333
                     Right.Value'Access,
 
334
                     Left);
 
335
      end return;
 
336
   end "+";
 
337
 
 
338
   --------------
 
339
   -- Subtract --
 
340
   --------------
 
341
 
 
342
   procedure Subtract (From : in out Big_Integer;  This : Unsigned_Long) is
 
343
   begin
 
344
      mpz_sub_ui (From.Value'Access, From.Value'Access, This);
 
345
   end Subtract;
 
346
 
 
347
   --------------
 
348
   -- Subtract --
 
349
   --------------
 
350
 
 
351
   procedure Subtract (From : in out Big_Integer;  This : Big_Integer) is
 
352
   begin
 
353
      mpz_sub (From.Value'Access, From.Value'Access, This.Value'Access);
 
354
   end Subtract;
 
355
 
 
356
   --------------
 
357
   -- Subtract --
 
358
   --------------
 
359
 
 
360
   procedure Subtract (Result : out Big_Integer; Op1, Op2 : Big_Integer) is
 
361
   begin
 
362
      mpz_sub (Result.Value'Access, Op1.Value'Access, Op2.Value'Access);
 
363
   end Subtract;
 
364
 
 
365
   ---------
 
366
   -- "-" --
 
367
   ---------
 
368
 
 
369
   function "-" (Left, Right : Big_Integer)
 
370
      return Big_Integer
 
371
   is
 
372
   begin
 
373
      return Result : Big_Integer do
 
374
         mpz_sub (Result.Value'Access, Left.Value'Access, Right.Value'Access);
 
375
      end return;
 
376
   end "-";
 
377
 
 
378
   ---------
 
379
   -- "-" --
 
380
   ---------
 
381
 
 
382
   function "-" (Left : Big_Integer; Right : Unsigned_Long)
 
383
      return Big_Integer
 
384
   is
 
385
   begin
 
386
      return Result : Big_Integer do
 
387
         mpz_add_ui (Result.Value'Access,
 
388
                     Left.Value'Access,
 
389
                     Right);
 
390
      end return;
 
391
   end "-";
 
392
 
 
393
   ---------
 
394
   -- "-" --
 
395
   ---------
 
396
 
 
397
   function "-" (Left : Unsigned_Long; Right : Big_Integer)
 
398
      return Big_Integer
 
399
   is
 
400
   begin
 
401
      return Result : Big_Integer do
 
402
         mpz_add_ui (Result.Value'Access,
 
403
                     Right.Value'Access,
 
404
                     Left);
 
405
      end return;
 
406
   end "-";
 
407
 
 
408
   --------------
 
409
   -- Multiply --
 
410
   --------------
 
411
 
 
412
   procedure Multiply (This : in out Big_Integer;  By : Long) is
 
413
   begin
 
414
      mpz_mul_si (This.Value'Access, This.Value'Access, By);
 
415
   end Multiply;
 
416
 
 
417
   --------------
 
418
   -- Multiply --
 
419
   --------------
 
420
 
 
421
   procedure Multiply (This : in out Big_Integer;  By : Big_Integer) is
 
422
   begin
 
423
      mpz_mul (This.Value'Access, This.Value'Access, By.Value'Access);
 
424
   end Multiply;
 
425
 
 
426
   --------------
 
427
   -- Multiply --
 
428
   --------------
 
429
 
 
430
   procedure Multiply (Result : out Big_Integer;  Op1, Op2 : Big_Integer) is
 
431
   begin
 
432
      mpz_mul (Result.Value'Access, Op1.Value'Access, Op2.Value'Access);
 
433
   end Multiply;
 
434
 
 
435
   ---------
 
436
   -- "*" --
 
437
   ---------
 
438
 
 
439
   function "*" (Left, Right : Big_Integer)
 
440
      return Big_Integer
 
441
   is
 
442
   begin
 
443
      return Result : Big_Integer do
 
444
         mpz_mul (Result.Value'Access, Left.Value'Access, Right.Value'Access);
 
445
      end return;
 
446
   end "*";
 
447
 
 
448
   ---------
 
449
   -- "*" --
 
450
   ---------
 
451
 
 
452
   function "*" (Left : Long; Right : Big_Integer)
 
453
      return Big_Integer
 
454
   is
 
455
   begin
 
456
      return Result : Big_Integer do
 
457
         mpz_mul_si (Result.Value'Access, Right.Value'Access, Left);
 
458
      end return;
 
459
   end "*";
 
460
 
 
461
   ---------
 
462
   -- "*" --
 
463
   ---------
 
464
 
 
465
   function "*" (Left : Big_Integer;  Right : Long)
 
466
      return Big_Integer
 
467
   is
 
468
   begin
 
469
      return Result : Big_Integer do
 
470
         mpz_mul_si (Result.Value'Access, Left.Value'Access, Right);
 
471
      end return;
 
472
   end "*";
 
473
 
 
474
   ------------
 
475
   -- Divide --
 
476
   ------------
 
477
 
 
478
   procedure Divide (Q : in out Big_Integer;
 
479
                     N : Big_Integer;
 
480
                     D : Unsigned_Long)
 
481
   is
 
482
      Dummy : Long;
 
483
      pragma Unreferenced (Dummy);
 
484
   begin
 
485
      if D = 0 then
 
486
         raise Constraint_Error;
 
487
      end if;
 
488
      Dummy := mpz_tdiv_q_ui (Q.Value'Access, N.Value'Access, D);
 
489
   end Divide;
 
490
 
 
491
   ------------
 
492
   -- Divide --
 
493
   ------------
 
494
 
 
495
   procedure Divide (Q : in out Big_Integer;
 
496
                     N : Big_Integer;
 
497
                     D : Big_Integer)
 
498
   is
 
499
   begin
 
500
      if mpz_cmp_ui (D.Value'Access, 0) = 0 then
 
501
         raise Constraint_Error;
 
502
      end if;
 
503
      mpz_tdiv_q (Q.Value'Access, N.Value'Access, D.Value'Access);
 
504
   end Divide;
 
505
 
 
506
   ---------
 
507
   -- "/" --
 
508
   ---------
 
509
 
 
510
   function "/" (Left, Right : Big_Integer)
 
511
      return Big_Integer
 
512
   is
 
513
   begin
 
514
      if mpz_cmp_ui (Right.Value'Access, 0) = 0 then
 
515
         raise Constraint_Error;
 
516
      end if;
 
517
      return Result : Big_Integer do
 
518
         mpz_tdiv_q (Q => Result.Value'Access,
 
519
                     N => Left.Value'Access,
 
520
                     D => Right.Value'Access);
 
521
      end return;
 
522
   end "/";
 
523
 
 
524
   ---------
 
525
   -- "/" --
 
526
   ---------
 
527
 
 
528
   function "/" (Left : Big_Integer;  Right : Unsigned_Long)
 
529
      return Big_Integer
 
530
   is
 
531
      Dummy : Long;
 
532
      pragma Unreferenced (Dummy);
 
533
   begin
 
534
      if Right = 0 then
 
535
         raise Constraint_Error;
 
536
      end if;
 
537
      return Result : Big_Integer do
 
538
         Dummy := mpz_tdiv_q_ui (Q => Result.Value'Access,
 
539
                                 N => Left.Value'Access,
 
540
                                 D => Right);
 
541
      end return;
 
542
   end "/";
 
543
 
 
544
   -----------
 
545
   -- "rem" --
 
546
   -----------
 
547
 
 
548
   function "rem" (Left : Big_Integer;  Right : Big_Integer)
 
549
      return Big_Integer
 
550
   is
 
551
   begin
 
552
      if mpz_cmp_ui (Right.Value'Access, 0) = 0 then
 
553
         raise Constraint_Error;
 
554
      end if;
 
555
      return Result : Big_Integer do
 
556
         mpz_tdiv_r (R => Result.Value'Access,
 
557
                     N => Left.Value'Access,
 
558
                     D => Right.Value'Access);
 
559
         --  the result takes the sign of N, as required by the RM
 
560
      end return;
 
561
   end "rem";
 
562
 
 
563
   -----------
 
564
   -- "rem" --
 
565
   -----------
 
566
 
 
567
   function "rem" (Left : Big_Integer;  Right : Unsigned_Long)
 
568
      return Big_Integer
 
569
   is
 
570
      Dummy : Long;
 
571
      pragma Unreferenced (Dummy);
 
572
   begin
 
573
      if Right = 0 then
 
574
         raise Constraint_Error;
 
575
      end if;
 
576
      return Result : Big_Integer do
 
577
         Dummy := mpz_tdiv_r_ui (R => Result.Value'Access,
 
578
                                 N => Left.Value'Access,
 
579
                                 D => Right);
 
580
         --  the result is always non-negative so we have to set the sign to
 
581
         --  that of Left
 
582
         if Sign (Left) /= Sign (Result) then
 
583
            Negate (Result);
 
584
         end if;
 
585
      end return;
 
586
   end "rem";
 
587
 
 
588
   -------------
 
589
   -- Get_Rem --
 
590
   -------------
 
591
 
 
592
   procedure Get_Rem (Result : out Big_Integer;  N, D : Big_Integer) is
 
593
   begin
 
594
      if mpz_cmp_ui (D.Value'Access, 0) = 0 then
 
595
         raise Constraint_Error;
 
596
      end if;
 
597
      mpz_tdiv_r (Result.Value'Access, N.Value'Access, D.Value'Access);
 
598
      --  the result takes the sign of N, as required by the RM
 
599
   end Get_Rem;
 
600
 
 
601
   ---------
 
602
   -- "-" --
 
603
   ---------
 
604
 
 
605
   function "-" (Left : Big_Integer)
 
606
      return Big_Integer
 
607
   is
 
608
   begin
 
609
      return Result : Big_Integer do
 
610
         mpz_neg (Result.Value'Access, Left.Value'Access);
 
611
      end return;
 
612
   end "-";
 
613
 
 
614
   ------------
 
615
   -- Negate --
 
616
   ------------
 
617
 
 
618
   procedure Negate (This : in out Big_Integer) is
 
619
   begin
 
620
      mpz_neg (This.Value'Access, This.Value'Access);
 
621
   end Negate;
 
622
 
 
623
   ----------
 
624
   -- "**" --
 
625
   ----------
 
626
 
 
627
   function "**"(Left : Big_Integer; Right : Unsigned_Long)
 
628
      return Big_Integer
 
629
   is
 
630
   begin
 
631
      return Result : Big_Integer do
 
632
         mpz_pow_ui (Result.Value'Access, Left.Value'Access, Right);
 
633
      end return;
 
634
   end "**";
 
635
 
 
636
   ----------------
 
637
   -- Raise_To_N --
 
638
   ----------------
 
639
 
 
640
   procedure Raise_To_N (This : in out Big_Integer; N : Unsigned_Long) is
 
641
   begin
 
642
      mpz_pow_ui (This.Value'Access, This.Value'Access, N);
 
643
   end Raise_To_N;
 
644
 
 
645
   -----------
 
646
   -- "abs" --
 
647
   -----------
 
648
 
 
649
   function "abs" (Left : Big_Integer)
 
650
      return Big_Integer
 
651
   is
 
652
   begin
 
653
      return Result : Big_Integer do
 
654
         mpz_abs (Result.Value'Access, Left.Value'Access);
 
655
      end return;
 
656
   end "abs";
 
657
 
 
658
   -------------
 
659
   -- Get_Abs --
 
660
   -------------
 
661
 
 
662
   procedure Get_Abs (Result : out Big_Integer;  From : Big_Integer) is
 
663
   begin
 
664
      mpz_abs (Result.Value'Access, From.Value'Access);
 
665
   end Get_Abs;
 
666
 
 
667
   -----------
 
668
   -- "mod" --
 
669
   -----------
 
670
 
 
671
   function "mod" (Left : Big_Integer;  Right : Big_Integer)
 
672
     return Big_Integer
 
673
   is
 
674
   begin
 
675
      if mpz_cmp_ui (Right.Value'Access, 0) = 0 then
 
676
         raise Constraint_Error;
 
677
      end if;
 
678
      return Result : Big_Integer do
 
679
         Get_Mod (Result, Left, Right);
 
680
      end return;
 
681
   end "mod";
 
682
 
 
683
   -----------
 
684
   -- "mod" --
 
685
   -----------
 
686
 
 
687
   function "mod" (Left : Big_Integer;  Right : Long)
 
688
      return Big_Integer
 
689
   is
 
690
   begin
 
691
      if Right = 0 then
 
692
         raise Constraint_Error;
 
693
      end if;
 
694
      return Result : Big_Integer do
 
695
         declare
 
696
            Temp_Right : Big_Integer;
 
697
         begin
 
698
            Set (Temp_Right, To => Right);
 
699
            Get_Mod (Result, Left, Temp_Right);
 
700
         end;
 
701
      end return;
 
702
   end "mod";
 
703
 
 
704
   -------------
 
705
   -- Get_Mod --
 
706
   -------------
 
707
 
 
708
   procedure Get_Mod (Result : out Big_Integer;  N, D : Big_Integer) is
 
709
   begin
 
710
      if mpz_cmp_ui (D.Value'Access, 0) = 0 then
 
711
         raise Constraint_Error;
 
712
      end if;
 
713
      if Sign (N) /= -1 and Sign (D) /= -1 then  -- neither is negative
 
714
         mpz_mod (Result.Value'Access, N.Value'Access, D.Value'Access);
 
715
      else
 
716
         --  The GMP library provides operators defined by C semantics, but the
 
717
         --  semantics of Ada's mod operator are not the same as C's when
 
718
         --  negative values are involved. We do the following to implement the
 
719
         --  required Ada semantics.
 
720
         declare
 
721
            Temp_Left   : Big_Integer;
 
722
            Temp_Right  : Big_Integer;
 
723
            Temp_Result : Big_Integer;
 
724
         begin
 
725
            Set (Temp_Left,  To => N);
 
726
            Set (Temp_Right, To => D);
 
727
 
 
728
            if Sign (N) = -1 then -- N is negative
 
729
               Negate (Temp_Left);
 
730
            end if;
 
731
            if Sign (D) = -1 then  -- D is negative
 
732
               Negate (Temp_Right);
 
733
            end if;
 
734
            --  now both Temp_Left and Temp_Right are nonnegative
 
735
 
 
736
            mpz_mod (Temp_Result.Value'Access,
 
737
                     Temp_Left.Value'Access,
 
738
                     Temp_Right.Value'Access);
 
739
 
 
740
            if mpz_cmp_ui (Temp_Result.Value'Access, 0) = 0 then
 
741
               --  if Temp_Result is zero we are done
 
742
               Set (Result, To => Temp_Result);
 
743
            else
 
744
               if Sign (N) = -1 then -- N is negative
 
745
                  if Sign (D) = -1 then -- D is negative too
 
746
                     Set (Result, To => Temp_Result);
 
747
                     Negate (Result);
 
748
                  else -- N is negative but D is not
 
749
                     Set (Result, Temp_Right - Temp_Result);
 
750
                  end if;
 
751
               else  -- N is not negative
 
752
                  if Sign (D) = -1 then  -- D is negative
 
753
                     --  Set (Result, Temp_Result - Temp_Right);
 
754
                     mpz_sub (Result.Value'Access,
 
755
                              Temp_Result.Value'Access,
 
756
                              Temp_Right.Value'Access);
 
757
                  else -- neither is negative
 
758
                     Set (Result, To => Temp_Result);
 
759
                  end if;
 
760
               end if;
 
761
            end if;
 
762
         end;
 
763
      end if;
 
764
   end Get_Mod;
 
765
 
 
766
   -----------
 
767
   -- Image --
 
768
   -----------
 
769
 
 
770
   function Image (This : Big_Integer;  Base : Positive := 10) return String is
 
771
      use Interfaces.C, Interfaces.C.Strings;
 
772
 
 
773
      Number_Digits : constant size_t := mpz_sizeinbase
 
774
         (This.Value'Access, Int (Base));
 
775
 
 
776
      Buffer : String (1 .. Integer (Number_Digits) + 2);
 
777
      --  The correct number to allocate is 2 more than Number_Digits in order
 
778
      --  to handle a possible minus sign and the null-terminator.
 
779
 
 
780
      Result : chars_ptr;
 
781
   begin
 
782
      Result := mpz_get_str (Buffer'Address, Int (Base), This.Value'Access);
 
783
      return Value (Result);
 
784
   end Image;
 
785
 
 
786
   --------------
 
787
   -- As_mpz_t --
 
788
   --------------
 
789
 
 
790
   function As_mpz_t (This : Big_Integer)
 
791
      return access constant GNATCOLL.GMP.Lib.mpz_t
 
792
   is
 
793
   begin
 
794
      return This.Value'Unchecked_Access;
 
795
   end As_mpz_t;
 
796
 
 
797
   ----------
 
798
   -- Sign --
 
799
   ----------
 
800
 
 
801
   function Sign (This : Big_Integer)
 
802
      return Integer
 
803
   is
 
804
   begin
 
805
      return Integer (mpz_sgn (This.Value'Access));
 
806
   end Sign;
 
807
 
 
808
end GNATCOLL.GMP.Integers;