|
|
@@ -0,0 +1,757 @@
|
|
|
+ClassDecl ::=
|
|
|
+ CLASS Classidentifier['(' Name { ',' Name } ')'] ';'
|
|
|
+ [ClassFieldDefList]
|
|
|
+ [MethodDecList]
|
|
|
+ END Classidentifier ';'
|
|
|
+
|
|
|
+ClassFieldDefList ::=
|
|
|
+ ClassFieldDef {';' ClassFieldDef }
|
|
|
+
|
|
|
+ClassFieldDef ::=
|
|
|
+ IdentifierList ':' TypeDef |
|
|
|
+ Identifier '=' Name
|
|
|
+
|
|
|
+MethodDecList ::=
|
|
|
+ MethodDec {',' MethodDec }
|
|
|
+
|
|
|
+MethodDec ::=
|
|
|
+ [VIRTUAL] PEOCEDURE MethodIdentifier
|
|
|
+ [FormalList [':' Name ]]
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+Example:
|
|
|
+
|
|
|
+(* ========================================== *)
|
|
|
+(* (c) 1990-1992 Clarion Software Corporation *)
|
|
|
+(* ========================================== *)
|
|
|
+
|
|
|
+DEFINITION MODULE Table;
|
|
|
+
|
|
|
+(*
|
|
|
+
|
|
|
+ This module implements classes that allow the creation and maintenance
|
|
|
+ of homogeneous tables of ordered objects. The internal structure of the
|
|
|
+ table is an AVL Balanced Tree. The algorithms are based on an example
|
|
|
+ given in Niklaus Wirth's "Algorithms + Data Structures = Programs". That
|
|
|
+ book also gives a detailed description of AVL Balanced Trees.
|
|
|
+
|
|
|
+*)
|
|
|
+
|
|
|
+TYPE
|
|
|
+
|
|
|
+ BalanceFlag = SHORTINT [-1..1];
|
|
|
+
|
|
|
+ ElementPtr = POINTER TO Element;
|
|
|
+
|
|
|
+ CLASS Element;
|
|
|
+
|
|
|
+ Right : ElementPtr; (* Pointer to right sub-tree *)
|
|
|
+ Left : ElementPtr; (* Pointer to left sub-tree *)
|
|
|
+ Bal : BalanceFlag; (* Tree balance flag *)
|
|
|
+
|
|
|
+ VIRTUAL PROCEDURE Compare( p : ElementPtr ) : INTEGER;
|
|
|
+ (*
|
|
|
+ Must be implemented by the client. This
|
|
|
+ procedure should return one of the
|
|
|
+ following integer values:
|
|
|
+
|
|
|
+ <0 if 'THIS' is less than 'p'
|
|
|
+ 0 if 'THIS' is equal to 'p'
|
|
|
+ >0 if 'THIS' is greater than 'p'
|
|
|
+ *)
|
|
|
+
|
|
|
+ END Element ;
|
|
|
+
|
|
|
+TYPE
|
|
|
+
|
|
|
+ Action = PROCEDURE ( ElementPtr );
|
|
|
+ (* This procedure type is used by 'Apply' *)
|
|
|
+
|
|
|
+ CLASS TABLE;
|
|
|
+
|
|
|
+ Root : ElementPtr; (* The root of this tree *)
|
|
|
+
|
|
|
+ PROCEDURE Insert( VAR x : Element );
|
|
|
+ (* Insert the element 'x' into this table *)
|
|
|
+ PROCEDURE Find( VAR p : Element ) : BOOLEAN;
|
|
|
+ (* Search table for a element matching 'p'.
|
|
|
+ Returns 'TRUE' and sets all fields of 'p' if
|
|
|
+ found; otherwise returns 'FALSE'
|
|
|
+ *)
|
|
|
+ PROCEDURE Delete( VAR x : Element );
|
|
|
+ (* Delete the element matching 'p' from table *)
|
|
|
+ PROCEDURE Apply( p : Action );
|
|
|
+ (* Apply procedure 'p' to all elements in order *)
|
|
|
+ PROCEDURE Init;
|
|
|
+ (* Initialize the table *)
|
|
|
+ PROCEDURE Eq( t2 : TABLE ) : INTEGER;
|
|
|
+ (* Compare 'THIS' with 't2'. The return values
|
|
|
+ are:
|
|
|
+
|
|
|
+ <0 'THIS' is less than 't2'
|
|
|
+ 0 'THIS' is equal to 't2'
|
|
|
+ >0 'THIS' is greater than 't2'
|
|
|
+
|
|
|
+ ** RESTRICTION : Table must not generate a
|
|
|
+ tree greater than 32 levels deep (around
|
|
|
+ 2^32 elements
|
|
|
+ *)
|
|
|
+ PROCEDURE SubSet( t2 : TABLE ) : BOOLEAN;
|
|
|
+ (* Are the elements in this table a subset of
|
|
|
+ the elememts in table 't2'? *)
|
|
|
+ PROCEDURE Copy() : TABLE;
|
|
|
+ (* Make a copy this table *)
|
|
|
+ PROCEDURE Incl( t2 : TABLE );
|
|
|
+ (* Include elements from table 't2' in this
|
|
|
+ table *)
|
|
|
+ PROCEDURE Excl( t2 : TABLE );
|
|
|
+ (* Exclude elements from table 't2' from this
|
|
|
+ table *)
|
|
|
+ PROCEDURE Empty() : BOOLEAN;
|
|
|
+ (* Is this table empty? *)
|
|
|
+ PROCEDURE Dispose;
|
|
|
+ (* Dispose of all elements of this table *)
|
|
|
+
|
|
|
+ END TABLE ;
|
|
|
+
|
|
|
+END Table.
|
|
|
+
|
|
|
+
|
|
|
+(* ==================================================== *)
|
|
|
+(* Copyright (C) 1990-1992 Clarion Software Corporation *)
|
|
|
+(* ==================================================== *)
|
|
|
+
|
|
|
+IMPLEMENTATION MODULE Table;
|
|
|
+
|
|
|
+ IMPORT Lib;
|
|
|
+ FROM Storage IMPORT ALLOCATE, DEALLOCATE;
|
|
|
+
|
|
|
+
|
|
|
+ CLASS IMPLEMENTATION Element;
|
|
|
+
|
|
|
+ VIRTUAL PROCEDURE Compare( p : ElementPtr ) : INTEGER;
|
|
|
+ (* It is an error not to supply an implementation of this
|
|
|
+ method. The client MUST supply a method to compare
|
|
|
+ 'THIS' with 'p'.
|
|
|
+ *)
|
|
|
+ BEGIN
|
|
|
+ Lib.FatalError(' implemeted by client ');
|
|
|
+ RETURN 0;
|
|
|
+ END Compare;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ END Element ;
|
|
|
+
|
|
|
+ CLASS GenElem (Element) ;
|
|
|
+ GenericData : CHAR;
|
|
|
+ END GenElem;
|
|
|
+
|
|
|
+ CLASS IMPLEMENTATION GenElem;
|
|
|
+ BEGIN
|
|
|
+ END GenElem;
|
|
|
+
|
|
|
+TYPE
|
|
|
+ GenElemPtr = POINTER TO GenElem;
|
|
|
+ (* The above definitions are a skeleton for all the
|
|
|
+ implementation of the 'Element' CLASS. This enables
|
|
|
+ the 'TABLE' class to successfully copy any client
|
|
|
+ implementation of 'Element'
|
|
|
+ *)
|
|
|
+
|
|
|
+
|
|
|
+ CLASS IMPLEMENTATION TABLE;
|
|
|
+
|
|
|
+ PROCEDURE Insert( VAR x : Element );
|
|
|
+ (* Insert a new element 'x' in 'THIS' table *)
|
|
|
+
|
|
|
+ PROCEDURE Search( VAR p : ElementPtr; VAR h : BOOLEAN);
|
|
|
+ (* Searches a tree 'p' for the element 'x'. If it is found
|
|
|
+ then the new value replaces the old. If 'x' is not
|
|
|
+ in the tree, then 'x' becomes a new leaf of the tree.
|
|
|
+ *)
|
|
|
+ VAR
|
|
|
+ p1 : ElementPtr;
|
|
|
+ p2 : ElementPtr;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ IF (p = NIL) THEN (* Create new leaf *)
|
|
|
+ ALLOCATE(p,SIZE(x));
|
|
|
+ Lib.Move(ADR(x),p,SIZE(x));
|
|
|
+ p^.Bal := 0;
|
|
|
+ p^.Left := NIL;
|
|
|
+ p^.Right := NIL;
|
|
|
+ h := TRUE; (* Tree requires balancing *)
|
|
|
+ ELSE
|
|
|
+ IF (x.Compare(p) < 0) THEN (* 'THIS' is < 'p' *)
|
|
|
+ (* Search the 'Left' branch of 'p' recursively
|
|
|
+ until 'x' is either found or created.
|
|
|
+ *)
|
|
|
+ Search(p^.Left,h);
|
|
|
+ IF h THEN (* i.e. requires balancing *)
|
|
|
+ CASE p^.Bal OF
|
|
|
+ | 1 :
|
|
|
+ p^.Bal := 0;
|
|
|
+ h := FALSE;
|
|
|
+ | 0 :
|
|
|
+ p^.Bal := -1;
|
|
|
+ | -1 :
|
|
|
+ p1 := p^.Left;
|
|
|
+ IF (p1^.Bal = -1) THEN
|
|
|
+ p^.Left := p1^.Right;
|
|
|
+ p1^.Right := p;
|
|
|
+ p^.Bal := 0;
|
|
|
+ p := p1;
|
|
|
+ ELSE
|
|
|
+ p2 := p1^.Right;
|
|
|
+ p1^.Right := p2^.Left;
|
|
|
+ p2^.Left := p1;
|
|
|
+ p^.Left := p2^.Right;
|
|
|
+ p2^.Right := p;
|
|
|
+ IF (p2^.Bal = -1) THEN
|
|
|
+ p^.Bal := 1;
|
|
|
+ ELSE
|
|
|
+ p^.Bal := 0;
|
|
|
+ END;
|
|
|
+ IF (p2^.Bal = 1) THEN
|
|
|
+ p1^.Bal := -1;
|
|
|
+ ELSE
|
|
|
+ p1^.Bal := 0;
|
|
|
+ END;
|
|
|
+ p := p2;
|
|
|
+ END;
|
|
|
+ p^.Bal := 0;
|
|
|
+ h := FALSE; (* Balancing done *)
|
|
|
+ END (* CASE *);
|
|
|
+ END (* of balancing 'Left' sub-tree *);
|
|
|
+ ELSIF (x.Compare(p) > 0) THEN (* 'THIS' > 'p' *)
|
|
|
+ (* Search the 'Right' branch of 'p' recursively
|
|
|
+ until 'x' is either found or created.
|
|
|
+ *)
|
|
|
+ Search( p^.Right,h);
|
|
|
+ IF h THEN (* i.e. tree needs balancing *)
|
|
|
+ CASE p^.Bal OF
|
|
|
+ | -1 :
|
|
|
+ p^.Bal := 0;
|
|
|
+ h := FALSE;
|
|
|
+ | 0 :
|
|
|
+ p^.Bal := 1;
|
|
|
+ | 1 :
|
|
|
+ p1 := p^.Right;
|
|
|
+ IF (p1^.Bal = 1) THEN
|
|
|
+ p^.Right := p1^.Left;
|
|
|
+ p1^.Left := p;
|
|
|
+ p^.Bal := 0;
|
|
|
+ p := p1;
|
|
|
+ ELSE
|
|
|
+ p2 := p1^.Left;
|
|
|
+ p1^.Left := p2^.Right;
|
|
|
+ p2^.Right := p1;
|
|
|
+ p^.Right := p2^.Left;
|
|
|
+ p2^.Left := p;
|
|
|
+ IF (p2^.Bal = 1) THEN
|
|
|
+ p^.Bal := -1;
|
|
|
+ ELSE
|
|
|
+ p^.Bal := 0;
|
|
|
+ END;
|
|
|
+ IF (p2^.Bal = -1) THEN
|
|
|
+ p1^.Bal := 1;
|
|
|
+ ELSE
|
|
|
+ p1^.Bal := 0;
|
|
|
+ END;
|
|
|
+ p := p2;
|
|
|
+ END;
|
|
|
+ p^.Bal := 0;
|
|
|
+ h := FALSE; (* Tree balanced *)
|
|
|
+ END (* CASE *);
|
|
|
+ END (* Balancing 'Right' sub-tree *);
|
|
|
+ ELSE (* 'THIS' and 'p' are the same *)
|
|
|
+ h := FALSE;
|
|
|
+ Lib.Move(ADR(GenElemPtr(ADR(x))^.GenericData),
|
|
|
+ ADR(GenElemPtr(p)^.GenericData),
|
|
|
+ SIZE(x)-VSIZE(Element.Bal));
|
|
|
+ END (* Possible comaprison results *);
|
|
|
+ END;
|
|
|
+ END Search;
|
|
|
+
|
|
|
+ VAR
|
|
|
+ h : BOOLEAN;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ IF (Root # NIL) AND (ADR(Root^.Compare) # ADR(x.Compare)) THEN
|
|
|
+ (* All table elements must be homogeneous; i.e. they must be of
|
|
|
+ the same CLASS
|
|
|
+ *)
|
|
|
+ Lib.FatalError('object not compatible with table');
|
|
|
+ END;
|
|
|
+ Search(Root,h);
|
|
|
+ END Insert;
|
|
|
+
|
|
|
+ PROCEDURE Find( VAR x : Element ) : BOOLEAN;
|
|
|
+ (* Search for 'x' in 'THIS' tree; if 'x' is found in
|
|
|
+ 'THIS' tree then the function returns 'TRUE' and 'x'
|
|
|
+ is set to the mathing element. Otherwise the
|
|
|
+ method returns 'FALSE'.
|
|
|
+ *)
|
|
|
+
|
|
|
+ PROCEDURE _Find( r : ElementPtr ) : ElementPtr;
|
|
|
+ (* Implements the search algorithm *)
|
|
|
+ BEGIN
|
|
|
+ LOOP
|
|
|
+ IF (r = NIL) THEN (* No match *)
|
|
|
+ RETURN r;
|
|
|
+ ELSIF (x.Compare(r) < 0) THEN (* 'THIS' < r *)
|
|
|
+ r := r^.Left;
|
|
|
+ ELSIF (x.Compare(r) > 0) THEN (* 'THIS' > r *)
|
|
|
+ r := r^.Right;
|
|
|
+ ELSE (* FOUND IT! *)
|
|
|
+ RETURN r;
|
|
|
+ END;
|
|
|
+ END (* LOOP *);
|
|
|
+ END _Find;
|
|
|
+
|
|
|
+ VAR
|
|
|
+ p : ElementPtr;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ p := _Find(Root);
|
|
|
+ IF (p # NIL) THEN (* Element Located *)
|
|
|
+ Lib.Move(p,ADR(x),SIZE(x));
|
|
|
+ RETURN TRUE;
|
|
|
+ ELSE
|
|
|
+ RETURN FALSE;
|
|
|
+ END;
|
|
|
+ END Find;
|
|
|
+
|
|
|
+ PROCEDURE Delete( VAR x : Element );
|
|
|
+ (* Locate the element 'x' in 'THIS' tree and delete it *)
|
|
|
+ VAR
|
|
|
+ q : ElementPtr;
|
|
|
+
|
|
|
+ PROCEDURE r_Balance( VAR p : ElementPtr; VAR h : BOOLEAN);
|
|
|
+ (* Blance a right sub-tree *)
|
|
|
+ VAR
|
|
|
+ p1 : ElementPtr;
|
|
|
+ p2 : ElementPtr;
|
|
|
+ b1 : BalanceFlag;
|
|
|
+ b2 : BalanceFlag;
|
|
|
+ BEGIN
|
|
|
+ CASE p^.Bal OF
|
|
|
+ | -1 :
|
|
|
+ p^.Bal := 0;
|
|
|
+ | 0 :
|
|
|
+ p^.Bal := 1;
|
|
|
+ h := FALSE;
|
|
|
+ | 1 :
|
|
|
+ p1 := p^.Right;
|
|
|
+ b1 := p1^.Bal;
|
|
|
+ IF (b1 >= 0) THEN
|
|
|
+ p^.Right := p1^.Left;
|
|
|
+ p1^.Left := p;
|
|
|
+ IF (b1 = 0) THEN
|
|
|
+ p^.Bal := 1;
|
|
|
+ p1^.Bal := -1;
|
|
|
+ h := FALSE
|
|
|
+ ELSE
|
|
|
+ p^.Bal := 0;
|
|
|
+ p1^.Bal := 0;
|
|
|
+ END;
|
|
|
+ p := p1;
|
|
|
+ ELSE
|
|
|
+ p2 := p1^.Left;
|
|
|
+ b2 := p2^.Bal;
|
|
|
+ p1^.Left := p2^.Right;
|
|
|
+ p2^.Right := p1;
|
|
|
+ p^.Right := p2^.Left;
|
|
|
+ p2^.Left := p;
|
|
|
+ IF (b2 = 1) THEN
|
|
|
+ p^.Bal := -1;
|
|
|
+ ELSE
|
|
|
+ p^.Bal := 0;
|
|
|
+ END;
|
|
|
+ IF (b2 = -1) THEN
|
|
|
+ p1^.Bal := 1;
|
|
|
+ ELSE
|
|
|
+ p1^.Bal := 0;
|
|
|
+ END;
|
|
|
+ p := p2;
|
|
|
+ p2^.Bal := 0;
|
|
|
+ END;
|
|
|
+ END (* CASE *);
|
|
|
+ END r_Balance;
|
|
|
+
|
|
|
+ PROCEDURE l_Balance( VAR p : ElementPtr; VAR h : BOOLEAN);
|
|
|
+ (* Balance a left sub-tree *)
|
|
|
+ VAR
|
|
|
+ p1 : ElementPtr;
|
|
|
+ p2 : ElementPtr;
|
|
|
+ b1 : BalanceFlag;
|
|
|
+ b2 : BalanceFlag;
|
|
|
+ BEGIN
|
|
|
+ CASE p^.Bal OF
|
|
|
+ | 1 :
|
|
|
+ p^.Bal := 0;
|
|
|
+ | 0 :
|
|
|
+ p^.Bal := -1;
|
|
|
+ h := FALSE;
|
|
|
+ | -1 :
|
|
|
+ p1 := p^.Left;
|
|
|
+ b1 := p1^.Bal;
|
|
|
+ IF (b1 <= 0) THEN
|
|
|
+ p^.Left := p1^.Right;
|
|
|
+ p1^.Right := p;
|
|
|
+ IF (b1 = 0) THEN
|
|
|
+ p^.Bal := -1;
|
|
|
+ p1^.Bal := 1;
|
|
|
+ h := FALSE
|
|
|
+ ELSE
|
|
|
+ p^.Bal := 0;
|
|
|
+ p1^.Bal := 0;
|
|
|
+ END;
|
|
|
+ p := p1;
|
|
|
+ ELSE
|
|
|
+ p2 := p1^.Right;
|
|
|
+ b2 := p2^.Bal;
|
|
|
+ p1^.Right := p2^.Left;
|
|
|
+ p2^.Left := p1;
|
|
|
+ p^.Left := p2^.Right;
|
|
|
+ p2^.Right := p;
|
|
|
+ IF (b2 = -1) THEN
|
|
|
+ p^.Bal := 1;
|
|
|
+ ELSE
|
|
|
+ p^.Bal := 0;
|
|
|
+ END;
|
|
|
+ IF (b2 = 1) THEN
|
|
|
+ p1^.Bal := -1;
|
|
|
+ ELSE
|
|
|
+ p1^.Bal := 0;
|
|
|
+ END;
|
|
|
+ p := p2;
|
|
|
+ p2^.Bal := 0;
|
|
|
+ END;
|
|
|
+ END (* CASE *);
|
|
|
+ END l_Balance;
|
|
|
+
|
|
|
+ PROCEDURE DeleteLeaf( VAR r : ElementPtr; VAR h : BOOLEAN );
|
|
|
+ (* Recursively search for extreme right-hand node of
|
|
|
+ the sub-tree 'r' and move data into 'q'
|
|
|
+ *)
|
|
|
+ BEGIN
|
|
|
+ IF (r^.Right # NIL) THEN
|
|
|
+ DeleteLeaf(r^.Right,h);
|
|
|
+ IF h THEN
|
|
|
+ l_Balance(r,h);
|
|
|
+ END;
|
|
|
+ ELSE
|
|
|
+ Lib.Move(ADR(GenElemPtr(r)^.GenericData),
|
|
|
+ ADR(GenElemPtr(q)^.GenericData),
|
|
|
+ SIZE(x)-VSIZE(Element.Bal));
|
|
|
+ q := r;
|
|
|
+ r := r^.Left;
|
|
|
+ h := TRUE;
|
|
|
+ END;
|
|
|
+ END DeleteLeaf;
|
|
|
+
|
|
|
+ PROCEDURE _Delete( VAR p : ElementPtr; VAR h : BOOLEAN );
|
|
|
+ (* Main recursive deletion procedure *)
|
|
|
+ BEGIN
|
|
|
+ IF (p = NIL) THEN (* Not found *)
|
|
|
+ h := FALSE;
|
|
|
+ ELSIF (x.Compare(p) < 0) THEN (* 'THIS' < 'p' *)
|
|
|
+ _Delete(p^.Left,h);
|
|
|
+ IF h THEN
|
|
|
+ r_Balance(p,h);
|
|
|
+ END;
|
|
|
+ ELSIF (x.Compare(p) > 0) THEN (* 'THIS' > 'p' *)
|
|
|
+ _Delete(p^.Right,h);
|
|
|
+ IF h THEN
|
|
|
+ l_Balance(p,h);
|
|
|
+ END;
|
|
|
+ ELSE (* Found it! *)
|
|
|
+ q := p;
|
|
|
+ IF (q^.Right = NIL) THEN
|
|
|
+ p := q^.Left;
|
|
|
+ h := TRUE;
|
|
|
+ ELSIF (q^.Left = NIL) THEN
|
|
|
+ p := q^.Right;
|
|
|
+ h := TRUE;
|
|
|
+ ELSE
|
|
|
+ DeleteLeaf(q^.Left,h);
|
|
|
+ IF h THEN
|
|
|
+ r_Balance(p,h);
|
|
|
+ END;
|
|
|
+ END;
|
|
|
+ DISPOSE(q);
|
|
|
+ END;
|
|
|
+ END _Delete;
|
|
|
+
|
|
|
+ VAR
|
|
|
+ h : BOOLEAN;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ IF (Root = NIL) THEN
|
|
|
+ RETURN;
|
|
|
+ END;
|
|
|
+ IF (Root # NIL) AND (ADR(x.Compare) # ADR(Root^.Compare)) THEN
|
|
|
+ (* 'x' is not the same type as tree members *)
|
|
|
+ Lib.FatalError('object not compatible with table');
|
|
|
+ END;
|
|
|
+ _Delete(Root,h);
|
|
|
+ END Delete;
|
|
|
+
|
|
|
+ PROCEDURE Apply( p : Action );
|
|
|
+ (* Apply a procedure to all table elements in order *)
|
|
|
+
|
|
|
+ PROCEDURE ApplyToElement( s : ElementPtr );
|
|
|
+ (* Apply 'p' to left sub-tree of s, then s, then the
|
|
|
+ right sub-tree of s.
|
|
|
+ *)
|
|
|
+ BEGIN
|
|
|
+ IF (s = NIL) THEN
|
|
|
+ RETURN;
|
|
|
+ ELSE
|
|
|
+ ApplyToElement(s^.Left);
|
|
|
+ p(s);
|
|
|
+ ApplyToElement(s^.Right);
|
|
|
+ END;
|
|
|
+ END ApplyToElement;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ ApplyToElement(Root);
|
|
|
+ END Apply;
|
|
|
+
|
|
|
+ PROCEDURE Init;
|
|
|
+ (* Initialise a tree *)
|
|
|
+ BEGIN
|
|
|
+ Root := NIL;
|
|
|
+ END Init;
|
|
|
+
|
|
|
+
|
|
|
+ PROCEDURE Eq( t2 : TABLE ) : INTEGER;
|
|
|
+ (* Compare 'THIS' to 't2'. Return values:
|
|
|
+
|
|
|
+ <0 'THIS' is less than 't2'
|
|
|
+ 0 'THIS' is equal to 't2'
|
|
|
+ >0 'THIS' is greater than 't2'
|
|
|
+
|
|
|
+ The trees are searched from the bottom up (i.e. in
|
|
|
+ order) and the elements compared. The procedure
|
|
|
+ returns immediately a difference is detected or
|
|
|
+ when both trees are exhausted (and, therefore, they
|
|
|
+ must be equal). This process is implemented iteratively
|
|
|
+ rather than recursively.
|
|
|
+ *)
|
|
|
+
|
|
|
+ VAR
|
|
|
+ S1,
|
|
|
+ S2 : ARRAY [1..32] OF ElementPtr;
|
|
|
+ r1,
|
|
|
+ r2 : ElementPtr;
|
|
|
+ sp1,
|
|
|
+ sp2 : CARDINAL;
|
|
|
+ res : INTEGER;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ r1 := Root;
|
|
|
+ r2 := t2.Root;
|
|
|
+ IF (r1 # NIL) AND (r1 # r2) AND (ADR(r1^.Compare) # ADR(r2^.Compare)) THEN
|
|
|
+ (* Both trees must contain the same sort of element *)
|
|
|
+ Lib.FatalError(' not compareable ');
|
|
|
+ END;
|
|
|
+ sp1 := 0;
|
|
|
+ sp2 := 0;
|
|
|
+ LOOP
|
|
|
+ WHILE (r1 # NIL) DO (* Build left edge array for 'THIS' *)
|
|
|
+ INC(sp1);
|
|
|
+ S1[sp1] := r1;
|
|
|
+ r1 := r1^.Left;
|
|
|
+ END;
|
|
|
+ WHILE (r2 # NIL) DO (* Build left edge array for 't2' *)
|
|
|
+ INC(sp2);
|
|
|
+ S2[sp2] := r2;
|
|
|
+ r2 := r2^.Left;
|
|
|
+ END;
|
|
|
+ IF (sp1 = 0) THEN (* No left sub-tree for 'THIS' *)
|
|
|
+ IF (sp2 = 0) THEN (* No left sub-tree for 't2' *)
|
|
|
+ RETURN 0; (* Implies they are equal *)
|
|
|
+ ELSE
|
|
|
+ RETURN -1; (* 'THIS' < 't2' *)
|
|
|
+ END;
|
|
|
+ ELSIF (sp2 = 0) THEN (* No left sub-tree for 't2' *)
|
|
|
+ RETURN 1; (* 'THIS' > 't2' *)
|
|
|
+ ELSE
|
|
|
+ r1 := S1[sp1];
|
|
|
+ DEC(sp1);
|
|
|
+ r2 := S2[sp2];
|
|
|
+ DEC(sp2);
|
|
|
+ END;
|
|
|
+ res := r1^.Compare(r2); (* Compare extreme left of both *)
|
|
|
+ IF (res # 0) THEN (* These are different! *)
|
|
|
+ RETURN res; (* Return how they are different *)
|
|
|
+ END;
|
|
|
+ r1 := r1^.Right;
|
|
|
+ r2 := r2^.Right;
|
|
|
+ END (* LOOP *);
|
|
|
+ END Eq;
|
|
|
+
|
|
|
+ PROCEDURE SubSet( t2 : TABLE ) : BOOLEAN;
|
|
|
+ (* Are the elements of 'THIS' table a sub set of the elements
|
|
|
+ of the table 't2'?
|
|
|
+ The procedure scans scans the trees in order looking for
|
|
|
+ an initial point of equality. Then 'THIS' is compared to
|
|
|
+ this sub-tree of 't2' until either an element greater than
|
|
|
+ the current 'THIS' element is found, or 'THIS' is exhuasted.
|
|
|
+ The process is implemented iteratively rather than
|
|
|
+ recursively.
|
|
|
+ *)
|
|
|
+ VAR
|
|
|
+ S1,
|
|
|
+ S2 : ARRAY [1..32] OF ElementPtr;
|
|
|
+ r1,
|
|
|
+ r2,
|
|
|
+ cr : ElementPtr;
|
|
|
+ sp1,
|
|
|
+ sp2 : CARDINAL;
|
|
|
+ res : INTEGER;
|
|
|
+ BEGIN
|
|
|
+ IF (Root # NIL) AND (t2.Root # Root) AND (ADR(Root^.Compare) # ADR(t2.Root^.Compare)) THEN
|
|
|
+ (* Both trees must contain the same type of element *)
|
|
|
+ Lib.FatalError('different types');
|
|
|
+ END;
|
|
|
+ r1 := Root;
|
|
|
+ r2 := t2.Root;
|
|
|
+ sp1 := 0;
|
|
|
+ sp2 := 0;
|
|
|
+ LOOP
|
|
|
+ WHILE (r1 # NIL) DO
|
|
|
+ INC(sp1);
|
|
|
+ S1[sp1] := r1;
|
|
|
+ r1 := r1^.Left;
|
|
|
+ END;
|
|
|
+ IF (sp1 = 0) THEN (* End of 'THIS' => is a sub-tree *)
|
|
|
+ RETURN TRUE;
|
|
|
+ END;
|
|
|
+ r1 := S1[sp1];
|
|
|
+ DEC(sp1);
|
|
|
+ cr := r1;
|
|
|
+ r1 := r1^.Right;
|
|
|
+ LOOP
|
|
|
+ WHILE (r2 # NIL) DO
|
|
|
+ INC(sp2);
|
|
|
+ S2[sp2] := r2;
|
|
|
+ r2 := r2^.Left;
|
|
|
+ END;
|
|
|
+ IF (sp2 = 0) THEN (* End of 't2' => not a sub-tree *)
|
|
|
+ RETURN FALSE;
|
|
|
+ ELSE
|
|
|
+ r2 := S2[sp2];
|
|
|
+ DEC(sp2);
|
|
|
+ END;
|
|
|
+ res := cr^.Compare(r2);
|
|
|
+ r2 := r2^.Right;
|
|
|
+ IF (res < 0) THEN
|
|
|
+ RETURN FALSE;
|
|
|
+ ELSIF (res = 0) THEN
|
|
|
+ EXIT;
|
|
|
+ END;
|
|
|
+ END (* LOOP *);
|
|
|
+ END (* LOOP *);
|
|
|
+ END SubSet;
|
|
|
+
|
|
|
+ PROCEDURE Copy() : TABLE;
|
|
|
+ (* Make a copy of 'THIS' *)
|
|
|
+
|
|
|
+ PROCEDURE _Copy( r : ElementPtr ) : ElementPtr;
|
|
|
+ (* Recursively generate a copy of 'r' *)
|
|
|
+ VAR
|
|
|
+ x : ElementPtr;
|
|
|
+ BEGIN
|
|
|
+ IF (r # NIL) THEN
|
|
|
+ ALLOCATE(x,SIZE(r^));
|
|
|
+ Lib.Move(r,x,SIZE(r^));
|
|
|
+ x^.Left := _Copy(r^.Left);
|
|
|
+ x^.Right := _Copy(r^.Right);
|
|
|
+ RETURN x;
|
|
|
+ ELSE
|
|
|
+ RETURN r;
|
|
|
+ END;
|
|
|
+ END _Copy;
|
|
|
+
|
|
|
+ VAR
|
|
|
+ NewTree : TABLE;
|
|
|
+ BEGIN
|
|
|
+ NewTree.Root := _Copy(Root);
|
|
|
+ RETURN NewTree;
|
|
|
+ END Copy;
|
|
|
+
|
|
|
+ PROCEDURE Incl( t2 : TABLE);
|
|
|
+ (* Include 't2' in 'THIS' tree *)
|
|
|
+
|
|
|
+ PROCEDURE _Incl( r : ElementPtr );
|
|
|
+ (* Recursively insert 'r' into 'THIS' *)
|
|
|
+ BEGIN
|
|
|
+ IF (r # NIL) THEN
|
|
|
+ _Incl(r^.Left);
|
|
|
+ _Incl(r^.Right);
|
|
|
+ Insert(r^);
|
|
|
+ END;
|
|
|
+ END _Incl;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ IF (Root # NIL) AND (t2.Root # Root) AND (ADR(Root^.Compare) # ADR(t2.Root^.Compare)) THEN
|
|
|
+ Lib.FatalError('different types');
|
|
|
+ END;
|
|
|
+ _Incl(t2.Root);
|
|
|
+ END Incl;
|
|
|
+
|
|
|
+
|
|
|
+ PROCEDURE Excl( t2 : TABLE);
|
|
|
+ (* Exclude elements of 't2' from 'THIS' *)
|
|
|
+
|
|
|
+ PROCEDURE _Excl( r: ElementPtr );
|
|
|
+ (* Recursively exclude 'r' from 'THIS' *)
|
|
|
+ BEGIN
|
|
|
+ IF (r # NIL) THEN
|
|
|
+ _Excl(r^.Left);
|
|
|
+ _Excl(r^.Right);
|
|
|
+ Delete(r^);
|
|
|
+ END;
|
|
|
+ END _Excl;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ IF (Root # NIL) AND (t2.Root # Root) AND (ADR(Root^.Compare) # ADR(t2.Root^.Compare)) THEN
|
|
|
+ Lib.FatalError('different types');
|
|
|
+ END;
|
|
|
+ _Excl(t2.Root);
|
|
|
+ END Excl;
|
|
|
+
|
|
|
+ PROCEDURE Empty() : BOOLEAN;
|
|
|
+ (* Is 'THIS' empty? *)
|
|
|
+ BEGIN
|
|
|
+ RETURN (Root = NIL);
|
|
|
+ END Empty;
|
|
|
+
|
|
|
+ PROCEDURE Dispose;
|
|
|
+ (* Dispose of entire tree *)
|
|
|
+
|
|
|
+ PROCEDURE _Dispose( r : ElementPtr );
|
|
|
+ (* Recursively dispose of each element of 'r' *)
|
|
|
+ BEGIN
|
|
|
+ IF (r # NIL) THEN
|
|
|
+ _Dispose(r^.Left); (* Delete left sub-tree *)
|
|
|
+ _Dispose(r^.Right); (* Delete right sub-tree *)
|
|
|
+ DISPOSE(r);
|
|
|
+ END;
|
|
|
+ END _Dispose;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+ _Dispose(Root);
|
|
|
+ END Dispose;
|
|
|
+
|
|
|
+ BEGIN
|
|
|
+
|
|
|
+ END TABLE ;
|
|
|
+
|
|
|
+
|
|
|
+END Table.
|
|
|
+
|
