a-ngrear.adb ("abs"): Adjust for modified L2_Norm generic

2011-10-13  Geert Bosch  <bosch@adacore.com>

	* a-ngrear.adb ("abs"): Adjust for modified L2_Norm generic
	* s-gearop.ads (L2_Norm): Change profile to be suitable for
	Complex_Vector
	* s-gearop.adb (L2_Norm): Reimplement using direct definition,
	not inner product

From-SVN: r179908

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c8602ce5911d6503e94ef5212005ecccc1493a98..39d4ec08fbb813b54fd7f3dd274238487c8215a3 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2011-10-13  Geert Bosch  <bosch@adacore.com>
+
+       * a-ngrear.adb ("abs"): Adjust for modified L2_Norm generic
+       * s-gearop.ads (L2_Norm): Change profile to be suitable for
+       Complex_Vector
+       * s-gearop.adb (L2_Norm): Reimplement using direct definition,
+       not inner product
+
 2011-10-13  Robert Dewar  <dewar@adacore.com>
 
        * exp_ch5.adb, sem_ch3.adb, impunit.adb, impunit.ads, sem_type.adb,

diff --git a/gcc/ada/a-ngrear.adb b/gcc/ada/a-ngrear.adb
index 8ce8d9a98b0fa9d133d02c8e927343506593700f..8ffd95e875e33dde68d1be35d2e9837ce39e4083 100644 (file)
--- a/gcc/ada/a-ngrear.adb
+++ b/gcc/ada/a-ngrear.adb
@@ -356,10 +356,14 @@ package body Ada.Numerics.Generic_Real_Arrays is
 
       function "abs" is new
         L2_Norm
-          (Scalar        => Real'Base,
-           Vector        => Real_Vector,
-           Inner_Product => "*",
-           Sqrt          => Sqrt);
+          (X_Scalar      => Real'Base,
+           Result_Real   => Real'Base,
+           X_Vector      => Real_Vector,
+           "abs"         => "+");
+      --  While the L2_Norm by definition uses the absolute values of the
+      --  elements of X_Vector, for real values the subsequent squaring
+      --  makes this unnecessary, so we substitute the "+" identity function
+      --  instead.
 
       function "abs" is new
         Vector_Elementwise_Operation

diff --git a/gcc/ada/s-gearop.adb b/gcc/ada/s-gearop.adb
index ddff7bea32e7f8aa573f29689a3a84bb860cf5ad..7582e9860e6ab2088c50349c951f531437d0b267 100644 (file)
--- a/gcc/ada/s-gearop.adb
+++ b/gcc/ada/s-gearop.adb
@@ -336,9 +336,14 @@ package body System.Generic_Array_Operations is
    -- L2_Norm --
    -------------
 
-   function L2_Norm (X : Vector) return Scalar is
+   function L2_Norm (X : X_Vector) return Result_Real'Base is
+      Sum    : Result_Real'Base := 0.0;
    begin
-      return Sqrt (Inner_Product (X, X));
+      for J in X'Range loop
+         Sum := Sum + Result_Real'Base (abs X (J))**2;
+      end loop;
+
+      return Sqrt (Sum);
    end L2_Norm;
 
    ----------------------------------

diff --git a/gcc/ada/s-gearop.ads b/gcc/ada/s-gearop.ads
index 51e3b92c2017df8d9eba5a83ae262b2d7dc9b2ea..ca6b7f3586f2d8b5d532a16ffbb16ff3a7d38d61 100644 (file)
--- a/gcc/ada/s-gearop.ads
+++ b/gcc/ada/s-gearop.ads
@@ -291,11 +291,12 @@ pragma Pure (Generic_Array_Operations);
    -------------
 
    generic
-      type Scalar is private;
-      type Vector is array (Integer range <>) of Scalar;
-      with function Inner_Product (Left, Right : Vector) return Scalar is <>;
-      with function Sqrt (X : Scalar) return Scalar is <>;
-   function L2_Norm (X : Vector) return Scalar;
+      type X_Scalar is private;
+      type Result_Real is digits <>;
+      type X_Vector is array (Integer range <>) of X_Scalar;
+      with function "abs" (Right : X_Scalar) return Result_Real is <>;
+      with function Sqrt (X : Result_Real'Base) return Result_Real'Base is <>;
+   function L2_Norm (X : X_Vector) return Result_Real'Base;
 
    -------------------
    -- Outer_Product --