Re: Need some light on using Ada or not

[Simon Wright <simon@pushface.org>]

[-- Attachment #1: Type: text/plain, Size: 367 bytes --]

Brian Drummond <brian_drummond@btconnect.com> writes:

> As this is my first experiment with tasking, comments are welcome (and
> I'd be interested to see your version).

See end.

> If people think this is worth submitting to the shootout, I'll go
> ahead.

I think it definitely is: the only Ada code for binary-trees is
single-threaded, so looks needlessly poor.


[-- Attachment #2: simple multi-thread version of binary trees benchmark --]
[-- Type: text/plain, Size: 5283 bytes --]

----------------------------------------------------------------
-- BinaryTrees
--
-- Ada 95 (GNAT)
--
-- Contributed by Jim Rogers
-- Modified by Simon Wright
----------------------------------------------------------------
with Tree_Nodes; use Tree_Nodes;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Command_Line; use Ada.Command_Line;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with System;

procedure Binarytrees is
   Min_Depth : constant Positive := 4;
   N : Natural := 1;
   Stretch_Tree : Tree_Node;
   Long_Lived_Tree : Tree_Node;
   Max_Depth : Positive;
   Stretch_Depth : Positive;

   task type Check_Tree is
      pragma Priority (System.Default_Priority - 1);
      entry Start (Iterations : Positive; Depth : Positive);
      entry Sum (Result : out Integer);
   end Check_Tree;

   task body Check_Tree is
      Iterations : Positive;
      Depth : Positive;
      Tree : Tree_Node;
      Check : Integer := 0;
   begin
      accept Start (Iterations : Positive; Depth : Positive) do
         Check_Tree.Iterations := Iterations;
         Check_Tree.Depth := Depth;
      end Start;
      for J in 1 .. Iterations loop
         Tree := Bottom_Up_Tree (J, Depth);
         Check := Check + Item_Check (Tree);
         Delete_Tree (Tree);
         Tree := Bottom_Up_Tree (-J, Depth);
         Check := Check + Item_Check (Tree);
         Delete_Tree (Tree);
      end loop;
      accept Sum (Result : out Integer) do
         Result := Check;
      end Sum;
   end Check_Tree;

begin

   if Argument_Count > 0 then
      N := Positive'Value (Argument (1));
   end if;

   Max_Depth := Positive'Max (Min_Depth + 2, N);
   Stretch_Depth := Max_Depth + 1;

   Stretch_Tree := Bottom_Up_Tree (0, Stretch_Depth);
   Put ("stretch tree of depth ");
   Put (Item => Stretch_Depth, Width => 1);
   Put (Ht & " check: ");
   Put (Item => Item_Check (Stretch_Tree), Width => 1);
   New_Line;
   Delete_Tree (Stretch_Tree);

   Long_Lived_Tree := Bottom_Up_Tree (0, Max_Depth);

   declare
      subtype Check_Trees_Array_Range
      is Natural range 0 .. (Max_Depth - Min_Depth) / 2;
      Check_Trees : array (Check_Trees_Array_Range) of Check_Tree;
      function Depth (For_Entry : Check_Trees_Array_Range) return Natural
      is
      begin
         return For_Entry  * 2 + Min_Depth;
      end Depth;
      function Iterations (For_Entry : Check_Trees_Array_Range) return Positive
      is
      begin
         return 2 ** (Max_Depth - Depth (For_Entry) + Min_Depth);
      end Iterations;
   begin
      for D in Check_Trees'Range loop
         Check_Trees (D).Start (Iterations => Iterations (D),
                                Depth => Depth (D));
      end loop;
      for D in Check_Trees'Range loop
         Put (Item => Iterations (D) * 2, Width => 0);
         Put (Ht & " trees of depth ");
         Put (Item => Depth (D), Width => 0);
         declare
            Check : Integer;
         begin
            Check_Trees (D).Sum (Result => Check);
            Put (Ht & " check: ");
            Put (Item => Check, Width => 0);
         end;
         New_Line;
      end loop;
   end;

   Put ("long lived tree of depth ");
   Put (Item => Max_Depth, Width => 0);
   Put (Ht & " check: ");
   Put (Item => Item_Check (Long_Lived_Tree), Width => 0);
   New_Line;
   Delete_Tree (Long_Lived_Tree);

end BinaryTrees;
----------------------------------------------------------------
-- BinaryTrees
--
-- Ada 95 (GNAT)
--
-- Contributed by Jim Rogers
-- Modified by Simon Wright
----------------------------------------------------------------

with Ada.Unchecked_Deallocation;

package body Tree_Nodes is

   function Bottom_Up_Tree (Item : Integer; Depth : Natural) return Tree_Node
   is
   begin
      if Depth > 0 then
         return new Node'(Bottom_Up_Tree (2 * Item - 1, Depth - 1),
                          Bottom_Up_Tree (2 * Item, Depth - 1),
                          Item);
      else
         return new Node'(null, null, Item);
      end if;
   end Bottom_Up_Tree;

   function Item_Check (This : Tree_Node) return Integer
   is
   begin
      if This.Left = null then
         return This.Item;
      else
         return This.Item + Item_Check (This.Left) - Item_Check (This.Right);
      end if;
   end Item_Check;

   procedure Delete_Tree (This : in out Tree_Node)
   is
      procedure Free is new Ada.Unchecked_Deallocation (Node, Tree_Node);
   begin
      if This /= null then
         Delete_Tree (This.Left);
         Delete_Tree (This.Right);
         Free (This);
      end if;
   end Delete_Tree;

end Tree_Nodes;
----------------------------------------------------------------
-- BinaryTrees
--
-- Ada 95 (GNAT)
--
-- Contributed by Jim Rogers
-- Modified by Simon Wright
----------------------------------------------------------------

package Tree_Nodes is
   type Tree_Node is private;
   function Bottom_Up_Tree (Item : Integer; Depth : Natural) return Tree_Node;
   function Item_Check (This : Tree_Node) return Integer;
   procedure Delete_Tree (This : in out Tree_Node);
private
   type Node;
   type Tree_Node is access Node;
   type Node is record
      Left  : Tree_Node;
      Right : Tree_Node;
      Item  : Integer := 0;
   end record;
end Tree_Nodes;