-- file TreePack.Mesa
-- last modified by Satterthwaite, January 10, 1983 9:37 am

DIRECTORY
  Alloc: TYPE USING [
    Handle, Notifier, AddNotify, DropNotify, FreeChunk, GetChunk],
  Literals: TYPE USING [LitIndex],
  Symbols: TYPE USING [HTIndex, ISEIndex],
  Tree: TYPE USING [
    AttrId, Base, Finger, Id, Info, Index, Link, Map, Node, NodeName, Scan, Test,
    maxNSons, Null, NullIndex, treeType],
  TreeOps: TYPE USING [];
 
TreePack: PROGRAM
    IMPORTS Alloc 
    EXPORTS TreeOps =
 PUBLIC {

  endIndex: Tree.Index = Tree.Index.LAST;
  endMark: Tree.Link = [subtree[index: endIndex]];

  initialized: PRIVATE BOOL ← FALSE;

  table: PRIVATE Alloc.Handle;
  zone: PRIVATE UNCOUNTED ZONE ← NIL;
  
  LinkSeq: PRIVATE TYPE = RECORD [SEQUENCE length: CARDINAL OF Tree.Link];
  LinkStack: PRIVATE TYPE = LONG POINTER TO LinkSeq;

  stack: PRIVATE LinkStack;
  sI: PRIVATE CARDINAL;

  tb: PRIVATE Tree.Base;		-- tree base

  UpdateBase: PRIVATE Alloc.Notifier = {tb ← base[Tree.treeType]};


  Initialize: PROC [ownTable: Alloc.Handle, scratchZone: UNCOUNTED ZONE] = {
    IF initialized THEN Finalize[];
    zone ← scratchZone;
    stack ← zone.NEW[LinkSeq[250]];  sI ← 0;
    table ← ownTable;
    table.AddNotify[UpdateBase];
    IF MakeNode[$none,0] # Tree.Null THEN ERROR;	-- reserve null
    initialized ← TRUE};

  Reset: PROC = {
    IF initialized AND stack.length > 250 THEN {
      zone.FREE[@stack]; stack ← zone.NEW[LinkSeq[250]]}};

  Finalize: PROC = {
    table.DropNotify[UpdateBase]; table ← NIL;
    zone.FREE[@stack]; zone ← NIL;
    initialized ← FALSE};


  ExpandStack: PRIVATE PROC = {
    newStack: LinkStack = zone.NEW[LinkSeq[stack.length + 256]];
    FOR i: CARDINAL IN [0 .. stack.length) DO newStack[i] ← stack[i] ENDLOOP;
    zone.FREE[@stack];  stack ← newStack};


  PushTree: PROC [v: Tree.Link] = {
    IF sI >= stack.length THEN ExpandStack[];
    stack[sI] ← v;  sI ← sI+1};

  PopTree: PROC RETURNS [Tree.Link] = {RETURN [stack[sI←sI-1]]};


  InsertTree: PROC [v: Tree.Link, n: CARDINAL] = {
    i: CARDINAL;
    IF sI >= stack.length THEN ExpandStack[];
    i ← sI;  sI ← sI+1;
    THROUGH [1 .. n) DO stack[i] ← stack[i-1]; i ← i-1 ENDLOOP;
    stack[i] ← v};

  ExtractTree: PROC [n: CARDINAL] RETURNS [v: Tree.Link] = {
    i: CARDINAL ← sI - n;
    v ← stack[i];
    THROUGH [1 .. n) DO stack[i] ← stack[i+1]; i ← i+1 ENDLOOP;
    sI ← sI - 1;
    RETURN [v]};


  MakeNode: PROC [name: Tree.NodeName, count: INTEGER] RETURNS [Tree.Link] = {
    PushNode[name, count];  RETURN [PopTree[]]};

  MakeList: PROC [size: INTEGER] RETURNS [Tree.Link] = {
    PushList[size];  RETURN [PopTree[]]};


  PushNode: PROC [name: Tree.NodeName, count: INTEGER] = {
    nSons: CARDINAL = count.ABS;
    node: Tree.Index = table.GetChunk[Tree.Node.SIZE+nSons*Tree.Link.SIZE, Tree.treeType];
    i: CARDINAL;
    tb[node].name ← name;  tb[node].nSons ← nSons;
    tb[node].info ← 0;  tb[node].shared ← FALSE;
    tb[node].attr1 ← tb[node].attr2 ← tb[node].attr3 ← FALSE;
    IF count >= 0 THEN
      FOR i ← nSons, i-1 WHILE i >= 1 DO tb[node].son[i] ← stack[sI←sI-1] ENDLOOP
    ELSE
      FOR i ← 1, i+1 WHILE i <= nSons DO tb[node].son[i] ← stack[sI←sI-1] ENDLOOP;
    IF sI >= stack.length THEN ExpandStack[];
    stack[sI] ← [subtree[index: node]];  sI ← sI+1};

  PushList: PROC [size: INTEGER] = {
    nSons: CARDINAL = size.ABS;
    node: Tree.Index;
    i: CARDINAL;
    SELECT nSons FROM
      1 => NULL;
      0 => PushTree[Tree.Null];
      ENDCASE => {
	IF nSons IN (0..Tree.maxNSons] THEN
	  node ← table.GetChunk[Tree.Node.SIZE+nSons*Tree.Link.SIZE, Tree.treeType]
	ELSE {
	  node ← table.GetChunk[Tree.Node.SIZE+(nSons+1)*Tree.Link.SIZE, Tree.treeType];
	  tb[node].son[nSons+1] ← endMark};
	tb[node].name ← $list;
	tb[node].info ← 0;  tb[node].shared ← FALSE;
	tb[node].attr1 ← tb[node].attr2 ← tb[node].attr3 ← FALSE;
	tb[node].nSons ← IF nSons IN (0..Tree.maxNSons] THEN nSons ELSE 0;
	IF size > 0 THEN
	  FOR i ← nSons, i-1 WHILE i >= 1 DO tb[node].son[i] ← stack[sI←sI-1] ENDLOOP
	ELSE
	  FOR i ← 1, i+1 WHILE i <= nSons DO tb[node].son[i] ← stack[sI←sI-1] ENDLOOP;
	IF sI >= stack.length THEN ExpandStack[];
	stack[sI] ← [subtree[index: node]];  sI ← sI+1}};

  PushProperList: PROC [size: INTEGER] = {
    IF size IN [-1..1] THEN {
      node: Tree.Index = table.GetChunk[Tree.Node.SIZE+Tree.Link.SIZE, Tree.treeType];
      tb[node].name ← $list;
      tb[node].info ← 0;  tb[node].shared ← FALSE;
      tb[node].attr1 ← tb[node].attr2 ← tb[node].attr3 ← FALSE;
      tb[node].nSons ← size.ABS;
      tb[node].son[1] ← IF size = 0 THEN endMark ELSE PopTree[];
      PushTree[[subtree[index: node]]]}
    ELSE PushList[size]};


  PushHash: PROC [hti: Symbols.HTIndex] = {PushTree[[hash[index: hti]]]};

  PushSe: PROC [sei: Symbols.ISEIndex] = {PushTree[[symbol[index: sei]]]};

  PushLit: PROC [lti: Literals.LitIndex] = {PushTree[[literal[index: lti]]]};


  SetInfo: PROC [info: Tree.Info] = {
    WITH stack[sI-1] SELECT FROM
      v: Tree.Link.subtree => IF v # Tree.Null THEN tb[v.index].info ← info;
      ENDCASE};

  SetAttr: PROC [attr: Tree.AttrId, value: BOOL] = {
    WITH stack[sI-1] SELECT FROM
      v: Tree.Link.subtree =>
	IF v = Tree.Null THEN ERROR
	ELSE
	  SELECT attr FROM
	    1 => tb[v.index].attr1 ← value;
	    2 => tb[v.index].attr2 ← value;
	    3 => tb[v.index].attr3 ← value;
	    ENDCASE;
      ENDCASE => ERROR};


  FreeNode: PROC [node: Tree.Index] = {
    IF node # Tree.NullIndex AND ~tb[node].shared THEN {
      i: CARDINAL;
      n: CARDINAL ← tb[node].nSons;
      IF tb[node].name # $list OR n # 0 THEN
	FOR i ← 1, i+1 WHILE i <= n DO
	  WITH tb[node].son[i] SELECT FROM
	    t: Tree.Link.subtree => FreeNode[t.index];
	    ENDCASE;
	  ENDLOOP
      ELSE {
	n ← 1;
	FOR i ← 1, i+1 UNTIL tb[node].son[i] = endMark DO
	  WITH tb[node].son[i] SELECT FROM
	    t: Tree.Link.subtree => FreeNode[t.index];
	    ENDCASE;
	  n ← n+1;
	  ENDLOOP};
      table.FreeChunk[node, Tree.Node.SIZE+n*Tree.Link.SIZE, Tree.treeType]}};

  FreeTree: PROC [t: Tree.Link] RETURNS [Tree.Link] = {
    WITH t SELECT FROM subtree => FreeNode[index] ENDCASE;
    RETURN [Tree.Null]};


  -- procedures for tree testing

  GetHash: PROC [t: Tree.Link] RETURNS [Symbols.HTIndex] = {
    RETURN [NARROW[t, Tree.Link.hash].index]};

  GetNode: PROC [t: Tree.Link] RETURNS [Tree.Index] = {
    RETURN [NARROW[t, Tree.Link.subtree].index]};

  GetSe: PROC [t: Tree.Link] RETURNS [Symbols.ISEIndex] = {
    RETURN [NARROW[t, Tree.Link.symbol].index]};

  NthSon: PROC [t: Tree.Link, n: CARDINAL] RETURNS [Tree.Link] = {
    RETURN [IF t = Tree.Null
      THEN ERROR
      ELSE tb[NARROW[t, Tree.Link.subtree].index].son[n]]};

  OpName: PROC [t: Tree.Link] RETURNS [Tree.NodeName] = {
    RETURN [IF t = Tree.Null
      THEN $none
      ELSE WITH t SELECT FROM subtree => tb[index].name ENDCASE => $none]};

  GetAttr: PROC [t: Tree.Link, attr: Tree.AttrId] RETURNS [BOOL] = {
    node: Tree.Index = NARROW[t, Tree.Link.subtree].index;
    RETURN [IF t = Tree.Null
      THEN ERROR
      ELSE SELECT attr FROM
	1 => tb[node].attr1,
	2 => tb[node].attr2,
	3 => tb[node].attr3,
	ENDCASE => ERROR]};

  PutAttr: PROC [t: Tree.Link, attr: Tree.AttrId, value: BOOL] = {
    node: Tree.Index = NARROW[t, Tree.Link.subtree].index;
    IF t = Tree.Null THEN ERROR;
    SELECT attr FROM
      1 => tb[node].attr1 ← value;
      2 => tb[node].attr2 ← value;
      3 => tb[node].attr3 ← value;
      ENDCASE => ERROR};

  GetInfo: PROC [t: Tree.Link] RETURNS [Tree.Info] = {
    RETURN [IF t # Tree.Null
      THEN tb[NARROW[t, Tree.Link.subtree].index].info
      ELSE ERROR]};

  PutInfo: PROC [t: Tree.Link, value: Tree.Info] = {
    IF t = Tree.Null THEN ERROR;
    tb[NARROW[t, Tree.Link.subtree].index].info ← value};

  Shared: PROC [t: Tree.Link] RETURNS [BOOL] = {
    RETURN [WITH t SELECT FROM
      s: Tree.Link.subtree => IF s = Tree.Null THEN FALSE ELSE tb[s.index].shared,
      ENDCASE => FALSE]};

  MarkShared: PROC [t: Tree.Link, shared: BOOL] = {
    WITH t SELECT FROM
      s: Tree.Link.subtree => IF s # Tree.Null THEN tb[s.index].shared ← shared;
      ENDCASE};

  SonCount: PRIVATE PROC [node: Tree.Index] RETURNS [CARDINAL] = INLINE {
    RETURN [SELECT node FROM
      Tree.NullIndex, endIndex => 0,
      ENDCASE => IF tb[node].name = $list AND tb[node].nSons = 0
	THEN ListLength[[subtree[index: node]]]
	ELSE tb[node].nSons]};


  -- procedures for tree traversal

  ScanSons: PROC [root: Tree.Link, action: Tree.Scan] = {
    IF root # Tree.Null THEN
      WITH root SELECT FROM
	subtree => {
	  node: Tree.Index = index;
	  FOR i: CARDINAL IN [1 .. SonCount[node]] DO
	    action[tb[node].son[i]] ENDLOOP};
	ENDCASE;
    RETURN};

  UpdateLeaves: PROC [root: Tree.Link, map: Tree.Map] RETURNS [v: Tree.Link] = {
    IF root = Tree.Null THEN v ← Tree.Null
    ELSE
      WITH root SELECT FROM
	subtree => {
	  node: Tree.Index = index;
	  FOR i: CARDINAL IN [1 .. SonCount[node]] DO
	    tb[node].son[i] ← map[tb[node].son[i]];
	    ENDLOOP;
	  v ← root};
	ENDCASE => v ← map[root];
    RETURN};


  -- procedures for list testing

  ListLength: PROC [t: Tree.Link] RETURNS [CARDINAL] = {
    IF t = Tree.Null THEN RETURN [0];
    WITH t SELECT FROM
      subtree => {
	node: Tree.Index = index;
	n: CARDINAL;
	IF tb[node].name # $list THEN RETURN [1];
	n ← tb[node].nSons;
	IF n # 0 THEN RETURN [n];
	FOR i: CARDINAL ← 1, i+1 UNTIL tb[node].son[i] = endMark DO n ← n+1 ENDLOOP;
	RETURN [n]};
      ENDCASE => RETURN [1]};

  ListHead: PROC [t: Tree.Link] RETURNS [Tree.Link] = {
    IF t = Tree.Null THEN RETURN [Tree.Null];
    WITH t SELECT FROM
      subtree => {
	node: Tree.Index = index;
	RETURN [SELECT TRUE FROM
	  (tb[node].name # $list) => t,
	  (tb[node].son[1] # endMark) => tb[node].son[1],
	  ENDCASE => Tree.Null]};
      ENDCASE => RETURN [t]};

  ListTail: PROC [t: Tree.Link] RETURNS [Tree.Link] = {
    IF t = Tree.Null THEN RETURN [Tree.Null];
    WITH t SELECT FROM
      subtree => {
	node: Tree.Index = index;
	RETURN [SELECT TRUE FROM
	  (tb[node].name # $list) => t,
	  (tb[node].son[1] # endMark) => tb[node].son[ListLength[t]],
	  ENDCASE => Tree.Null]};
      ENDCASE => RETURN [t]};


  -- procedures for list traversal

  ScanList: PROC [root: Tree.Link, action: Tree.Scan] = {
    IF root # Tree.Null THEN
      WITH root SELECT FROM
	subtree => {
	  node: Tree.Index = index;
	  i, n: CARDINAL;
	  t: Tree.Link;
	  IF tb[node].name # $list THEN action[root]
	  ELSE IF (n ← tb[node].nSons) # 0 THEN
	    FOR i ← 1, i+1 WHILE i <= n DO action[tb[node].son[i]] ENDLOOP
	  ELSE
	    FOR i ← 1, i+1 UNTIL (t←tb[node].son[i]) = endMark DO action[t] ENDLOOP};
	ENDCASE => action[root]};

  ReverseScanList: PROC [root: Tree.Link, action: Tree.Scan] = {
    IF root # Tree.Null THEN
      WITH root SELECT FROM
	subtree => {
	  node: Tree.Index = index;
	  IF tb[node].name # $list THEN action[root]
	  ELSE
	    FOR i: CARDINAL DECREASING IN [1 .. ListLength[root]] DO
	      action[tb[node].son[i]] ENDLOOP};
	ENDCASE => action[root]};

  SearchList: PROC [root: Tree.Link, test: Tree.Test] = {
    IF root # Tree.Null THEN
      WITH root SELECT FROM
	subtree => {
	  node: Tree.Index = index;
	  i, n: CARDINAL;
	  t: Tree.Link;
	  IF tb[node].name # $list THEN [] ← test[root]
	  ELSE IF (n ← tb[node].nSons) # 0 THEN
	    FOR i ← 1, i+1 WHILE i <= n DO IF test[tb[node].son[i]] THEN EXIT ENDLOOP
	  ELSE
	    FOR i ← 1, i+1 UNTIL (t←tb[node].son[i]) = endMark DO
	      IF test[t] THEN EXIT ENDLOOP};
	ENDCASE => [] ← test[root]};

  UpdateList: PROC [root: Tree.Link, map: Tree.Map] RETURNS [Tree.Link] = {
    IF root = Tree.Null THEN RETURN [Tree.Null];
    WITH root SELECT FROM
      subtree => {
	node: Tree.Index = index;
	i, n: CARDINAL;
	t: Tree.Link;
	IF tb[node].name # $list THEN RETURN [map[root]];
	IF (n ← tb[node].nSons) # 0 THEN
	  FOR i ← 1, i+1 WHILE i <= n DO tb[node].son[i] ← map[tb[node].son[i]] ENDLOOP
	ELSE
	  FOR i ← 1, i+1 UNTIL (t←tb[node].son[i]) = endMark DO
	    tb[node].son[i] ← map[t] ENDLOOP;
	RETURN [root]};
      ENDCASE => RETURN [map[root]]};

  ReverseUpdateList: PROC [root: Tree.Link, map: Tree.Map] RETURNS [Tree.Link] = {
    IF root = Tree.Null THEN RETURN [Tree.Null];
    WITH root SELECT FROM
      subtree => {
	node: Tree.Index = index;
	IF tb[node].name # $list THEN RETURN [map[root]];
	FOR i: CARDINAL DECREASING IN [1..ListLength[root]] DO
	  tb[node].son[i] ← map[tb[node].son[i]] ENDLOOP;
	RETURN [root]};
      ENDCASE => RETURN [map[root]]};


 -- cross-table tree manipulation

  CopyTree: PROC [root: Tree.Id, map: Tree.Map] RETURNS [v: Tree.Link] = {
    WITH root.link SELECT FROM
      subtree => {
	sNode: Tree.Index = index;
	IF sNode = Tree.NullIndex THEN v ← Tree.Null
	ELSE {
	  size: CARDINAL = NodeSize[root.baseP, sNode];
	  dNode: Tree.Index = table.GetChunk[size, Tree.treeType];
	  t: Tree.Link;
	  tb[dNode].name ← root.baseP↑[sNode].name;
	  tb[dNode].shared ← FALSE;
	  tb[dNode].nSons ← root.baseP↑[sNode].nSons;
	  tb[dNode].info ← root.baseP↑[sNode].info;
	  tb[dNode].attr1 ← root.baseP↑[sNode].attr1;
	  tb[dNode].attr2 ← root.baseP↑[sNode].attr2;
	  tb[dNode].attr3 ← root.baseP↑[sNode].attr3;
	  FOR i: CARDINAL IN [1..size-Tree.Node.SIZE] DO
	    tb[dNode].son[i] ← IF (t←root.baseP↑[sNode].son[i]) = endMark
				    THEN endMark
				    ELSE map[t];
	    ENDLOOP;
	  v ← [subtree[index: dNode]]}};
      ENDCASE => v ← map[root.link];
    RETURN};

  IdentityMap: Tree.Map = {
    RETURN [IF ISTYPE[t, Tree.Link.subtree] AND ~Shared[t]
	THEN CopyTree[[baseP:@tb, link:t], IdentityMap]
	ELSE t]};


  NodeSize: PROC [baseP: Tree.Finger, node: Tree.Index] RETURNS [size: CARDINAL] = {
    IF node = Tree.NullIndex THEN size ← 0
    ELSE IF baseP↑[node].name # $list OR baseP↑[node].nSons # 0 THEN
      size ← Tree.Node.SIZE + baseP↑[node].nSons*Tree.Link.SIZE
    ELSE {
      size ← Tree.Node.SIZE + Tree.Link.SIZE;
      FOR i: CARDINAL ← 1, i+1 UNTIL baseP↑[node].son[i] = endMark DO
        size ← size + Tree.Link.SIZE ENDLOOP};
    RETURN};

  }.