diff options
| author | Geert Bosch <bosch@adacore.com> | 2011-10-13 10:49:57 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-10-13 12:49:57 +0200 |
| commit | a4935dea3fa78cd019774991efe03ffbf96aecb7 (patch) | |
| tree | 86e465d761c3562ee46b5e2f2cad7b18e37c7567 | |
| parent | 3e7302c3cbddf59061529884465a594597ac3f3a (diff) | |
| download | gcc-a4935dea3fa78cd019774991efe03ffbf96aecb7.zip gcc-a4935dea3fa78cd019774991efe03ffbf96aecb7.tar.gz gcc-a4935dea3fa78cd019774991efe03ffbf96aecb7.tar.bz2 | |
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
| -rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/ada/a-ngrear.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/s-gearop.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/s-gearop.ads | 11 |
4 files changed, 29 insertions, 11 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c8602ce..39d4ec0 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 8ce8d9a..8ffd95e 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 ddff7be..7582e98 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 51e3b92..ca6b7f3 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 -- |