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