From: Geert Bosch <bosch@adacore.com>
Date: Thu, 13 Oct 2011 10:49:57 +0000 (+0000)
Subject: a-ngrear.adb ("abs"): Adjust for modified L2_Norm generic
X-Git-Tag: releases/gcc-4.7.0~3161
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=a4935dea3fa78cd019774991efe03ffbf96aecb7;p=thirdparty%2Fgcc.git

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 c8602ce5911d..39d4ec08fbb8 100644
--- 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 8ce8d9a98b0f..8ffd95e875e3 100644
--- 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 ddff7bea32e7..7582e9860e6a 100644
--- 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 51e3b92c2017..ca6b7f3586f2 100644
--- 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 --