1-- Copyright 1994 Grady Booch 2-- Copyright 1994-1997 David Weller 3-- Copyright 1998-2014 Simon Wright <simon@pushface.org> 4 5-- This package is free software; you can redistribute it and/or 6-- modify it under terms of the GNU General Public License as 7-- published by the Free Software Foundation; either version 2, or 8-- (at your option) any later version. This package is distributed in 9-- the hope that it will be useful, but WITHOUT ANY WARRANTY; without 10-- even the implied warranty of MERCHANTABILITY or FITNESS FOR A 11-- PARTICULAR PURPOSE. See the GNU General Public License for more 12-- details. You should have received a copy of the GNU General Public 13-- License distributed with this package; see file COPYING. If not, 14-- write to the Free Software Foundation, 59 Temple Place - Suite 15-- 330, Boston, MA 02111-1307, USA. 16 17-- As a special exception, if other files instantiate generics from 18-- this unit, or you link this unit with other files to produce an 19-- executable, this unit does not by itself cause the resulting 20-- executable to be covered by the GNU General Public License. This 21-- exception does not however invalidate any other reasons why the 22-- executable file might be covered by the GNU Public License. 23 24with Ada.Finalization; 25with System.Storage_Pools; 26 27generic 28 Storage : in out System.Storage_Pools.Root_Storage_Pool'Class; 29package BC.Containers.Trees.Multiway is 30 31 pragma Preelaborate; 32 33 type Multiway_Tree is private; 34 35 function Create (From : Multiway_Tree) return Multiway_Tree; 36 -- If the given tree is null; construct a null tree. Otherwise, 37 -- construct a tree that structurally shares the root of the given 38 -- tree. 39 40 function "=" (Left, Right : Multiway_Tree) return Boolean; 41 -- Return True if and only if both trees are null or structurally 42 -- share the same tree. 43 44 procedure Clear (T : in out Multiway_Tree); 45 -- If the tree is not null, destroy this alias to the tree, make 46 -- the tree null, and reclaim the storage associated with any 47 -- unreachable items. 48 49 procedure Insert (T : in out Multiway_Tree; Elem : in Item); 50 -- Add the item to the root of the tree and make the original root 51 -- the immediate child of this new tree. 52 53 procedure Append (T : in out Multiway_Tree; 54 Elem : in Item); 55 -- Add the item as the immediate child of the tree. 56 57 procedure Append (T : in out Multiway_Tree; 58 Elem : in Item; 59 After : Natural); 60 -- Add the item as a child of the tree, after the given indexed 61 -- child. If After is 0, the item is inserted as the first child. 62 63 procedure Append (T : in out Multiway_Tree; 64 From_Tree : in out Multiway_Tree); 65 -- Add the tree as the immediate child of the tree. 66 67 procedure Append (T : in out Multiway_Tree; 68 From_Tree : in out Multiway_Tree; 69 After : Natural); 70 -- Add the tree as a child of the tree, after the given indexed 71 -- child. If After is 0, the tree is inserted as the first child. 72 73 procedure Remove (T : in out Multiway_Tree; Index : Positive); 74 -- Remove the given child and destroy it if it is no longer 75 -- reachable. 76 77 procedure Share (T : in out Multiway_Tree; 78 Share_With : in Multiway_Tree; 79 Child : Positive); 80 -- Clear the tree, then, if the given tree is not null, set the 81 -- tree to structurally share with the given child of the tree. 82 83 procedure Swap_Child (T : in out Multiway_Tree; 84 Swap_With : in out Multiway_Tree; 85 Child : in Positive); 86 -- The given tree must represent the root of a tree, which may be 87 -- null. Set the child of the tree (which may be null) to denote 88 -- the given tree (which may be null), and set the given tree to 89 -- the original child of the tree. If it is not null, the parent 90 -- of the new child of the tree is set to be the root of the tree. 91 -- If it is not null, the parent of the new root of the given tree 92 -- is set to be null. 93 94 procedure Child (T : in out Multiway_Tree; Child : in Positive); 95 -- The tree must not be null. Set the tree to now denote the given 96 -- child (which may be null) and reclaim the storage associated 97 -- with any unreachable items. 98 99 procedure Parent (T : in out Multiway_Tree); 100 -- Set the tree to now denote its parent (if any). 101 102 procedure Set_Item (T : in out Multiway_Tree; Elem : in Item); 103 -- Set the item at the root of the tree. 104 105 function Arity (T : Multiway_Tree) return Natural; 106 -- Return the number of children relative to the root of the tree. 107 108 function Has_Children (T : in Multiway_Tree) return Boolean; 109 -- Return True if and only if the tree has any non-null children. 110 111 function Is_Null (T : in Multiway_Tree) return Boolean; 112 -- Return True if and only if the tree has no items. 113 114 function Is_Shared (T : in Multiway_Tree) return Boolean; 115 -- Return True if and only if the tree has an alias. 116 117 function Is_Root (T : in Multiway_Tree) return Boolean; 118 -- Return True if and only if the tree is at the root of a tree. 119 120 function Item_At (T : in Multiway_Tree) return Item; 121 -- Return the item at the root of the tree. 122 123private 124 125 -- Type denoting a simple node consisting of an item, a pointer to 126 -- the parent, pointers to the child and sibling items, and a 127 -- reference count 128 129 type Multiway_Node; 130 type Multiway_Node_Ref is access Multiway_Node; 131 for Multiway_Node_Ref'Storage_Pool use Storage; 132 133 type Multiway_Node is record 134 Element : Item; 135 Parent, Child, Sibling : Multiway_Node_Ref; 136 Count : Natural := 1; 137 end record; 138 139 type Multiway_Tree is new Ada.Finalization.Controlled with record 140 Rep : Multiway_Node_Ref; 141 end record; 142 143 procedure Initialize (T : in out Multiway_Tree); 144 procedure Adjust (T : in out Multiway_Tree); 145 procedure Finalize (T : in out Multiway_Tree); 146 147end BC.Containers.Trees.Multiway; 148