# tree.icn: Generic tree-node object
#--

$define  TREE_REVISION      "$Revision: 1.4 $"
$define  TREE_DATE          "$Date: 1996/11/05 23:35:12 $"

#================================================================
# Class Tree:  Each instance represents a node in an N-ary tree.
# As created, a tree node has parent or children; nodes are
# attached by later calls to Tree_Add_Child().  There is currently
# no provision for removing children.
#----------------------------------------------------------------
# METHODS
#----------------------------------------------------------------
# Tree_New ( parent, value )
#   [ if parent is either a Tree object or &null, and
#     value is any value including &null ->
#       if parent is &null ->
#         return a new Tree object with parent (&null), value (value),
#           birthOrder 1, and no children
#       else ->
#         parent  :=  parent with a new last child added: a new Tree
#                     object with parent (parent), value (value),
#                     birthOrder (1 + number of parent's children),
#                     and no children
#         return that new Tree object
#   ]
#--
# Tree_Value ( self )
#   [ returns self's value
#   ]
#--
# Tree_Set_Value ( self, value )
#   [ self  :=  self with the new value attached
#   ]
#--
# Tree_Parent ( self )
#   [ if self has a parent ->
#       return that parent
#   | else -> fail
#   ]
#--
# Tree_N_Children ( self )
#   [ returns the number of self's children as an integer
#   ]
#--
# Tree_Gen_Children ( self )
#   [ generates the child Tree objects of self in ascending birth order
#   ]
#--
# Tree_Nth_Child ( self, n )
#   [ if self has at least n children ->
#       return the nth child Tree object
#   | else -> fail
#   ]
#--
# Tree_Birth_Order ( self )
#   [ if self has a parent ->
#       return self's child number relative to that parent
#   | else -> return 1
#   ]
#----------------------------------------------------------------
# STATE
#----------------------------------------------------------------
  record treeTag (
    value,          # Current value attached to this node
    parent,         # &null if we're the root, else our parent Tree object
    birthOrder,     # Our birth order relative to the parent
    childList )     # List of children, or &null if there are none
#----------------------------------------------------------------
# INVARIANTS
#----------------------------------------------------------------
# .parent ==
#       if self has no parent -> &null
#       else ->
#         a Tree object T such that T's child list has self in
#         the position specified by self.birthorder
# .birthOrder == (see invariant for self.parent)
# .childList ==
#       if self has no children -> &null
#       else ->
#         a list containing the children as Tree objects in
#         the order they were added 
#----------------------------------------------------------------


# - - -   T r e e _ N e w   - - -

procedure Tree_New ( parent, value )
  local self

  #-- 1 --
  #-[ self  :=  a new Tree object with these field values:
  #               .value       :=  value
  #               .parent      :=  parent
  #               .birthOrder  :=  &null
  #               .childList   :=  &null
  #-]
  self         :=  treeTag ( );
  self.value   :=  value;
  self.parent  :=  parent;

  #-- 2 --
  #-[ if parent is &null ->
  #     self.birthOrder   :=  1
  #   else if parent.childList is &null ->
  #     parent.childList  :=  a singleton list, [ self ]
  #     self.birthOrder   :=  1
  #   else ->
  #     self.birthOrder   :=    1 + * parent.childList
  #     parent.childList  ||:=  self
  #-]
  if  / parent  then
    self.birthOrder  :=  1
  else
  { #-- 2.1 -- 
    if  / parent.childList  then
      parent.childList  :=  [];

    self.birthOrder  :=  1 + * parent.childList;
    put ( parent.childList, self );
  } #-- 2.1 --

  #-- 3 --
  return self;
end # --- Tree_New ---


# - - -   T r e e _ V a l u e   - - -

procedure Tree_Value ( self )
  return self.value;
end


# - - -   T r e e _ S e t _ V a l u e   - - -

procedure Tree_Set_Value ( self, value )
  self.value  :=  value;
end


# - - -   T r e e _ P a r e n t   - - -

procedure Tree_Parent ( self )
  return  \ tree.parent;
end


# - - -   T r e e _ N _ C h i l d r e n   - - -

procedure Tree_N_Children ( self )
  #-- 1 --
  #-[ if self.childList is not &null ->
  #     return the size of self.childList
  # | else -> return 0
  #-]
  return  ( * \ self.childList ) | 0;
end


# - - -   T r e e _ G e n _ C h i l d r e n   - - -

procedure Tree_Gen_Children ( self )
  every suspend ( ! \ self.childList );
  fail;
end


# - - -   T r e e _ N t h _ C h i l d   - - -

procedure Tree_Nth_Child ( self, n )
  #-- 1 --
  #-[ if self.childList is &null -> fail
  # | else -> I
  #-]
  if  / self.childList  then
    fail;

  #-- 2 --
  #-[ if self.childList has at least n elements ->
  #     return self.childList[n]
  # | else -> fail
  #-]
  return  self.childList[n];
end # --- Tree_Nth_Child ---


# - - -   T r e e _ B i r t h _ O r d e r   - - -

procedure Tree_Birth_Order ( self )
  return self.birthOrder;
end