aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data update

Browse source
This commit is contained in:
Ingy döt Net 2026-02-01 16:33:20 -08:00
parent 5150844a7d
commit 4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
Download patch file Download diff file Expand all files Collapse all files

56
Task/First-class-functions/Ada/first-class-functions.ada
View file

@ -1,56 +0,0 @@
with Ada.Float_Text_IO,
Ada.Integer_Text_IO,
Ada.Text_IO,
Ada.Numerics.Elementary_Functions;
procedure First_Class_Functions is
use Ada.Float_Text_IO,
Ada.Integer_Text_IO,
Ada.Text_IO,
Ada.Numerics.Elementary_Functions;
function Sqr (X : Float) return Float is
begin
return X ** 2;
end Sqr;
type A_Function is access function (X : Float) return Float;
generic
F, G : A_Function;
function Compose (X : Float) return Float;
function Compose (X : Float) return Float is
begin
return F (G (X));
end Compose;
Functions : array (Positive range <>) of A_Function := (Sin'Access,
Cos'Access,
Sqr'Access);
Inverses : array (Positive range <>) of A_Function := (Arcsin'Access,
Arccos'Access,
Sqrt'Access);
begin
for I in Functions'Range loop
declare
function Identity is new Compose (Functions (I), Inverses (I));
Test_Value : Float := 0.5;
Result : Float;
begin
Result := Identity (Test_Value);
if Result = Test_Value then
Put ("Example ");
Put (I, Width => 0);
Put_Line (" is perfect for the given test value.");
else
Put ("Example ");
Put (I, Width => 0);
Put (" is off by");
Put (abs (Result - Test_Value));
Put_Line (" for the given test value.");
end if;
end;
end loop;
end First_Class_Functions;