Alexis Ada Reference Manual

package body aada_compiler_node_package is
 
procedure init(node: in out compiler_node;
               token: in aada_compiler_token_package.compiler_token_type) is
begin
  node.token := token;
end init;
 
-- note that the children remains!
procedure unlink(node: in out compiler_node_access) is
begin
  if node.previous /= null then
    node.previous.next := node.next;
  elsif node.parent /= null then
    node.parent.child(node.index) := node.next;
  end if;
  if node.next /= null then
    node.next.previous := node.previous;
  end if;
  node.parent := null;
  node.next := null;
  node.previous := null;
end unlink;
 
procedure parent(node: in out compiler_node_access;
                 parent: in out compiler_node_access;
                 child_index: in compiler_node_index := 1) is
  l: compiler_node_access;
begin
  node := first(node);
 
  -- attach to the new parent if not null
  if parent /= null and then node.parent /= parent then
    if parent.child(child_index) /= null then
      -- we're not the first... attach at the end of the existing children
      l := last(parent.child(child_index));
      l.next := node;
      node.previous := l;
    else
      -- we're the first
      parent.child(child_index) := node;
    end if;
    -- avoid the detach (see loop below)
    node.parent := parent;
  end if;
 
  -- now reparent all the siblings in this list
  while node /= null
  loop
    -- detach from the old parent if any
    if node.parent /= null and then node.parent /= parent then
      node.parent.child(node.index) := null;
    end if;
 
    node.parent := parent;
    node.index := child_index;
 
    -- loop through all the siblings
    node := node.next;
  end loop;
end parent;
 
function parent(node: in compiler_node_access) return compiler_node_access is
begin
  return node.parent;
end parent;
 
function child(node: in compiler_node_access;
               child_index: in compiler_node_index := 1)
                                            return compiler_node_access is
begin
  return node.child(child_index);
end child;
 
procedure next(node: in out compiler_node_access;
               next: in out compiler_node_access) is
  f: compiler_node_access;
  l: compiler_node_access;
begin
  f := first(next);
  l := last(next);
 
  l.next := node.next;
  f.previous := node;
  node.next := f;
  if l.next /= null then
    l.next.previous := l;
  end if;
 
  -- reparent our new children
  parent(node, node.parent, node.index);
end next;
 
function next(node: in compiler_node_access) return compiler_node_access is
begin
  return node.next;
end next;
 
function last(node: in compiler_node_access) return compiler_node_access is
  n: compiler_node_access := node;
begin
  if n /= null then
    while n.next /= null
    loop
      n := n.next;
    end loop;
  end if;
  return n;
end last;
 
procedure previous(node: in out compiler_node_access;
                   previous: in out compiler_node_access) is
  f: compiler_node_access;
  l: compiler_node_access;
begin
  f := first(previous);
  l := last(previous);
 
  l.next := node;
  f.previous := node.previous;
  node.previous := l;
  if f.previous /= null then
    f.previous.next := f;
  end if;
 
  -- reparent our new children
  parent(node, node.parent, node.index);
end previous;
 
function previous(node: in compiler_node_access)
                                        return compiler_node_access is
begin
  return node.previous;
end previous;
 
function first(node: in compiler_node_access) return compiler_node_access is
  n: compiler_node_access := node;
begin
  if n /= null then
    while n.previous /= null
    loop
      n := n.previous;
    end loop;
  end if;
  return n;
end first;
 
procedure create_node(node_handle: in out compiler_node_handle;
                      token: in aada_compiler_token_package.compiler_token_type;
                      children: in compiler_node_index := 0) is
begin
  node_handle.node := new compiler_node(children);
  init(node_handle.node.all, token);
end create_node;
 
procedure init(node_handle: compiler_node_handle;
               token: in aada_compiler_token_package.compiler_token_type) is
begin
  init(node_handle.node.all, token);
end init;
 
procedure parent(node_handle: in out compiler_node_handle;
                 parent_handle: in out compiler_node_handle;
                 child_index: in compiler_node_index := 1) is
begin
  parent(node_handle.node, parent_handle.node, child_index);
end parent;
 
procedure next(node_handle: in out compiler_node_handle;
               next_handle: in out compiler_node_handle) is
begin
  next(node_handle.node, next_handle.node);
end next;
 
end aada_compiler_node_package;
 
-- vim: ts=2 sw=2 et syntax=ada