+2019-12-18 Arnaud Charlet <charlet@adacore.com>
+
+ * libgnat/a-nbnbin.ads, libgnat/a-nbnbin.adb,
+ libgnat/a-nbnbre.ads, libgnat/a-nbnbre.adb: Replace
+ Optional_Big_* types by a simple check and exception raise in
+ Get_Bignum.
+ (Set_Bignum): Arg should be 'out' and not 'in out'.
+ (Invalid_Big_Integer, No_Big_Real): Removed.
+ (Is_Valid): Now convention Intrinsic.
+
2019-12-18 Piotr Trojanek <trojanek@adacore.com>
* doc/gnat_rm/implementation_defined_pragmas.rst,
procedure Free is new Ada.Unchecked_Deallocation (Bignum_Data, Bignum);
- function Get_Bignum (Arg : Optional_Big_Integer) return Bignum is
- (To_Bignum (Arg.Value.C));
- -- Return the Bignum value stored in Arg
-
- procedure Set_Bignum (Arg : in out Optional_Big_Integer; Value : Bignum)
+ function Get_Bignum (Arg : Big_Integer) return Bignum is
+ (if Arg.Value.C = System.Null_Address
+ then raise Constraint_Error with "invalid big integer"
+ else To_Bignum (Arg.Value.C));
+ -- Check for validity of Arg and return the Bignum value stored in Arg.
+ -- Raise Constraint_Error if Arg is uninitialized.
+
+ procedure Set_Bignum (Arg : out Big_Integer; Value : Bignum)
with Inline;
-- Set the Bignum value stored in Arg to Value
-- Set_Bignum --
----------------
- procedure Set_Bignum (Arg : in out Optional_Big_Integer; Value : Bignum) is
+ procedure Set_Bignum (Arg : out Big_Integer; Value : Bignum) is
begin
Arg.Value.C := To_Address (Value);
end Set_Bignum;
-- Is_Valid --
--------------
- function Is_Valid (Arg : Optional_Big_Integer) return Boolean is
+ function Is_Valid (Arg : Big_Integer) return Boolean is
(Arg.Value.C /= System.Null_Address);
- --------------------------
- -- Invalid_Big_Integer --
- --------------------------
-
- function Invalid_Big_Integer return Optional_Big_Integer is
- (Value => (Ada.Finalization.Controlled with C => System.Null_Address));
-
---------
-- "=" --
---------
--------------------
function To_Big_Integer (Arg : Integer) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, To_Bignum (Long_Long_Integer (Arg)));
return Result;
--------------------
function To_Big_Integer (Arg : Int) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, To_Bignum (Long_Long_Integer (Arg)));
return Result;
--------------------
function To_Big_Integer (Arg : Int) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, To_Bignum (Unsigned_64 (Arg)));
return Result;
-----------------
function From_String (Arg : String) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
-- ??? only support Long_Long_Integer, good enough for now
Set_Bignum (Result, To_Bignum (Long_Long_Integer'Value (Arg)));
---------
function "+" (L : Big_Integer) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, new Bignum_Data'(Get_Bignum (L).all));
return Result;
---------
function "-" (L : Big_Integer) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, Big_Neg (Get_Bignum (L)));
return Result;
-----------
function "abs" (L : Big_Integer) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, Big_Abs (Get_Bignum (L)));
return Result;
---------
function "+" (L, R : Big_Integer) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, Big_Add (Get_Bignum (L), Get_Bignum (R)));
return Result;
---------
function "-" (L, R : Big_Integer) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, Big_Sub (Get_Bignum (L), Get_Bignum (R)));
return Result;
---------
function "*" (L, R : Big_Integer) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, Big_Mul (Get_Bignum (L), Get_Bignum (R)));
return Result;
---------
function "/" (L, R : Big_Integer) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, Big_Div (Get_Bignum (L), Get_Bignum (R)));
return Result;
-----------
function "mod" (L, R : Big_Integer) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, Big_Mod (Get_Bignum (L), Get_Bignum (R)));
return Result;
-----------
function "rem" (L, R : Big_Integer) return Big_Integer is
- Result : Optional_Big_Integer;
+ Result : Big_Integer;
begin
Set_Bignum (Result, Big_Rem (Get_Bignum (L), Get_Bignum (R)));
return Result;
----------
function "**" (L : Big_Integer; R : Natural) return Big_Integer is
- Exp : Bignum := To_Bignum (Long_Long_Integer (R));
- Result : Optional_Big_Integer;
begin
- Set_Bignum (Result, Big_Exp (Get_Bignum (L), Exp));
- Free (Exp);
- return Result;
+ -- Explicitly check for validity before allocating Exp so that
+ -- the call to Get_Bignum below cannot raise an exception before
+ -- we get a chance to free Exp.
+
+ if not Is_Valid (L) then
+ raise Constraint_Error with "invalid big integer";
+ end if;
+
+ declare
+ Exp : Bignum := To_Bignum (Long_Long_Integer (R));
+ Result : Big_Integer;
+ begin
+ Set_Bignum (Result, Big_Exp (Get_Bignum (L), Exp));
+ Free (Exp);
+ return Result;
+ end;
end "**";
---------
with Preelaborate
-- Nonblocking
is
- type Optional_Big_Integer is private
- with Default_Initial_Condition => not Is_Valid (Optional_Big_Integer);
- -- Integer_Literal => From_String,
+ type Big_Integer is private;
+ -- with Integer_Literal => From_String,
-- Put_Image => Put_Image;
- function Is_Valid (Arg : Optional_Big_Integer) return Boolean;
-
- subtype Big_Integer is Optional_Big_Integer
- with Dynamic_Predicate => Is_Valid (Big_Integer),
- Predicate_Failure => (raise Constraint_Error);
-
- function Invalid_Big_Integer return Optional_Big_Integer
- with Post => not Is_Valid (Invalid_Big_Integer'Result);
+ function Is_Valid (Arg : Big_Integer) return Boolean
+ with Convention => Intrinsic;
function "=" (L, R : Big_Integer) return Boolean;
function To_Big_Integer (Arg : Integer) return Big_Integer;
- subtype Optional_Big_Positive is Optional_Big_Integer
- with Dynamic_Predicate =>
- (not Is_Valid (Optional_Big_Positive))
- or else (Optional_Big_Positive > To_Big_Integer (0)),
- Predicate_Failure => (raise Constraint_Error);
-
- subtype Optional_Big_Natural is Optional_Big_Integer
- with Dynamic_Predicate =>
- (not Is_Valid (Optional_Big_Natural))
- or else (Optional_Big_Natural >= To_Big_Integer (0)),
- Predicate_Failure => (raise Constraint_Error);
-
subtype Big_Positive is Big_Integer
with Dynamic_Predicate => Big_Positive > To_Big_Integer (0),
Predicate_Failure => (raise Constraint_Error);
procedure Adjust (This : in out Controlled_Bignum);
procedure Finalize (This : in out Controlled_Bignum);
- type Optional_Big_Integer is record
+ type Big_Integer is record
Value : Controlled_Bignum;
end record;
-- Is_Valid --
--------------
- function Is_Valid (Arg : Optional_Big_Real) return Boolean is
+ function Is_Valid (Arg : Big_Real) return Boolean is
(Is_Valid (Arg.Num) and then Is_Valid (Arg.Den));
- -----------------
- -- No_Big_Real --
- -----------------
-
- function No_Big_Real return Optional_Big_Real is
- (Num => Invalid_Big_Integer, Den => Invalid_Big_Integer);
-
---------
-- "/" --
---------
function "/" (Num, Den : Big_Integer) return Big_Real is
- Result : Optional_Big_Real;
+ Result : Big_Real;
begin
if Den = To_Big_Integer (0) then
raise Constraint_Error with "divide by zero";
function From_String (Arg : String) return Big_Real is
Ten : constant Big_Integer := To_Big_Integer (10);
- Frac : Optional_Big_Integer;
+ Frac : Big_Integer;
Exp : Integer := 0;
Pow : Natural := 0;
Index : Natural := 0;
end if;
declare
- Result : Optional_Big_Real;
+ Result : Big_Real;
begin
Result.Den := Ten ** Pow;
Result.Num := From_String (Arg (Arg'First .. Index)) * Result.Den;
---------
function "+" (L : Big_Real) return Big_Real is
- Result : Optional_Big_Real;
+ Result : Big_Real;
begin
Result.Num := L.Num;
Result.Den := L.Den;
---------
function "+" (L, R : Big_Real) return Big_Real is
- Result : Optional_Big_Real;
+ Result : Big_Real;
begin
Result.Num := L.Num * R.Den + R.Num * L.Den;
Result.Den := L.Den * R.Den;
---------
function "-" (L, R : Big_Real) return Big_Real is
- Result : Optional_Big_Real;
+ Result : Big_Real;
begin
Result.Num := L.Num * R.Den - R.Num * L.Den;
Result.Den := L.Den * R.Den;
---------
function "*" (L, R : Big_Real) return Big_Real is
- Result : Optional_Big_Real;
+ Result : Big_Real;
begin
Result.Num := L.Num * R.Num;
Result.Den := L.Den * R.Den;
---------
function "/" (L, R : Big_Real) return Big_Real is
- Result : Optional_Big_Real;
+ Result : Big_Real;
begin
Result.Num := L.Num * R.Den;
Result.Den := L.Den * R.Num;
----------
function "**" (L : Big_Real; R : Integer) return Big_Real is
- Result : Optional_Big_Real;
+ Result : Big_Real;
begin
if R = 0 then
Result.Num := To_Big_Integer (1);
with Preelaborate
-- Nonblocking, Global => in out synchronized Big_Reals
is
- type Optional_Big_Real is private with
- Default_Initial_Condition => not Is_Valid (Optional_Big_Real);
--- Real_Literal => From_String,
--- Put_Image => Put_Image;
+ type Big_Real is private;
+-- with Real_Literal => From_String,
+-- Put_Image => Put_Image;
- function Is_Valid (Arg : Optional_Big_Real) return Boolean;
-
- function No_Big_Real return Optional_Big_Real
- with Post => not Is_Valid (No_Big_Real'Result);
-
- subtype Big_Real is Optional_Big_Real
- with Dynamic_Predicate => Is_Valid (Big_Real),
- Predicate_Failure => (raise Constraint_Error);
+ function Is_Valid (Arg : Big_Real) return Boolean;
function "/" (Num, Den : Big_Integers.Big_Integer) return Big_Real;
-- with Pre => (if Big_Integers."=" (Den, Big_Integers.To_Big_Integer (0))
private
- type Optional_Big_Real is record
- Num, Den : Big_Integers.Optional_Big_Integer;
+ type Big_Real is record
+ Num, Den : Big_Integers.Big_Integer;
end record;
end Ada.Numerics.Big_Numbers.Big_Reals;
projects / gcc.git / commitdiff