-- file TreePack.Mesa
-- last modified by Satterthwaite, May 21, 1982 1:34 pm
DIRECTORY
Alloc: TYPE USING [
Handle, Notifier, AddNotify, DropNotify, FreeChunk, GetChunk],
Literals: TYPE USING [LTIndex, STIndex],
Symbols: TYPE USING [HTIndex, ISEIndex],
Tree: TYPE USING [
AttrId, Base, Finger, Id, Index, Link, Map, Node, NodeName, Scan, Test,
MaxNSons, Null, NullIndex, treeType],
TreeOps: TYPE USING [];
TreePack: PROGRAM
IMPORTS Alloc
EXPORTS TreeOps =
PUBLIC {
EndIndex: Tree.Index = LAST[Tree.Index];
EndMark: Tree.Link = [subtree[index: EndIndex]];
initialized: PRIVATE BOOLEAN ← 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;
i ← 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 = ABS[count];
node: Tree.Index = table.GetChunk[SIZE[Tree.Node]+nSons, 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 = ABS[size];
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[SIZE[Tree.Node]+nSons, Tree.treeType]
ELSE {
node ← table.GetChunk[SIZE[Tree.Node]+(nSons+1), 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[SIZE[Tree.Node] + 1, 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 ← ABS[size];
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.LTIndex] = {PushTree[[literal[info: [word[lti]]]]]};
PushStringLit: PROC [sti: Literals.STIndex] = {PushTree[[literal[info: [string[sti]]]]]};
SetInfo: PROC [info: UNSPECIFIED] = {
v: Tree.Link = stack[sI-1];
IF v # Tree.Null THEN
WITH v SELECT FROM subtree => tb[index].info ← info ENDCASE};
SetAttr: PROC [attr: Tree.AttrId, value: BOOLEAN] = {
v: Tree.Link = stack[sI-1];
IF v = Tree.Null THEN ERROR
ELSE
WITH v SELECT FROM
subtree => {
node: Tree.Index = index;
SELECT attr FROM
1 => tb[node].attr1 ← value;
2 => tb[node].attr2 ← value;
3 => tb[node].attr3 ← value;
ENDCASE};
ENDCASE => ERROR};
FreeNode: PROC [node: Tree.Index] = {
IF node # Tree.NullIndex AND ~tb[node].shared THEN {
i, n: CARDINAL;
t: Tree.Link;
n ← tb[node].nSons;
IF tb[node].name # list OR n # 0 THEN
FOR i ← 1, i+1 WHILE i <= n DO
t ← tb[node].son[i];
WITH t SELECT FROM subtree => FreeNode[index] ENDCASE;
ENDLOOP
ELSE {
n ← 1;
FOR i ← 1, i+1 UNTIL (t←tb[node].son[i]) = EndMark DO
WITH t SELECT FROM subtree => FreeNode[index] ENDCASE;
n ← n+1;
ENDLOOP};
table.FreeChunk[node, SIZE[Tree.Node]+n, 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 [WITH t SELECT FROM hash => index, ENDCASE => ERROR]};
GetNode: PROC [t: Tree.Link] RETURNS [Tree.Index] = {
RETURN [WITH t SELECT FROM subtree => index, ENDCASE => ERROR]};
GetSe: PROC [t: Tree.Link] RETURNS [Symbols.ISEIndex] = {
RETURN [WITH t SELECT FROM symbol => index, ENDCASE => ERROR]};
NthSon: PROC [t: Tree.Link, n: CARDINAL] RETURNS [Tree.Link] = {
RETURN [IF t = Tree.Null
THEN ERROR
ELSE WITH t SELECT FROM subtree => tb[index].son[n], ENDCASE => ERROR]};
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]};
Shared: PROC [t: Tree.Link] RETURNS [BOOLEAN] = {
RETURN [WITH t SELECT FROM
subtree => IF index = Tree.NullIndex THEN FALSE ELSE tb[index].shared,
ENDCASE => FALSE]};
SetShared: PROC [t: Tree.Link, shared: BOOLEAN] = {
WITH t SELECT FROM
subtree => IF index # Tree.NullIndex THEN tb[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-SIZE[Tree.Node]] 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 t.tag = 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 ← SIZE[Tree.Node] + baseP↑[node].nSons
ELSE {
size ← SIZE[Tree.Node] + 1;
FOR i: CARDINAL ← 1, i+1 UNTIL baseP↑[node].son[i] = EndMark DO size ← size + 1 ENDLOOP};
RETURN};
}.