home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FUZZY.ZIP / AVL.S < prev    next >
Encoding:
Text File  |  1986-11-30  |  4.1 KB  |  86 lines
  1.  
  2. -------------------------------------------------------------------------------
  3. --                                                                           --
  4. --  Library Unit:  AVL  --  Generic AVL tree package                         --
  5. --                                                                           --
  6. --  Author:  Bradley L. Richards                                             --
  7. --                                                                           --
  8. --     Version     Date     Notes . . .                                      --
  9. --    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -    --
  10. --       1.0    12 Mar 86   Initial Version (delete & update not done)       --
  11. --       1.1    19 Aug 86   Added update and release procedures              --
  12. --       1.2     7 Sep 86   Added delete procedure, cleaned up code          --
  13. --    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -    --
  14. --                                                                           --
  15. --  Library units used:  unchecked_deallocation (text_io when debugging)     --
  16. --                                                                           --
  17. --  Description:  This package provides generic functions for creating,      --
  18. --      modifying, and accessing AVL trees.  AVL trees are binary trees      --
  19. --      which never have more than one level of imbalance between any        --
  20. --      two subtrees.  Balance is maintained automatically when the tree     --
  21. --      is being built.                                                      --
  22. --           The data to be maintained in the tree is never actually passed  --
  23. --      to this package.  Rather, pointers to the data are passed in, via    --
  24. --      type "node_ptr."  Also, comparison functions on the key fields of    --
  25. --      the data must be provided.  The package requires a less-than and an  --
  26. --      equality test.                                                       --
  27. --                                                                           --
  28. -------------------------------------------------------------------------------
  29.  
  30. with unchecked_deallocation;
  31. --with text_io; use text_io; -- debug
  32. generic
  33.    type node is limited private;
  34.    type node_ptr is access node;                -- points to the data for a node
  35.  
  36.    with function equal (a, b : node_ptr) return boolean;
  37.    with function less_than (a, b : node_ptr) return boolean;
  38.    --with procedure put_data (a : node_ptr); -- debug
  39.  
  40. package avl is
  41.  
  42.    type tree_ptr is private;
  43.  
  44.    function init_tree return tree_ptr;
  45.    function copy_tree( original : tree_ptr ) return tree_ptr;
  46.  
  47.    procedure add_node( tree : in out tree_ptr; data : in node_ptr;
  48.                           duplicate : out boolean );
  49.    procedure delete_node( tree : in out tree_ptr; data : in node_ptr;
  50.                           not_found : out boolean );
  51.    function fetch_node( tree : tree_ptr; data : node_ptr) return node_ptr;
  52.    --procedure print_tree( tree : tree_ptr );  -- debug
  53.    procedure release( tree : in out tree_ptr );
  54.    procedure update_node( tree : in tree_ptr; data : in node_ptr;
  55.                           not_found : out boolean );
  56.  
  57.    avl_error : exception;
  58.  
  59. private
  60.  
  61.     type subtree_status is (tall_left, left, same, right, tall_right);
  62.     --package bal_io is new enumeration_io(subtree_status); use bal_io; -- debug
  63.  
  64.     --
  65.     --  tree_node is declared first here, since the compiler otherwise
  66.     --  thinks I'm trying to overload type tree.  Another bug?
  67.     --
  68.     type tree_node;
  69.     type tree_ptr is access tree_node;
  70.     type tree_node is
  71.       record
  72.     balance : subtree_status := same;
  73.     left_child, right_child : tree_ptr := null;
  74.     parent : tree_ptr := null;
  75.     data : node_ptr := null;
  76.       end record;
  77.  
  78.     procedure free_AVL is new unchecked_deallocation(tree_node, tree_ptr);
  79.  
  80.     function fetch_node( tree : tree_ptr; data : node_ptr) return tree_ptr;
  81.     function needs_single_rotation(p1, p2, p3, p4 : in tree_ptr) return boolean;
  82.     procedure rotate_singly(p1, p2, p3 : in out tree_ptr);
  83.     procedure rotate_doubly(p1, p2, p3, p4 : in out tree_ptr);
  84.  
  85. end avl;
  86.