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