gcc/ada/libgnat/a-nbnbin__gmp.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --                  ADA.NUMERICS.BIG_NUMBERS.BIG_INTEGERS                   --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --             Copyright (C) 2019-2023, Free Software Foundation, Inc.      --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 --  This is the GMP version of this package
  33
  34 with Ada.Unchecked_Conversion;
  35 with Ada.Unchecked_Deallocation;
  36 with Interfaces.C;               use Interfaces.C;
  37 with Interfaces.C.Strings;       use Interfaces.C.Strings;
  38 with Ada.Characters.Handling;    use Ada.Characters.Handling;
  39
  40 package body Ada.Numerics.Big_Numbers.Big_Integers is
  41
  42    use System;
  43
  44    pragma Linker_Options ("-lgmp");
  45
  46    type mpz_t is record
  47       mp_alloc : Integer;
  48       mp_size  : Integer;
  49       mp_d     : System.Address;
  50    end record;
  51    pragma Convention (C, mpz_t);
  52    type mpz_t_ptr is access all mpz_t;
  53
  54    function To_Mpz is new Ada.Unchecked_Conversion (System.Address, mpz_t_ptr);
  55    function To_Address is new
  56      Ada.Unchecked_Conversion (mpz_t_ptr, System.Address);
  57
  58    function Get_Mpz (Arg : Big_Integer) return mpz_t_ptr is
  59      (To_Mpz (Arg.Value.C));
  60    --  Return the mpz_t value stored in Arg
  61
  62    procedure Set_Mpz (Arg : in out Big_Integer; Value : mpz_t_ptr)
  63      with Inline;
  64    --  Set the mpz_t value stored in Arg to Value
  65
  66    procedure Allocate (This : in out Big_Integer) with Inline;
  67    --  Allocate a Big_Integer, including the underlying mpz
  68
  69    procedure mpz_init_set (ROP : access mpz_t;  OP : access constant mpz_t);
  70    pragma Import (C, mpz_init_set, "__gmpz_init_set");
  71
  72    procedure mpz_set (ROP : access mpz_t;  OP : access constant mpz_t);
  73    pragma Import (C, mpz_set, "__gmpz_set");
  74
  75    function mpz_cmp (OP1, OP2 : access constant mpz_t) return Integer;
  76    pragma Import (C, mpz_cmp, "__gmpz_cmp");
  77
  78    function mpz_cmp_ui
  79      (OP1 : access constant mpz_t; OP2 : unsigned_long) return Integer;
  80    pragma Import (C, mpz_cmp_ui, "__gmpz_cmp_ui");
  81
  82    procedure mpz_set_si (ROP : access mpz_t; OP : long);
  83    pragma Import (C, mpz_set_si, "__gmpz_set_si");
  84
  85    procedure mpz_set_ui (ROP : access mpz_t; OP : unsigned_long);
  86    pragma Import (C, mpz_set_ui, "__gmpz_set_ui");
  87
  88    function mpz_get_si (OP : access constant mpz_t) return long;
  89    pragma Import (C, mpz_get_si, "__gmpz_get_si");
  90
  91    function mpz_get_ui (OP : access constant mpz_t) return unsigned_long;
  92    pragma Import (C, mpz_get_ui, "__gmpz_get_ui");
  93
  94    procedure mpz_neg (ROP : access mpz_t;  OP : access constant mpz_t);
  95    pragma Import (C, mpz_neg, "__gmpz_neg");
  96
  97    procedure mpz_sub (ROP : access mpz_t;  OP1, OP2 : access constant mpz_t);
  98    pragma Import (C, mpz_sub, "__gmpz_sub");
  99
 100    -------------
 101    -- Set_Mpz --
 102    -------------
 103
 104    procedure Set_Mpz (Arg : in out Big_Integer; Value : mpz_t_ptr) is
 105    begin
 106       Arg.Value.C := To_Address (Value);
 107    end Set_Mpz;
 108
 109    --------------
 110    -- Is_Valid --
 111    --------------
 112
 113    function Is_Valid (Arg : Big_Integer) return Boolean is
 114      (Arg.Value.C /= System.Null_Address);
 115
 116    ---------
 117    -- "=" --
 118    ---------
 119
 120    function "=" (L, R : Valid_Big_Integer) return Boolean is
 121    begin
 122       return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) = 0;
 123    end "=";
 124
 125    ---------
 126    -- "<" --
 127    ---------
 128
 129    function "<" (L, R : Valid_Big_Integer) return Boolean is
 130    begin
 131       return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) < 0;
 132    end "<";
 133
 134    ----------
 135    -- "<=" --
 136    ----------
 137
 138    function "<=" (L, R : Valid_Big_Integer) return Boolean is
 139    begin
 140       return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) <= 0;
 141    end "<=";
 142
 143    ---------
 144    -- ">" --
 145    ---------
 146
 147    function ">" (L, R : Valid_Big_Integer) return Boolean is
 148    begin
 149       return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) > 0;
 150    end ">";
 151
 152    ----------
 153    -- ">=" --
 154    ----------
 155
 156    function ">=" (L, R : Valid_Big_Integer) return Boolean is
 157    begin
 158       return mpz_cmp (Get_Mpz (L), Get_Mpz (R)) >= 0;
 159    end ">=";
 160
 161    --------------------
 162    -- To_Big_Integer --
 163    --------------------
 164
 165    function To_Big_Integer (Arg : Integer) return Valid_Big_Integer is
 166       Result : Big_Integer;
 167    begin
 168       Allocate (Result);
 169       mpz_set_si (Get_Mpz (Result), long (Arg));
 170       return Result;
 171    end To_Big_Integer;
 172
 173    ----------------
 174    -- To_Integer --
 175    ----------------
 176
 177    function To_Integer (Arg : Valid_Big_Integer) return Integer is
 178    begin
 179       return Integer (mpz_get_si (Get_Mpz (Arg)));
 180    end To_Integer;
 181
 182    ------------------------
 183    -- Signed_Conversions --
 184    ------------------------
 185
 186    package body Signed_Conversions is
 187
 188       --------------------
 189       -- To_Big_Integer --
 190       --------------------
 191
 192       function To_Big_Integer (Arg : Int) return Valid_Big_Integer is
 193          Result : Big_Integer;
 194       begin
 195          Allocate (Result);
 196          mpz_set_si (Get_Mpz (Result), long (Arg));
 197          return Result;
 198       end To_Big_Integer;
 199
 200       ----------------------
 201       -- From_Big_Integer --
 202       ----------------------
 203
 204       function From_Big_Integer (Arg : Valid_Big_Integer) return Int is
 205       begin
 206          return Int (mpz_get_si (Get_Mpz (Arg)));
 207       end From_Big_Integer;
 208
 209    end Signed_Conversions;
 210
 211    --------------------------
 212    -- Unsigned_Conversions --
 213    --------------------------
 214
 215    package body Unsigned_Conversions is
 216
 217       --------------------
 218       -- To_Big_Integer --
 219       --------------------
 220
 221       function To_Big_Integer (Arg : Int) return Valid_Big_Integer is
 222          Result : Big_Integer;
 223       begin
 224          Allocate (Result);
 225          mpz_set_ui (Get_Mpz (Result), unsigned_long (Arg));
 226          return Result;
 227       end To_Big_Integer;
 228
 229       ----------------------
 230       -- From_Big_Integer --
 231       ----------------------
 232
 233       function From_Big_Integer (Arg : Valid_Big_Integer) return Int is
 234       begin
 235          return Int (mpz_get_ui (Get_Mpz (Arg)));
 236       end From_Big_Integer;
 237
 238    end Unsigned_Conversions;
 239
 240    ---------------
 241    -- To_String --
 242    ---------------
 243
 244    function To_String
 245      (Arg : Valid_Big_Integer; Width : Field := 0; Base : Number_Base := 10)
 246       return String
 247    is
 248       function mpz_get_str
 249         (STR  : System.Address;
 250          BASE : Integer;
 251          OP   : access constant mpz_t) return chars_ptr;
 252       pragma Import (C, mpz_get_str, "__gmpz_get_str");
 253
 254       function mpz_sizeinbase
 255          (this : access constant mpz_t; base : Integer) return size_t;
 256       pragma Import (C, mpz_sizeinbase, "__gmpz_sizeinbase");
 257
 258       function Add_Base (S : String) return String;
 259       --  Add base information if Base /= 10
 260
 261       function Leading_Padding
 262         (Str        : String;
 263          Min_Length : Field;
 264          Char       : Character := ' ') return String;
 265       --  Return padding of Char concatenated with Str so that the resulting
 266       --  string is at least Min_Length long.
 267
 268       function Image (N : Natural) return String;
 269       --  Return image of N, with no leading space.
 270
 271       --------------
 272       -- Add_Base --
 273       --------------
 274
 275       function Add_Base (S : String) return String is
 276       begin
 277          if Base = 10 then
 278             return S;
 279          else
 280             return Image (Base) & "#" & To_Upper (S) & "#";
 281          end if;
 282       end Add_Base;
 283
 284       -----------
 285       -- Image --
 286       -----------
 287
 288       function Image (N : Natural) return String is
 289          S : constant String := Natural'Image (N);
 290       begin
 291          return S (2 .. S'Last);
 292       end Image;
 293
 294       ---------------------
 295       -- Leading_Padding --
 296       ---------------------
 297
 298       function Leading_Padding
 299         (Str        : String;
 300          Min_Length : Field;
 301          Char       : Character := ' ') return String is
 302       begin
 303          return (1 .. Integer'Max (Integer (Min_Length) - Str'Length, 0)
 304                         => Char) & Str;
 305       end Leading_Padding;
 306
 307       Number_Digits : constant Integer :=
 308         Integer (mpz_sizeinbase (Get_Mpz (Arg), Integer (abs Base)));
 309
 310       Buffer : aliased String (1 .. Number_Digits + 2);
 311       --  The correct number to allocate is 2 more than Number_Digits in order
 312       --  to handle a possible minus sign and the null-terminator.
 313
 314       Result : constant chars_ptr :=
 315         mpz_get_str (Buffer'Address, Integer (Base), Get_Mpz (Arg));
 316       S      : constant String := Value (Result);
 317
 318    begin
 319       if S (1) = '-' then
 320          return Leading_Padding ("-" & Add_Base (S (2 .. S'Last)), Width);
 321       else
 322          return Leading_Padding (" " & Add_Base (S), Width);
 323       end if;
 324    end To_String;
 325
 326    -----------------
 327    -- From_String --
 328    -----------------
 329
 330    function From_String (Arg : String) return Valid_Big_Integer is
 331       function mpz_set_str
 332         (this : access mpz_t;
 333          str  : System.Address;
 334          base : Integer := 10) return Integer;
 335       pragma Import (C, mpz_set_str, "__gmpz_set_str");
 336
 337       Result : Big_Integer;
 338       First  : Natural;
 339       Last   : Natural;
 340       Base   : Natural;
 341
 342    begin
 343       Allocate (Result);
 344
 345       if Arg (Arg'Last) /= '#' then
 346
 347          --  Base 10 number
 348
 349          First := Arg'First;
 350          Last  := Arg'Last;
 351          Base  := 10;
 352       else
 353          --  Compute the xx base in a xx#yyyyy# number
 354
 355          if Arg'Length < 4 then
 356             raise Constraint_Error;
 357          end if;
 358
 359          First := 0;
 360          Last  := Arg'Last - 1;
 361
 362          for J in Arg'First + 1 .. Last loop
 363             if Arg (J) = '#' then
 364                First := J;
 365                exit;
 366             end if;
 367          end loop;
 368
 369          if First = 0 then
 370             raise Constraint_Error;
 371          end if;
 372
 373          Base  := Natural'Value (Arg (Arg'First .. First - 1));
 374          First := First + 1;
 375       end if;
 376
 377       declare
 378          Str   : aliased String (1 .. Last - First + 2);
 379          Index : Natural := 0;
 380       begin
 381          --  Strip underscores
 382
 383          for J in First .. Last loop
 384             if Arg (J) /= '_' then
 385                Index := Index + 1;
 386                Str (Index) := Arg (J);
 387             end if;
 388          end loop;
 389
 390          Index := Index + 1;
 391          Str (Index) := ASCII.NUL;
 392
 393          if mpz_set_str (Get_Mpz (Result), Str'Address, Base) /= 0 then
 394             raise Constraint_Error;
 395          end if;
 396       end;
 397
 398       return Result;
 399    end From_String;
 400
 401    ---------------
 402    -- Put_Image --
 403    ---------------
 404
 405    procedure Put_Image (S : in out Root_Buffer_Type'Class; V : Big_Integer) is
 406       --  This is implemented in terms of To_String. It might be more elegant
 407       --  and more efficient to do it the other way around, but this is the
 408       --  most expedient implementation for now.
 409    begin
 410       Strings.Text_Buffers.Put_UTF_8 (S, To_String (V));
 411    end Put_Image;
 412
 413    ---------
 414    -- "+" --
 415    ---------
 416
 417    function "+" (L : Valid_Big_Integer) return Valid_Big_Integer is
 418       Result : Big_Integer;
 419    begin
 420       Set_Mpz (Result, new mpz_t);
 421       mpz_init_set (Get_Mpz (Result), Get_Mpz (L));
 422       return Result;
 423    end "+";
 424
 425    ---------
 426    -- "-" --
 427    ---------
 428
 429    function "-" (L : Valid_Big_Integer) return Valid_Big_Integer is
 430       Result : Big_Integer;
 431    begin
 432       Allocate (Result);
 433       mpz_neg (Get_Mpz (Result), Get_Mpz (L));
 434       return Result;
 435    end "-";
 436
 437    -----------
 438    -- "abs" --
 439    -----------
 440
 441    function "abs" (L : Valid_Big_Integer) return Valid_Big_Integer is
 442       procedure mpz_abs (ROP : access mpz_t;  OP : access constant mpz_t);
 443       pragma Import (C, mpz_abs, "__gmpz_abs");
 444
 445       Result : Big_Integer;
 446    begin
 447       Allocate (Result);
 448       mpz_abs (Get_Mpz (Result), Get_Mpz (L));
 449       return Result;
 450    end "abs";
 451
 452    ---------
 453    -- "+" --
 454    ---------
 455
 456    function "+" (L, R : Valid_Big_Integer) return Valid_Big_Integer is
 457       procedure mpz_add
 458         (ROP : access mpz_t;  OP1, OP2 : access constant mpz_t);
 459       pragma Import (C, mpz_add, "__gmpz_add");
 460
 461       Result : Big_Integer;
 462
 463    begin
 464       Allocate (Result);
 465       mpz_add (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
 466       return Result;
 467    end "+";
 468
 469    ---------
 470    -- "-" --
 471    ---------
 472
 473    function "-" (L, R : Valid_Big_Integer) return Valid_Big_Integer is
 474       Result : Big_Integer;
 475    begin
 476       Allocate (Result);
 477       mpz_sub (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
 478       return Result;
 479    end "-";
 480
 481    ---------
 482    -- "*" --
 483    ---------
 484
 485    function "*" (L, R : Valid_Big_Integer) return Valid_Big_Integer is
 486       procedure mpz_mul
 487         (ROP : access mpz_t;  OP1, OP2 : access constant mpz_t);
 488       pragma Import (C, mpz_mul, "__gmpz_mul");
 489
 490       Result : Big_Integer;
 491
 492    begin
 493       Allocate (Result);
 494       mpz_mul (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
 495       return Result;
 496    end "*";
 497
 498    ---------
 499    -- "/" --
 500    ---------
 501
 502    function "/" (L, R : Valid_Big_Integer) return Valid_Big_Integer is
 503       procedure mpz_tdiv_q (Q : access mpz_t;  N, D : access constant mpz_t);
 504       pragma Import (C, mpz_tdiv_q, "__gmpz_tdiv_q");
 505    begin
 506       if mpz_cmp_ui (Get_Mpz (R), 0) = 0 then
 507          raise Constraint_Error;
 508       end if;
 509
 510       declare
 511          Result : Big_Integer;
 512       begin
 513          Allocate (Result);
 514          mpz_tdiv_q (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
 515          return Result;
 516       end;
 517    end "/";
 518
 519    -----------
 520    -- "mod" --
 521    -----------
 522
 523    function "mod" (L, R : Valid_Big_Integer) return Valid_Big_Integer is
 524       procedure mpz_mod (R : access mpz_t;  N, D : access constant mpz_t);
 525       pragma Import (C, mpz_mod, "__gmpz_mod");
 526       --  result is always non-negative
 527
 528       L_Negative, R_Negative : Boolean;
 529
 530    begin
 531       if mpz_cmp_ui (Get_Mpz (R), 0) = 0 then
 532          raise Constraint_Error;
 533       end if;
 534
 535       declare
 536          Result : Big_Integer;
 537       begin
 538          Allocate (Result);
 539          L_Negative := mpz_cmp_ui (Get_Mpz (L), 0) < 0;
 540          R_Negative := mpz_cmp_ui (Get_Mpz (R), 0) < 0;
 541
 542          if not (L_Negative or R_Negative) then
 543             mpz_mod (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
 544          else
 545             --  The GMP library provides operators defined by C semantics, but
 546             --  the semantics of Ada's mod operator are not the same as C's
 547             --  when negative values are involved. We do the following to
 548             --  implement the required Ada semantics.
 549
 550             declare
 551                Temp_Left   : Big_Integer;
 552                Temp_Right  : Big_Integer;
 553                Temp_Result : Big_Integer;
 554
 555             begin
 556                Allocate (Temp_Result);
 557                Set_Mpz (Temp_Left, new mpz_t);
 558                Set_Mpz (Temp_Right, new mpz_t);
 559                mpz_init_set (Get_Mpz (Temp_Left), Get_Mpz (L));
 560                mpz_init_set (Get_Mpz (Temp_Right), Get_Mpz (R));
 561
 562                if L_Negative then
 563                   mpz_neg (Get_Mpz (Temp_Left), Get_Mpz (Temp_Left));
 564                end if;
 565
 566                if R_Negative then
 567                   mpz_neg (Get_Mpz (Temp_Right), Get_Mpz (Temp_Right));
 568                end if;
 569
 570                --  now both Temp_Left and Temp_Right are nonnegative
 571
 572                mpz_mod (Get_Mpz (Temp_Result),
 573                         Get_Mpz (Temp_Left),
 574                         Get_Mpz (Temp_Right));
 575
 576                if mpz_cmp_ui (Get_Mpz (Temp_Result), 0) = 0 then
 577                   --  if Temp_Result is zero we are done
 578                   mpz_set (Get_Mpz (Result), Get_Mpz (Temp_Result));
 579
 580                elsif L_Negative then
 581                   if R_Negative then
 582                      mpz_neg (Get_Mpz (Result), Get_Mpz (Temp_Result));
 583                   else -- L is negative but R is not
 584                      mpz_sub (Get_Mpz (Result),
 585                               Get_Mpz (Temp_Right),
 586                               Get_Mpz (Temp_Result));
 587                   end if;
 588                else
 589                   pragma Assert (R_Negative);
 590                   mpz_sub (Get_Mpz (Result),
 591                            Get_Mpz (Temp_Result),
 592                            Get_Mpz (Temp_Right));
 593                end if;
 594             end;
 595          end if;
 596
 597          return Result;
 598       end;
 599    end "mod";
 600
 601    -----------
 602    -- "rem" --
 603    -----------
 604
 605    function "rem" (L, R : Valid_Big_Integer) return Valid_Big_Integer is
 606       procedure mpz_tdiv_r (R : access mpz_t;  N, D : access constant mpz_t);
 607       pragma Import (C, mpz_tdiv_r, "__gmpz_tdiv_r");
 608       --   R will have the same sign as N.
 609
 610    begin
 611       if mpz_cmp_ui (Get_Mpz (R), 0) = 0 then
 612          raise Constraint_Error;
 613       end if;
 614
 615       declare
 616          Result : Big_Integer;
 617       begin
 618          Allocate (Result);
 619          mpz_tdiv_r (R => Get_Mpz (Result),
 620                      N => Get_Mpz (L),
 621                      D => Get_Mpz (R));
 622          --  the result takes the sign of N, as required by the RM
 623
 624          return Result;
 625       end;
 626    end "rem";
 627
 628    ----------
 629    -- "**" --
 630    ----------
 631
 632    function "**"
 633      (L : Valid_Big_Integer; R : Natural) return Valid_Big_Integer
 634    is
 635       procedure mpz_pow_ui (ROP : access mpz_t;
 636                             BASE : access constant mpz_t;
 637                             EXP : unsigned_long);
 638       pragma Import (C, mpz_pow_ui, "__gmpz_pow_ui");
 639
 640       Result : Big_Integer;
 641
 642    begin
 643       Allocate (Result);
 644       mpz_pow_ui (Get_Mpz (Result), Get_Mpz (L), unsigned_long (R));
 645       return Result;
 646    end "**";
 647
 648    ---------
 649    -- Min --
 650    ---------
 651
 652    function Min (L, R : Valid_Big_Integer) return Valid_Big_Integer is
 653      (if L < R then L else R);
 654
 655    ---------
 656    -- Max --
 657    ---------
 658
 659    function Max (L, R : Valid_Big_Integer) return Valid_Big_Integer is
 660      (if L > R then L else R);
 661
 662    -----------------------------
 663    -- Greatest_Common_Divisor --
 664    -----------------------------
 665
 666    function Greatest_Common_Divisor
 667      (L, R : Valid_Big_Integer) return Big_Positive
 668    is
 669       procedure mpz_gcd
 670         (ROP : access mpz_t;  Op1, Op2 : access constant mpz_t);
 671       pragma Import (C, mpz_gcd, "__gmpz_gcd");
 672
 673       Result : Big_Integer;
 674
 675    begin
 676       Allocate (Result);
 677       mpz_gcd (Get_Mpz (Result), Get_Mpz (L), Get_Mpz (R));
 678       return Result;
 679    end Greatest_Common_Divisor;
 680
 681    --------------
 682    -- Allocate --
 683    --------------
 684
 685    procedure Allocate (This : in out Big_Integer) is
 686       procedure mpz_init (this : access mpz_t);
 687       pragma Import (C, mpz_init, "__gmpz_init");
 688    begin
 689       Set_Mpz (This, new mpz_t);
 690       mpz_init (Get_Mpz (This));
 691    end Allocate;
 692
 693    ------------
 694    -- Adjust --
 695    ------------
 696
 697    procedure Adjust (This : in out Controlled_Bignum) is
 698       Value : constant mpz_t_ptr := To_Mpz (This.C);
 699    begin
 700       if Value /= null then
 701          This.C := To_Address (new mpz_t);
 702          mpz_init_set (To_Mpz (This.C), Value);
 703       end if;
 704    end Adjust;
 705
 706    --------------
 707    -- Finalize --
 708    --------------
 709
 710    procedure Finalize (This : in out Controlled_Bignum) is
 711       procedure Free is new Ada.Unchecked_Deallocation (mpz_t, mpz_t_ptr);
 712
 713       procedure mpz_clear (this : access mpz_t);
 714       pragma Import (C, mpz_clear, "__gmpz_clear");
 715
 716       Mpz : mpz_t_ptr;
 717
 718    begin
 719       if This.C /= System.Null_Address then
 720          Mpz := To_Mpz (This.C);
 721          mpz_clear (Mpz);
 722          Free (Mpz);
 723          This.C := System.Null_Address;
 724       end if;
 725    end Finalize;
 726
 727 end Ada.Numerics.Big_Numbers.Big_Integers;