Next / Previous / Shipman's Home Sweet Homepage / Site map

An example of a Cleanroom object

Shown below is the complete source for a generic tree node object in Icon. Principal parts include:


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

$define  TREE_REVISION      "$Revision: 1.2 $"
$define  TREE_DATE          "$Date: 1996/04/14 23:17:33 $"

#================================================================
# 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 ( value )
#   [ return a tree node with no parent, no children, and
#     the given value (which may be &null)
#   ]
#----------------------------------------------------------------
# Tree_Value ( self )
#   [ returns self's value
#   ]
#--
# Tree_Set_Value ( self, value )
#   [ self  :=  self with the new value attached
#   ]
#--
# Tree_Add_Child ( self, child )
#   [ if child is a Tree object ->
#       self   :=  self with child added as its new last child
#       child  :=  child with self added as its parent
#   ]
#--
# 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 ( value )
  local self

  self        :=  treeTag ( );
  self.value  :=  value;

  return self;
end


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

procedure Tree_Value ( self )
  return tree.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 _ A d d _ C h i l d   - - -

procedure Tree_Add_Child ( self, child )

  #-- 1 --
  #-[ if self.childList is &null ->
  #     self.childList  :=  an empty list
  # | else -> I
  #-]
  / self.childList  :=  [];

  #-- 2 --
  #-[ self.childList  ||:=  child
  #-]
  put ( self.childList, child );

  #-- 3 --
  #-[ child.parent      :=  self
  #   child.birthOrder  :=  number of elements in self.childList
  #-]
  child.parent      :=  self;
  child.birthOrder  :=  * self.childList;
end # --- Tree_Add_Child ---


# - - -   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

Next: Cleanroom verification of objects
See also: Using the Cleanroom methodology with objects
Previous: Naming conventions for Icon objects
Site map
John W. Shipman, john@nmt.edu
Last updated: 1996/04/14 23:17:33
URL: http://www.nmt.edu/~shipman/soft/clean/ootree.html