-- PPTreeImpl.Mesa
-- Satterthwaite, January 13, 1981 9:27 AM
-- Russ Atkinson, June 9, 1982 3:44 pm
DIRECTORY
PPLeaves: TYPE USING [HTIndex, ISEIndex],
PPTree: TYPE USING [
AttrId, Id, Handle, Link, Map, Node, NodeName, Scan, SonId, Test,
Null, NullHandle],
PPTreeOps: TYPE USING [];
PPTreeImpl: CEDAR PROGRAM EXPORTS PPTreeOps =
BEGIN OPEN PPLeaves, Tree: PPTree;
initialized: BOOL ← FALSE;
StackIncr: CARDINAL = 32;
LinkStack: TYPE = RECORD [SEQUENCE size: NAT OF Tree.Link];
stack: REF LinkStack ← NIL;
sI: NAT;
Initialize: PUBLIC PROC = {
IF initialized THEN Finalize[];
stack ← AllocStack[StackIncr];
sI ← 0;
initialized ← TRUE};
Reset: PUBLIC PROC = {
IF initialized AND stack.size > 2*StackIncr
THEN stack ← AllocStack[StackIncr]};
Finalize: PUBLIC PROC = {initialized ← FALSE};
AllocStack: PROC
[size: NAT, forceNew: BOOL ← FALSE] RETURNS [st: REF LinkStack] = {
st ← IF forceNew THEN NIL ELSE stack;
IF st = NIL OR st.size < size THEN st ← NEW[LinkStack[size]];
};
ExpandStack: PROC = {
newStack: REF LinkStack = AllocStack[stack.size+StackIncr, TRUE];
FOR i: NAT IN [0 .. stack.size) DO newStack[i] ← stack[i] ENDLOOP;
stack ← newStack};
PushTree: PUBLIC PROC [v: Tree.Link] = {
IF sI >= stack.size 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: NAT] = {
i: NAT ← sI;
IF sI >= stack.size THEN ExpandStack[];
sI ← sI+1;
THROUGH [1 .. n) DO stack[i] ← stack[i-1]; i ← i-1 ENDLOOP;
stack[i] ← v};
ExtractTree: PUBLIC PROC [n: NAT] RETURNS [v: Tree.Link] = {
i: NAT ← sI - n;
v ← stack[i];
THROUGH [1 .. n) DO stack[i] ← stack[i+1]; i ← i+1 ENDLOOP;
sI ← sI - 1;
RETURN};
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: NAT = ABS[count];
node: Tree.Handle = NEW[Tree.Node[nSons] ← [name:name, son:]];
IF count >= 0
THEN FOR i: Tree.SonId DECREASING IN [1..nSons]
DO node.son[i] ← stack[sI←sI-1] ENDLOOP
ELSE FOR i: Tree.SonId IN [1..nSons]
DO node.son[i] ← stack[sI←sI-1] ENDLOOP;
IF sI >= stack.size THEN ExpandStack[];
stack[sI] ← node; sI ← sI+1};
PushList: PUBLIC PROC [size: INTEGER] = {
nSons: NAT = ABS[size];
SELECT nSons FROM
1 => NULL;
0 => PushTree[Tree.Null];
ENDCASE => {
node: Tree.Handle = NEW[Tree.Node[nSons] ← [name: list, son:]];
IF size > 0
THEN FOR i: Tree.SonId DECREASING IN [1..nSons]
DO node.son[i] ← stack[sI←sI-1] ENDLOOP
ELSE FOR i: Tree.SonId IN [1..nSons]
DO node.son[i] ← stack[sI←sI-1] ENDLOOP;
IF sI >= stack.size THEN ExpandStack[];
stack[sI] ← node; sI ← sI+1}};
PushProperList: PUBLIC PROC [size: INTEGER] = {
IF size NOT IN [-1..1]
THEN PushList[size]
ELSE {
node: Tree.Handle = NEW[Tree.Node[ABS[size]] ← [name: list, son:]];
IF size # 0 THEN node.son[1] ← PopTree[];
PushTree[node]}};
SetInfo: PUBLIC PROC [info: CARDINAL] = {
v: Tree.Link = stack[sI-1];
WITH v SELECT FROM
node: Tree.Handle => node.info ← info;
ENDCASE => ERROR};
SetAttr: PUBLIC PROC [which: Tree.AttrId, value: BOOL] = {
v: Tree.Link = stack[sI-1];
WITH v SELECT FROM
node: Tree.Handle => node.attr[which] ← value;
ENDCASE => ERROR};
-- procedures for tree testing
GetHash: PUBLIC PROC [t: Tree.Link] RETURNS [HTIndex] = {
RETURN [WITH t SELECT FROM id: HTIndex => id, ENDCASE => ERROR]};
GetNode: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.Handle] = {
RETURN [WITH t SELECT FROM node: Tree.Handle => node, ENDCASE => ERROR]};
GetSe: PUBLIC PROC [t: Tree.Link] RETURNS [ISEIndex] = {
RETURN [GetHash[t].name]};
NthSon: PUBLIC PROC [t: Tree.Link, n: Tree.SonId] RETURNS [Tree.Link] = {
RETURN [WITH t SELECT FROM
node: Tree.Handle => node.son[n],
ENDCASE => ERROR]};
NSons: PUBLIC PROC [t: Tree.Link] RETURNS [NAT] = {
RETURN [WITH t SELECT FROM
node: Tree.Handle => node.sonLimit-1,
ENDCASE => 0]};
OpName: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.NodeName] = {
RETURN [WITH t SELECT FROM node: Tree.Handle => node.name, ENDCASE => none]};
-- procedures for tree traversal
ScanSons: PUBLIC PROC [root: Tree.Link, action: Tree.Scan] = {
WITH root SELECT FROM
node: Tree.Handle =>
FOR i: Tree.SonId IN [1 .. node.sonLimit) DO action[node.son[i]] ENDLOOP;
ENDCASE};
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 FROM
node: Tree.Handle => {
FOR i: Tree.SonId IN [1 .. node.sonLimit)
DO node.son[i] ← map[node.son[i]] ENDLOOP;
v ← root};
ENDCASE => v ← map[root];
RETURN};
-- procedures for list testing
ListLength: PUBLIC PROC [t: Tree.Link] RETURNS [NAT] = {
RETURN [
IF t = Tree.Null THEN 0
ELSE WITH t SELECT FROM
node: Tree.Handle => IF node.name # list THEN 1 ELSE node.sonLimit-1,
ENDCASE => 1]};
ListHead: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.Link] = {
RETURN [WITH t SELECT FROM
node: Tree.Handle =>
SELECT TRUE FROM
(node.name # list) => t,
(node.sonLimit # 1) => node.son[1],
ENDCASE => Tree.Null,
ENDCASE => t]};
ListTail: PUBLIC PROC [t: Tree.Link] RETURNS [Tree.Link] = {
RETURN [WITH t SELECT FROM
node: Tree.Handle =>
SELECT TRUE FROM
(node.name # list) => t,
(node.sonLimit # 1) => node.son[ListLength[t]],
ENDCASE => Tree.Null,
ENDCASE => t]};
-- procedures for list traversal
ScanList: PUBLIC PROC [root: Tree.Link, action: Tree.Scan] = {
IF root # Tree.Null
THEN
WITH root SELECT FROM
node: Tree.Handle =>
IF node.name # list
THEN action[root]
ELSE
FOR i: Tree.SonId IN [1..node.sonLimit)
DO action[node.son[i]] ENDLOOP;
ENDCASE => action[root]};
ReverseScanList: PUBLIC PROC [root: Tree.Link, action: Tree.Scan] = {
IF root # Tree.Null
THEN
WITH root SELECT FROM
node: Tree.Handle =>
IF node.name # list
THEN action[root]
ELSE
FOR i: Tree.SonId DECREASING IN [1..node.sonLimit)
DO action[node.son[i]] ENDLOOP;
ENDCASE => action[root]};
SearchList: PUBLIC PROC [root: Tree.Link, test: Tree.Test] = {
IF root # Tree.Null
THEN
WITH root SELECT FROM
node: Tree.Handle =>
IF node.name # list
THEN [] ← test[root]
ELSE
FOR i: Tree.SonId IN [1..node.sonLimit)
DO IF test[node.son[i]] THEN EXIT ENDLOOP;
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 FROM
node: Tree.Handle => {
IF node.name # list THEN RETURN [map[root]];
FOR i: Tree.SonId IN [1..node.sonLimit)
DO node.son[i] ← map[node.son[i]] ENDLOOP;
RETURN [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 FROM
node: Tree.Handle => {
IF node.name # list THEN RETURN [map[root]];
FOR i: Tree.SonId DECREASING IN [1..node.sonLimit)
DO node.son[i] ← map[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 SELECT FROM
sNode: Tree.Handle => {
IF sNode = Tree.NullHandle
THEN v ← Tree.Null
ELSE {
dNode: Tree.Handle = NEW[Tree.Node[NSons[sNode]] ← [
name: sNode.name,
attr: sNode.attr,
info: sNode.info,
son: ]];
FOR i: Tree.SonId IN [1..sNode.sonLimit)
DO dNode.son[i] ← map[sNode.son[i]] ENDLOOP;
v ← dNode}};
ENDCASE => v ← map[root];
RETURN};
IdentityMap: PUBLIC Tree.Map = {
RETURN [IF ISTYPE[t, Tree.Handle]
THEN CopyTree[t, IdentityMap]
ELSE t]};
END.