s-gearop.ads (Forward_Eliminate): Add "abs" formal function returning a Real.
authorGeert Bosch <bosch@adacore.com>
Thu, 13 Oct 2011 10:52:59 +0000 (10:52 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Thu, 13 Oct 2011 10:52:59 +0000 (12:52 +0200)
2011-10-13  Geert Bosch  <bosch@adacore.com>

* s-gearop.ads (Forward_Eliminate): Add "abs" formal function
returning a Real.
* s-gearop.adb (Forward_Eliminate): Remove local "abs" function
and use formal.
* a-ngrear.adb (Forward_Eliminate): Adjust instantiation for
new profile.

From-SVN: r179910

gcc/ada/ChangeLog
gcc/ada/a-ngrear.adb
gcc/ada/s-gearop.adb
gcc/ada/s-gearop.ads

index 24fd5821f83d01d6315cd7f8e2bd27dc57001fad..cd443afa1406d020577446575f27a79870387a2f 100644 (file)
@@ -1,3 +1,12 @@
+2011-10-13  Geert Bosch  <bosch@adacore.com>
+
+       * s-gearop.ads (Forward_Eliminate): Add "abs" formal function
+       returning a Real.
+       * s-gearop.adb (Forward_Eliminate): Remove local "abs" function
+       and use formal.
+       * a-ngrear.adb (Forward_Eliminate): Adjust instantiation for
+       new profile.
+
 2011-10-13  Geert Bosch  <bosch@adacore.com>
 
        * a-ngrear.adb, s-gearop.adb, s-gearop.ads (Sqrt): Make generic and
index 85c949eebb90e65f6656bf7e957dc09d1983e93b..c5ed66a3f7db5511ff0d3bc6a109815fbc4d3316 100644 (file)
@@ -33,7 +33,7 @@
 --  reason for this is new Ada 2012 requirements that prohibit algorithms such
 --  as Strassen's algorithm, which may be used by some BLAS implementations. In
 --  addition, some platforms lacked suitable compilers to compile the reference
---  BLAS/LAPACK implementation. Finally, on many platforms there may be more
+--  BLAS/LAPACK implementation. Finally, on some platforms there are be more
 --  floating point types than supported by BLAS/LAPACK.
 
 with Ada.Containers.Generic_Anonymous_Array_Sort; use Ada.Containers;
@@ -59,6 +59,7 @@ package body Ada.Numerics.Generic_Real_Arrays is
 
    procedure Forward_Eliminate is new Ops.Forward_Eliminate
     (Scalar        => Real'Base,
+     Real          => Real'Base,
      Matrix        => Real_Matrix,
      Zero          => 0.0,
      One           => 1.0);
index 1380cd449cdae5120c7c5022098b25786b2de1b1..3aba5b9f4501869af94875d1814d0606360a0ffb 100644 (file)
@@ -161,9 +161,6 @@ package body System.Generic_Array_Operations is
       pragma Assert (M'First (1) = N'First (1) and then
                      M'Last  (1) = N'Last (1));
 
-      function "abs" (X : Scalar) return Scalar is
-        (if X < Zero then Zero - X else X);
-
       --  The following are variations of the elementary matrix row operations:
       --  row switching, row multiplication and row addition. Because in this
       --  algorithm the addition factor is always a negated value, we chose to
@@ -274,14 +271,14 @@ package body System.Generic_Array_Operations is
       for J in M'Range (2) loop
          declare
             Max_Row : Integer := Row;
-            Max_Abs : Scalar := Zero;
+            Max_Abs : Real'Base := 0.0;
 
          begin
             --  Find best pivot in column J, starting in row Row
 
             for K in Row .. M'Last (1) loop
                declare
-                  New_Abs : constant Scalar := abs M (K, J);
+                  New_Abs : constant Real'Base := abs M (K, J);
                begin
                   if Max_Abs < New_Abs then
                      Max_Abs := New_Abs;
@@ -290,7 +287,7 @@ package body System.Generic_Array_Operations is
                end;
             end loop;
 
-            if Zero < Max_Abs then
+            if Max_Abs > 0.0 then
                Switch_Row (M, N, Row, Max_Row);
                Divide_Row (M, N, Row, M (Row, J));
 
index c8eea4f94401ee043895181ac59119fd245d3860..9e9973c7d9c74cabfb89d87751134337870098cb 100644 (file)
@@ -65,12 +65,14 @@ pragma Pure (Generic_Array_Operations);
 
    generic
       type Scalar is private;
+      type Real is digits <>;
       type Matrix is array (Integer range <>, Integer range <>) of Scalar;
+      with function "abs" (Right : Scalar) return Real'Base is <>;
       with function "-" (Left, Right : Scalar) return Scalar is <>;
       with function "*" (Left, Right : Scalar) return Scalar is <>;
       with function "/" (Left, Right : Scalar) return Scalar is <>;
-      with function "<" (Left, Right : Scalar) return Boolean is <>;
-      Zero, One : Scalar;
+      Zero : Scalar;
+      One  : Scalar;
    procedure Forward_Eliminate
      (M   : in out Matrix;
       N   : in out Matrix;