Re: Problem trying to implement generics.

["Ayende Rahien" <Dont@spam.me>]

<tmoran@acm.org> wrote in message
news:PgmB6.11956$ix4.9222255@news1.rdc1.sfba.home.com...

> > That solved the problem, but why? What does aliased mean?
>   If you have a variable x, and also a pointer p that points to
> x (p := x'access) then "x" and "p.all" are two different names,
> or aliases, for the same thing.  Declaring "x : aliased some_type;"
> alerts a reader of the program to the possibility the value of
> x may change during a code sequence that appears to have to
> mention of x (but has "p.all := 7;", for instance).  It also
> tells the compiler that if it makes a temporary copy of x, in
> a register, say, it must take account of the possibilty that
> x is supposed to be changed by references to p.

Okay, that makes sense.

> >The only thing I can think of is that this doesn't work because the
function
> >is not declared on the ads file.
>    Inside the body of the function, where the error occurs, it doesn't
> matter where the spec of the function was first declared.  You say
> other functions use this variable just fine.  What's different?

I've no idea, I switched the places of the function with another procedure,
and it produce the same error in the procedure.
I also tried another compiler (I was using ObjectAda, tried GNAT), and got
the error on the same line.
The OS is Windows2000, ObjectAda 7.2 SE, GNAT 3.13.
I've no idea what I'm doing wrong here, as far as I know, it should compile.


The error from Object Ada is:
bintree.adb: Error: line 9 col 28 LRM:4.1(3), Direct name, root, is not
visible, Ignoring future references

The error from GNAT is:

bintree.adb:9:42: "root" is undefined (more references follow)

With nothing more to follow this.


Here is the spec:

with Ada.Finalization;
generic
 type data_type is private;
 type Sort_by is private;
 with function ">" (Left, Right: in Sort_By) return Boolean;
package binTree is
 type binary_Tree is new Ada.Finalization.controlled with private;
 type node is private;
 type node_access is access all Node;
 type data_access is access all Data_type;
 procedure insert(insert_this : in data_type; Sort : in sort_by);
 --Insert into the binary tree, sort according to sort.
 function Delete(Delete_this: in Sort_by; Index : in natural := 1) return
boolean;
 -- Delete a node from the tree, return true if succeeded, return false if
 -- the node does not exist.
 function Get(Search_For: in sort_by; index : in natural := 1) return
data_access;
 -- Search for nodes with duplicate sort_by variable. It find the first
 -- node with the sort_by equal to the given one, and then continue to check
for Index
 -- number of duplicated. It return null if it there isn't a suitable node
in the
 -- correct index.

 private
  type Binary_Tree is new Ada.Finalization.controlled with record
   root: Node_access := null;
  end record;
  type node is record
   Data : aliased Data_type;
   Sorted_by: Sort_by;
   Parent, Left, right : Node_access;
  end record;
     procedure Adjust(Object : in out Binary_Tree );
     procedure Finalize(Object : in out Binary_Tree );

end binTree;

Here is the body:

with Unchecked_Deallocation;

package body binTree is

 procedure Free is new Unchecked_Deallocation(node, Node_Access);

 procedure insert(insert_this : in data_type; Sort : in sort_by) is
  New_node : Node_Access := new node;
  current : Node_access := root; -- This is the line it compline about!!
 begin
  New_node.sorted_by := sort;
  New_node.data := insert_this;
  --if the tree is empty
  if root = null then
   root := new_node;
   return;
  end if;
  -- if tree is not empty
  loop
   if current.sorted_by > sort then
    if current.right /= null then
     current := current.right;
    else
     current.right := New_node;
     New_node.parent := current;
     return;
    end if;
   else
    if current.left /= null then
     current := current.left;
    else
     current.left := New_node;
     New_node.parent := current;
     return;
    end if;
   end if;
  end loop;
 end insert;

  function find(Find_This : in sort_by; index : in natural := 1) return
node_Access is
  current : node_access := root;
 begin
  while current /= null and current.sorted_by /= Find_This loop
   if current.sorted_by > Find_This then
    current := current.right;
   else
    current := current.left;
   end if;
  end loop;
  if index /= 0 and current /= null then
   for I in 1..index loop
    if current.left /= null and current.sorted_by = Find_This then
     current := current.left;
    else
     return null;
    end if;
   end loop;
  end if;
  return current;
 end Find;

 function Delete(Delete_this: in Sort_by; Index : in natural := 1) return
boolean is
  to_del: node_access := find(Delete_this,index);
  Lowest_Node : node_access;
 begin
  if to_del = null then
   return false;
  end if;
  --find the lower node to the left or to the right, so we can replace it.
  lowest_Node := to_del;
  while lowest_Node.left /= null or lowest_Node.right /= null loop
   if lowest_Node.left /= null then
    lowest_Node := lowest_Node.left;
   else
    lowest_Node := lowest_Node.right;
   end if;
  end loop;

  if Lowest_node.parent /= null then
   if lowest_Node.parent.left = lowest_Node then
    lowest_Node.parent.left := null;
   else
    lowest_Node.parent.right := null;
   end if;
  elsif root = Lowest_node then
   -- a single node tree which is about to lose its only leaf (the root one)
   root := null;
  end if;

  lowest_Node.parent := to_del.parent;
  lowest_Node.right := to_del.right;
  Lowest_node.left := Lowest_node.left;

  if lowest_Node.right /= null then
   lowest_Node.right.parent := lowest_Node;
  end if;

  if lowest_Node.left /= null then
   lowest_Node.left.parent := lowest_node;
  end if;

  Free(To_del);
  return true;
 end delete;


 function Get(Search_For: in sort_by; index : in natural := 1) return
data_access is
  result : node_access := find(search_for,index);
 begin
  if result = null then
   return null;
  else

   return   result.data'access;
  end if;
 end get;

 --erase this node and all that below this one
 procedure erase(node_to_del : in out Node_access) is
 begin
  if node_to_del.right /= null then
   erase(node_to_del.right);
  end if;

  if node_to_del.Left /= null then
   erase(node_to_del.Left);
  end if;

  free(node_to_del);
 end erase;

 --copy from_this node (and its children) to_this
 procedure copy(from_this: in node_access; to_this: out node_access;
to_this_parent : in node_access) is
 begin
  to_this := new node;
  to_this.data := from_this.data;
  to_this.sorted_by := from_this.sorted_by;
  to_this.parent := to_this_parent;
  if from_this.left /= null then
   copy(from_this.left,to_this.left,to_this);
  end if;
  if from_this.right /= null then
   copy(from_this.right,to_this.right,to_this);
  end if;
 end copy;

 procedure Finalize(Object : in out Binary_Tree ) is
  begin
  if root /= null then
   erase(root);
  end if;
 end finalize;

 procedure Adjust(Object : in out Binary_Tree ) is
  new_node : node_access;
 begin
  if root/=null then
   copy(root,root,null);
  end if;
 end adjust;

end binTree;