The Computer Language
Benchmarks Game

binary-trees Ada 2005 GNAT program

source code

-- The Computer Language Benchmarks Game
-- http://benchmarksgame.alioth.debian.org/
--
-- Contributed by Jim Rogers

with Treenodes; use Treenodes;
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;

procedure Binarytrees is
   Min_Depth : constant Positive := 4;
   N : Natural := 1;
   Stretch_Tree : TreeNode;
   Long_Lived_Tree : TreeNode;
   Short_Lived_Tree_1 : TreeNode;
   Short_Lived_Tree_2 : TreeNode;
   Max_Depth : Positive;
   Stretch_Depth : Positive;
   Check : Integer;
   Sum : Integer;
   Depth : Natural;
   Iterations : Positive;
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);
   Item_Check(Stretch_Tree, Check);
   Put("stretch tree of depth ");
   Put(Item => Stretch_Depth, Width => 1);
   Put(Ht & " check: ");
   Put(Item => Check, Width => 1);
   New_Line;
   
   Long_Lived_Tree := Bottom_Up_Tree(0, Max_Depth);
   
   Depth := Min_Depth;
   while Depth <= Max_Depth loop
      Iterations := 2**(Max_Depth - Depth + Min_Depth);
      Check := 0;
      for I in 1..Iterations loop
         Short_Lived_Tree_1 := Bottom_Up_Tree(Item => I, Depth => Depth);
         Short_Lived_Tree_2 := Bottom_Up_Tree(Item =>-I, Depth => Depth);
         Item_Check(Short_Lived_Tree_1, Sum);
         Check := check + Sum;
         Item_Check(Short_Lived_Tree_2, Sum);
         Check := Check + Sum;
      end loop;
      Put(Item => Iterations * 2, Width => 0);
      Put(Ht & " trees of depth ");
      Put(Item => Depth, Width => 0);
      Put(Ht & " check: ");
      Put(Item => Check, Width => 0);
      New_Line;
      Depth := Depth + 2;
   end loop;
   Put("long lived tree of depth ");
   Put(Item => Max_Depth, Width => 0);
   Put(Ht & " check: ");
   Item_Check(Long_Lived_Tree, Check);
   Put(Item => Check, Width => 0);
   New_Line;
end BinaryTrees;
----------------------------------------------------------------
-- BinaryTrees
--
-- Ada 95 (GNAT)
--
-- Contributed by Jim Rogers
----------------------------------------------------------------

package Treenodes is
   type Treenode is private;
   function Bottom_Up_Tree(Item : Integer; Depth : Integer) return Treenode;
   procedure Item_Check(This : in out Treenode; Sum : out Integer);
private
   type Node;
   type Treenode is access Node;
   type Node is record
      Left  : Treenode := null;
      Right : Treenode := null;
      Item  : Integer  := 0; 
   end record;
end Treenodes;
----------------------------------------------------------------
-- BinaryTrees
--
-- Ada 95 (GNAT)
--
-- Contributed by Jim Rogers
----------------------------------------------------------------

with Ada.Unchecked_Deallocation;

package body Treenodes is
   function Bottom_Up_Tree(Item : Integer; Depth : Integer)
      return Treenode 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;

   procedure Item_Check (This : in out Treenode; Sum : out Integer) is
      procedure Free is new Ada.Unchecked_Deallocation(Node, Treenode);
      Left_Sum, Right_Sum : Integer;
   begin
      if This.Left = null then
         Sum := This.Item;
      else
         Item_Check(This.Left, Left_Sum);
         Item_Check(This.Right, Right_Sum);
         Sum :=  This.Item + Left_Sum - Right_Sum;
      end if;
      Free(This);      
   end Item_Check;

end Treenodes;
    

notes, command-line, and program output

NOTES:
64-bit Ubuntu quad core
GNATMAKE 5.4.0
gcc (Ubuntu 5.4.0-6ubuntu1~16.04.4) 5.4.0 20160609



Sat, 25 Mar 2017 01:28:41 GMT

MAKE:
gnatchop -r -w binarytrees.gnat
splitting binarytrees.gnat into:
   binarytrees.adb
   treenodes.ads
   treenodes.adb
gnatmake -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp -f binarytrees.adb -o binarytrees.gnat_run -largs -lapr-1
gcc-5 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp binarytrees.adb
gcc-5 -c -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -gnatNp treenodes.adb
gnatbind-5 -x binarytrees.ali
gnatlink-5 binarytrees.ali -O3 -fomit-frame-pointer -march=native -msse3 -mfpmath=sse -o binarytrees.gnat_run -lapr-1
0.75s to complete and log all make actions

COMMAND LINE:
./binarytrees.gnat_run 7

UNEXPECTED OUTPUT 

1,4c1,4
< stretch tree of depth 8	 check: -1
< 256	 trees of depth 4	 check: -256
< 64	 trees of depth 6	 check: -64
< long lived tree of depth 7	 check: -1
---
> stretch tree of depth 8	 check: 511
> 128	 trees of depth 4	 check: 3968
> 32	 trees of depth 6	 check: 4064
> long lived tree of depth 7	 check: 255

PROGRAM OUTPUT:
stretch tree of depth 8	 check: -1
256	 trees of depth 4	 check: -256
64	 trees of depth 6	 check: -64
long lived tree of depth 7	 check: -1