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