-- BinaryTreeImpl.mesa (from TreePack.mesa by Peter A. Arndt)
-- Implementation of a binary tree - that just stores a string per node
-- Alto/Mesa 6.1 version
-- Revised by Newman 16-Mar-83 16:03:39
DIRECTORY
BinaryTree USING [ReportProc, UserProc],
Inline USING [COPY],
PrincOps USING [Port],
String USING [--CopyToNewString, -- CompareStrings, LowerCase];
BinaryTreeImpl: PROGRAM
IMPORTS Inline, String
EXPORTS BinaryTree =
BEGIN
Sv: TYPE = STRING;
CopyToNewString: PROC [s: Sv, z: MDSZone] RETURNS [newS: Sv] =
{newS ← z.NEW [StringBody [s.length]];
Inline.COPY [from: @s.text, to: @newS.text, nwords: (s.length + 1)/2];
newS.length ← s.length};
--Tree object
Tree: TYPE = POINTER TO Object;
Object: PUBLIC TYPE = RECORD[
size: ARRAY SubtreeIndex OF CARDINAL ← ALL[0],
subtree: ARRAY SubtreeIndex OF Subtree ← ALL[NIL]];
SubtreeIndex: TYPE = {preAlpha, ac, df, gj, km, np, qs, tv, wz, postAlpha};
--Subtrees
Subtree: TYPE = POINTER TO Item;
Item: TYPE = RECORD [id: Sv, left, right: Subtree];
ProperSubtree: PROC [s: Sv] RETURNS [SubtreeIndex] =
BEGIN
RETURN[
SELECT String.LowerCase[s[0]] FROM
< 'a => preAlpha,
IN ['a..'c] => ac,
IN ['d..'f] => df,
IN ['g..'j] => gj,
IN ['k..'m] => km,
IN ['n..'p] => np,
IN ['q..'s] => qs,
IN ['t..'v] => tv,
IN ['w..'z] => wz,
ENDCASE => postAlpha];
END;
-- tree creation
Enter: PUBLIC PROC [tree: Tree, s: Sv, z: MDSZone]
RETURNS [Tree] =
BEGIN
entered: BOOLEAN;
index: SubtreeIndex = ProperSubtree[s];
IF tree = NIL THEN tree ← z.NEW [Object];
[tree.subtree[index], entered] ← EnterInSubtree[tree.subtree[index], s, z];
IF entered THEN tree.size[index] ← tree.size[index] + 1;
RETURN [tree];
END; -- of Enter
EnterInSubtree: PROC [tree: Subtree, s: Sv, z: MDSZone]
RETURNS [newTree: Subtree, entered: BOOLEAN ← TRUE] =
BEGIN
IF tree = NIL THEN tree ← MakeTree[s, z]
ELSE
BEGIN
t: Subtree ← tree;
DO
SELECT String.CompareStrings[s, t.id] FROM
-1 => IF t.left = NIL
THEN {t.left ← MakeTree[s, z]; EXIT}
ELSE t ← t.left;
1 => IF t.right = NIL
THEN {t.right ← MakeTree[s, z]; EXIT}
ELSE t ← t.right;
0 => {entered ← FALSE; EXIT}; --already in tree
ENDCASE;
ENDLOOP;
END;
RETURN [tree];
END; -- of proc Enter
MakeTree: PROC [s: Sv, z: MDSZone] RETURNS [tree: Subtree] =
BEGIN
tree ← z.NEW [Item ← [left: NIL, right: NIL, id: --String.--CopyToNewString [s, z]]];
END; -- of proc MakeTree
-- tree searching
Present: PUBLIC PROC [tree: Tree, s: Sv] RETURNS [present: BOOLEAN] =
BEGIN
n: Subtree;
IF tree = NIL THEN RETURN [FALSE];
n ← Find[tree.subtree[ProperSubtree[s]], s];
RETURN[n # NIL];
END; -- of proc Present
Find: PROC [tree: Subtree, s: Sv] RETURNS [n: Subtree] =
BEGIN
n ← tree;
UNTIL n = NIL DO
SELECT String.CompareStrings[s, n.id] FROM
-1 => n ← n.left;
1 => n ← n.right;
0 => EXIT;
ENDCASE;
ENDLOOP;
END; -- of proc Find
-- tree enumeration
-- PORT definitions
InPort: TYPE = PORT RETURNS [Sv];
OutPort: TYPE = PORT [Sv];
Starter: TYPE = PORT [tree: Tree, port: POINTER TO InPort] RETURNS [Sv];
CompareTrees: PUBLIC PROC [
first, second: Tree, report: BinaryTree.ReportProc] =
BEGIN
s1, s2: Sv;
In1, In2: InPort;
LOOPHOLE [In1, PrincOps.Port].out ← PortEnumerate;
LOOPHOLE [In2, PrincOps.Port].out ← PortEnumerate;
s1 ← LOOPHOLE [In1, Starter] [first, @In1];
s2 ← LOOPHOLE [In2, Starter] [second, @In2];
DO
IF s1 = NIL THEN {
WHILE s2 # NIL DO report[s2, second]; s2 ← In2[]; ENDLOOP;
EXIT};
IF s2 = NIL THEN {
WHILE s1 # NIL DO report[s1, first]; s1 ← In1[]; ENDLOOP;
EXIT};
SELECT String.CompareStrings[s1, s2] FROM
-1 => -- s1 < s2
{report[s1, first]; s1 ← In1[]; LOOP; };
0 => -- s1 = s2
{report[s1, both]; s1 ← In1[]; s2 ← In2[]; LOOP; };
1 => -- s1 > s2
{report[s2, second]; s2 ← In2[]; LOOP; };
ENDCASE => ERROR;
ENDLOOP;
END; -- of proc CompareTrees
--Call the port with each element of the tree. Return NIL when finished.
PortEnumerate: PROC [tree: Tree, inPort: POINTER TO InPort] RETURNS [Sv] =
BEGIN
Out: OutPort;
NextNode: BinaryTree.UserProc = {Out[id]};
LOOPHOLE [Out, PrincOps.Port].out ← inPort;
EnumerateTree [tree, NextNode];
RETURN [NIL]; --coroutine must not be called again after it returns NIL!
END; -- of PortEnumerate
EnumerateTree: PUBLIC PROC [tree: Tree, userProc: BinaryTree.UserProc] =
BEGIN
IF tree # NIL THEN
FOR i: SubtreeIndex IN SubtreeIndex DO Walk[tree.subtree[i], userProc]; ENDLOOP;
END; -- of proc EnumerateTree
Walk: PROC [start: Subtree, userProc: BinaryTree.UserProc] =
BEGIN
IF start = NIL THEN RETURN;
Walk[start.left, userProc];
userProc[start.id];
Walk[start.right, userProc];
END; -- of proc Walk
-- tree deletion
DestroyTree: PUBLIC PROC [tree: Tree, z: MDSZone] =
BEGIN
IF tree = NIL THEN RETURN;
FOR i: SubtreeIndex IN SubtreeIndex DO ReleaseTree[tree.subtree[i], z]; ENDLOOP;
z.FREE[@tree];
END; -- of proc DestroyTree
ReleaseTree: PROC [tree: Subtree, z: MDSZone] =
BEGIN
left, right: Subtree;
IF tree = NIL THEN RETURN;
left ← tree.left;
right ← tree.right;
z.FREE[@tree.id];
z.FREE[@tree];
ReleaseTree[left, z];
ReleaseTree[right, z];
END; -- of proc ReleaseTree
--tree merging
MergeTrees: PUBLIC PROC [first, second: Tree, z: MDSZone] RETURNS [Tree] =
BEGIN
IF second = NIL THEN RETURN [first];
IF first = NIL THEN RETURN [second];
FOR i: SubtreeIndex IN SubtreeIndex DO
from, into: Subtree;
size: CARDINAL;
IF first.size[i] < second.size[i]
THEN
{from ← first.subtree[i];
into ← second.subtree[i];
size ← second.size[i]}
ELSE
{from ← second.subtree[i];
into ← first.subtree[i];
size ← first.size[i]};
IF into = NIL
THEN into ← from
ELSE size ← size + WalkAndMerge [from: from, into: into, z: z];
--consumes "from"
first.subtree[i] ← into;
first.size[i] ← size;
ENDLOOP;
z.FREE [@second];
RETURN [first];
END; -- of MergeTrees
WalkAndMerge: PROC [from, into: Subtree, z: MDSZone] RETURNS [newEntries: CARDINAL] =
BEGIN
inserted: BOOLEAN;
--ASSERT into # NIL
IF from = NIL THEN RETURN [0];
newEntries ← WalkAndMerge [from: from.right, into: into, z: z];
--consumes from.right
newEntries ← newEntries + WalkAndMerge [from: from.left, into: into, z: z];
--consumes from.left
from.left ← from.right ← NIL;
inserted ← InsertSubtree [from: from, into: into];
IF inserted
THEN newEntries ← newEntries + 1
ELSE {z.FREE [@from.id]; z.FREE [@from]};
END; -- of WalkForMerge
InsertSubtree: PROC [from, into: Subtree] RETURNS [inserted: BOOLEAN] =
BEGIN
--ASSERT from # NIL AND into # NIL
DO
SELECT String.CompareStrings[from.id, into.id] FROM
-1 => IF into.left = NIL
THEN {into.left ← from; RETURN [TRUE]}
ELSE into ← into.left;
1 => IF into.right = NIL
THEN {into.right ← from; RETURN [TRUE]}
ELSE into ← into.right;
0 => RETURN [FALSE]; --already in tree
ENDCASE;
ENDLOOP;
END; -- of InsertSubtree
END.
28-Apr-82 14:40:40 - Newman - Created from TreePack.mesa by Peter A. Arndt.
7-Mar-83 18:26:37 - Newman - Convert to Sierra (remove Storage calls).
16-Mar-83 16:03:01 - Newman - Added zone parameters; change MergeTrees to avoid copying nodes and strings wherever possible.
5-May-83 16:56:11 - Newman - no LONGs, UNCOUNTED ZONE => MDSZone for Alto, had to write CopyToNewString.