TreePack.Mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, June 18, 1986 12:19:19 pm PDT
Paul Rovner, September 7, 1983 12:12 am
Russ Atkinson (RRA) March 6, 1985 10:26:01 pm PST
Sweet June 4, 1986 9:48:04 am PDT
DIRECTORY
Alloc: TYPE USING [Handle, Notifier, AddNotify, DropNotify, FreeChunk, GetChunk],
Literals USING [LTIndex, STIndex],
Symbols: TYPE USING [HTIndex, ISEIndex],
Tree: TYPE USING [AttrId, Base, Finger, Id, Info, Index, Link, LinkRep, LinkTag, Map, Node, NodeName, Scan, Test, Null, nullIndex, nullInfo, treeType],
TreeOps: TYPE USING [GetTag];
TreePack: PROGRAM
IMPORTS Alloc, TreeOps EXPORTS TreeOps = {
initialized: BOOL ← FALSE;
table: PRIVATE Alloc.Handle;
LinkSeq: TYPE = RECORD[SEQUENCE length: CARDINAL OF Tree.Link];
LinkStack: TYPE = REF LinkSeq;
stack: LinkStack;
sI: CARDINAL;
tb: Tree.Base;  -- tree base
UpdateBase: Alloc.Notifier = {tb ← base[Tree.treeType]};
Initialize: PUBLIC PROC[ownTable: Alloc.Handle] = {
IF initialized THEN Finalize[];
stack ← NEW[LinkSeq[250]]; sI ← 0;
table ← ownTable;
table.AddNotify[UpdateBase];
IF MakeNode[$none,0] # Tree.Null THEN ERROR; -- reserve null
initialized ← TRUE};
Reset: PUBLIC PROC = {
IF initialized AND stack.length > 250 THEN {
stack ← NEW[LinkSeq[250]]}};
Finalize: PUBLIC PROC = {
table.DropNotify[UpdateBase]; table ← NIL;
stack ← NIL;
initialized ← FALSE};
ExpandStack: PROC = {
newStack: LinkStack = NEW[LinkSeq[stack.length + 256]];
FOR i: CARDINAL IN [0 .. stack.length) DO newStack[i] ← stack[i] ENDLOOP;
stack ← newStack};
PushTree: PUBLIC PROC[v: Tree.Link] = {
IF sI >= stack.length THEN ExpandStack[];
stack[sI] ← v; sI ← sI+1};
PopTree: PUBLIC PROC RETURNS[Tree.Link] = {RETURN[stack[sI←sI-1]]};
InsertTree: PUBLIC 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: PUBLIC 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: PUBLIC PROC[name: Tree.NodeName, count: INTEGER] RETURNS[Tree.Link] = {
PushNode[name, count]; RETURN[PopTree[]]};
MakeList: PUBLIC PROC[size: INTEGER] RETURNS[Tree.Link] = {
PushList[size]; RETURN[PopTree[]]};
PushNode: PUBLIC PROC[name: Tree.NodeName, count: INTEGER] = {
nSons: CARDINAL = count.ABS;
node: Tree.Index = table.GetChunk[Tree.Node[nSons].SIZE, Tree.treeType];
i: CARDINAL;
tb[node].name ← name; tb[node].nSons ← nSons;
tb[node].info ← Tree.nullInfo; 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: PUBLIC PROC[size: INTEGER] = {
nSons: CARDINAL = size.ABS;
node: Tree.Index;
i: CARDINAL;
SELECT nSons FROM
1 => NULL;
0 => PushTree[Tree.Null];
ENDCASE => {
node ← table.GetChunk[Tree.Node[nSons].SIZE, Tree.treeType];
tb[node].name ← $list;
tb[node].info ← Tree.nullInfo; tb[node].shared ← FALSE;
tb[node].attr1 ← tb[node].attr2 ← tb[node].attr3 ← FALSE;
tb[node].nSons ← nSons;
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: PUBLIC PROC[size: INTEGER] = {
IF size IN [-1..1] THEN PushNode[$list, size]
ELSE PushList[size]};
PushHash: PUBLIC PROC[hti: Symbols.HTIndex] = {PushTree[[hash[index: hti]]]};
PushSe: PUBLIC PROC[sei: Symbols.ISEIndex] = {PushTree[[symbol[index: sei]]]};
PushLit: PUBLIC PROC[lti: Literals.LTIndex] = {PushTree[[literal[index: lti]]]};
PushString: PUBLIC PROC[sti: Literals.STIndex] = {PushTree[[string[index: sti]]]};
SetInfo: PUBLIC PROC[info: Tree.Info] = {
t: Tree.Link = stack[sI-1];
WITH v: t SELECT TreeOps.GetTag[v] FROM
subtree => IF v # Tree.Null THEN tb[v.index].info ← info;
ENDCASE
};
SetAttr: PUBLIC PROC[attr: Tree.AttrId, value: BOOL] = {
t: Tree.Link = stack[sI-1];
WITH v: t SELECT TreeOps.GetTag[v] FROM
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: PUBLIC PROC[node: Tree.Index] = {
IF node # Tree.nullIndex AND ~tb[node].shared THEN {
i: CARDINAL;
n: CARDINAL ← tb[node].nSons;
FOR i IN [1..n] DO
t: Tree.Link ← tb[node].son[i];
WITH v: t SELECT TreeOps.GetTag[t] FROM
subtree => FreeNode[v.index];
ENDCASE;
ENDLOOP;
table.FreeChunk[node, Tree.Node.SIZE+n*Tree.Link.SIZE, Tree.treeType]}
};
FreeTree: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] = {
WITH t SELECT TreeOps.GetTag[t] FROM subtree => FreeNode[index] ENDCASE;
RETURN[Tree.Null]};
procedures for tree testing
IsTree: PROC[t: Tree.Link] RETURNS[BOOL] = INLINE {
RETURN[LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.subtree.ORD]};
Narrow: PROC[t: Tree.Link] RETURNS[Tree.Index] = INLINE {
RETURN[IF LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.subtree.ORD THEN LOOPHOLE[t] ELSE ERROR]};
GetHash: PUBLIC PROC[t: Tree.Link] RETURNS[Symbols.HTIndex] = {
RETURN[IF LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.hash.ORD THEN LOOPHOLE[t] ELSE ERROR]};
GetNode: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Index] = {RETURN[Narrow[t]]};
GetSe: PUBLIC PROC[t: Tree.Link] RETURNS[Symbols.ISEIndex] = {
RETURN[IF LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.symbol.ORD THEN LOOPHOLE[t] ELSE ERROR]};
GetLit: PUBLIC PROC[t: Tree.Link] RETURNS[Literals.LTIndex] = {
RETURN[IF LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.literal.ORD THEN LOOPHOLE[t] ELSE ERROR]};
GetStr: PUBLIC PROC[t: Tree.Link] RETURNS[Literals.STIndex] = {
RETURN[IF LOOPHOLE[t, Tree.LinkRep].tag = Tree.LinkTag.string.ORD THEN LOOPHOLE[t] ELSE ERROR]};
NthSon: PUBLIC PROC[t: Tree.Link, n: CARDINAL] RETURNS[Tree.Link] = {
RETURN[IF t = Tree.Null
THEN ERROR
ELSE WITH t SELECT TreeOps.GetTag[t] FROM
subtree => tb[index].son[n],
ENDCASE => ERROR]
};
OpName: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.NodeName] = {
RETURN[IF t = Tree.Null
THEN $none
ELSE WITH t SELECT TreeOps.GetTag[t] FROM subtree => tb[index].name ENDCASE => $none]
};
GetAttr: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId] RETURNS[BOOL] = {
node: Tree.Index = Narrow[t];
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: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId, value: BOOL] = {
node: Tree.Index = Narrow[t];
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: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Info] = {
RETURN[IF t # Tree.Null
THEN tb[Narrow[t]].info 
ELSE ERROR]
};
PutInfo: PUBLIC PROC[t: Tree.Link, value: Tree.Info] = {
IF t = Tree.Null THEN ERROR;
tb[Narrow[t]].info ← value};
Shared: PUBLIC PROC[t: Tree.Link] RETURNS[BOOL] = {
RETURN[WITH s: t SELECT TreeOps.GetTag[t] FROM
subtree => IF s = Tree.Null THEN FALSE ELSE tb[s.index].shared,
ENDCASE => FALSE]
};
MarkShared: PUBLIC PROC[t: Tree.Link, shared: BOOL] = {
WITH s: t SELECT TreeOps.GetTag[t] FROM
subtree => IF s # Tree.Null THEN tb[s.index].shared ← shared;
ENDCASE
};
SonCount: PROC[node: Tree.Index] RETURNS[CARDINAL] = INLINE {
RETURN[SELECT node FROM
Tree.nullIndex => 0,
ENDCASE => tb[node].nSons]
};
procedures for tree traversal
ScanSons: PUBLIC PROC[root: Tree.Link, action: Tree.Scan] = {
IF root # Tree.Null THEN
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
FOR i: CARDINAL IN [1 .. tb[node].nSons] DO
action[tb[node].son[i]] ENDLOOP};
ENDCASE;
RETURN};
UpdateLeaves: PUBLIC PROC[root: Tree.Link, map: Tree.Map] RETURNS[v: Tree.Link] = {
IF root = Tree.Null THEN v ← Tree.Null
ELSE
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
FOR i: CARDINAL IN [1 .. tb[node].nSons] DO
tb[node].son[i] ← map[tb[node].son[i]];
ENDLOOP;
v ← root};
ENDCASE => v ← map[root];
RETURN};
procedures for list testing
ListLength: PUBLIC PROC[t: Tree.Link] RETURNS[CARDINAL] = {
IF t = Tree.Null THEN RETURN[0];
WITH t SELECT TreeOps.GetTag[t] FROM
subtree => {
node: Tree.Index = index;
RETURN[IF tb[node].name # $list THEN 1 ELSE tb[node].nSons]};
ENDCASE => RETURN[1]
};
ListHead: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] = {
IF t = Tree.Null THEN RETURN[Tree.Null];
WITH t SELECT TreeOps.GetTag[t] FROM
subtree => {
node: Tree.Index = index;
RETURN[SELECT TRUE FROM
(tb[node].name # $list) => t,
(tb[node].nSons # 0) => tb[node].son[1],
ENDCASE => Tree.Null]};
ENDCASE => RETURN[t]
};
ListTail: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Link] = {
IF t = Tree.Null THEN RETURN[Tree.Null];
WITH t SELECT TreeOps.GetTag[t] FROM
subtree => {
node: Tree.Index = index;
RETURN[SELECT TRUE FROM
(tb[node].name # $list) => t,
(tb[node].nSons # 0) => tb[node].son[ListLength[t]],
ENDCASE => Tree.Null]};
ENDCASE => RETURN[t]
};
procedures for list traversal
ScanList: PUBLIC PROC[root: Tree.Link, action: Tree.Scan] = {
IF root # Tree.Null THEN
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
IF tb[node].name = $list THEN
FOR i: CARDINAL IN [1..tb[node].nSons] DO action[tb[node].son[i]] ENDLOOP
ELSE action[root]};
ENDCASE => action[root]
};
ReverseScanList: PUBLIC PROC[root: Tree.Link, action: Tree.Scan] = {
IF root # Tree.Null THEN
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
IF tb[node].name = $list THEN
FOR i: CARDINAL DECREASING IN [1..tb[node].nSons] DO
action[tb[node].son[i]] ENDLOOP
ELSE action[root]};
ENDCASE => action[root]
};
SearchList: PUBLIC PROC[root: Tree.Link, test: Tree.Test] = {
IF root # Tree.Null THEN
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
IF tb[node].name = $list THEN
FOR i: CARDINAL IN [1..tb[node].nSons] DO
IF test[tb[node].son[i]] THEN EXIT
ENDLOOP
ELSE [] ← test[root]};
ENDCASE => [] ← test[root]
};
UpdateList: PUBLIC PROC[root: Tree.Link, map: Tree.Map] RETURNS[Tree.Link] = {
IF root = Tree.Null THEN RETURN[Tree.Null];
WITH root SELECT TreeOps.GetTag[root] FROM
subtree => {
node: Tree.Index = index;
IF tb[node].name = $list THEN {
FOR i: CARDINAL IN [1..tb[node].nSons] DO
tb[node].son[i] ← map[tb[node].son[i]];
ENDLOOP;
RETURN[root]}
ELSE RETURN[map[root]]};
ENDCASE => RETURN[map[root]] 
};
ReverseUpdateList: PUBLIC PROC[root: Tree.Link, map: Tree.Map] RETURNS[Tree.Link] = {
IF root = Tree.Null THEN RETURN[Tree.Null];
WITH root SELECT TreeOps.GetTag[root] 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: PUBLIC PROC[root: Tree.Id, map: Tree.Map] RETURNS[v: Tree.Link] = {
WITH root.link SELECT TreeOps.GetTag[root.link] 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];
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)/Tree.Link.SIZE] DO
tb[dNode].son[i] ← map[root.baseP^[sNode].son[i]];
ENDLOOP;
v ← [subtree[index: dNode]]}};
ENDCASE => v ← map[root.link];
RETURN};
IdentityMap: PUBLIC Tree.Map = {
RETURN[IF IsTree[t] AND ~Shared[t]
THEN CopyTree[[baseP:@tb, link:t], IdentityMap]
ELSE t] 
};
NodeSize: PUBLIC PROC[baseP: Tree.Finger, node: Tree.Index] RETURNS[size: CARDINAL] = {
RETURN[IF node = Tree.nullIndex
THEN 0
ELSE Tree.Node[baseP^[node].nSons].SIZE]
};
}.