[ivy]<Satterthwaite>SML>SMTreeImpl.mesa!8

SMTreeImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, October 21, 1985 3:25:15 pm PDT
DIRECTORY
Tree: TYPE USING [
AttrId, Ext, Handle, Id, Info, Link, Name, Node, NodeName, SonId, null],
TreeOps USING [Map, Scan, Test];
SMTreeImpl: CEDAR PROGRAM EXPORTS TreeOps ~ {
OPEN Tree;
LinkStack: TYPE~RECORD[SEQUENCE size: NAT OF Tree.Link];
stackIncr: NAT~128;
TreeManager: PUBLIC TYPE~RECORD[
z: ZONE ←,
stack: REF LinkStack ← NIL,
sI: NAT ← 0,
initialized: BOOL ← FALSE,
visiting: BOOL ← FALSE,
mark: BOOL ← FALSE];
TM: TYPE~REF TreeManager;
Create: PUBLIC PROC[zone: ZONE] RETURNS[TM]~{
tm: TM ~ zone.NEW[TreeManager ← [z~zone]];
RETURN[tm]};
Initialize: PUBLIC PROC[tm: TM]~{
IF tm.initialized THEN Finalize[tm];
tm.stack ← AllocStack[tm, stackIncr];
tm.sI ← 0;
tm.mark ← FALSE;
tm.initialized ← TRUE};
Reset: PUBLIC PROC[tm: TM]~{
IF tm.initialized AND tm.stack.size > 2*stackIncr THEN {
tm.stack ← AllocStack[tm, stackIncr]}
};
Finalize: PUBLIC PROC[tm: TM]~{
tm.initialized ← FALSE;
tm.stack ← NIL};
AllocStack: PROC[tm: TM, size: NAT, forceNew: BOOL←FALSE]
RETURNS[st: REF LinkStack] ~ {
st ← (IF forceNew THEN NIL ELSE tm.stack);
IF st = NIL OR st.size < size THEN st ← (tm.z).NEW[LinkStack[size]]};
ExpandStack: PROC[tm: TM]~{
newStack: REF LinkStack ~ AllocStack[tm, tm.stack.size+stackIncr, TRUE];
FOR i: NAT IN [0 .. tm.stack.size) DO newStack[i] ← tm.stack[i] ENDLOOP;
tm.stack ← newStack};
Zone: PUBLIC PROC[tm: TM] RETURNS[ZONE]~{RETURN [tm.z]};
PushTree: PUBLIC PROC[tm: TM, v: Tree.Link] = {
IF tm.sI >= tm.stack.size THEN ExpandStack[tm];
tm.stack[tm.sI] ← v; tm.sI ← tm.sI+1};
PopTree: PUBLIC PROC[tm: TM] RETURNS[Tree.Link]~{
RETURN [tm.stack[tm.sI←tm.sI-1]]};
InsertTree: PUBLIC PROC[tm: TM, v: Tree.Link, n: NAT]~{
i: NAT ← tm.sI;
IF tm.sI >= tm.stack.size THEN ExpandStack[tm];
tm.sI ← tm.sI+1;
THROUGH [1 .. n) DO tm.stack[i] ← tm.stack[i-1]; i ← i-1 ENDLOOP;
tm.stack[i] ← v};
ExtractTree: PUBLIC PROC[tm: TM, n: CARDINAL] RETURNS [v: Tree.Link] = {
i: NAT ← tm.sI - n;
v ← tm.stack[i];
THROUGH [1 .. n) DO tm.stack[i] ← tm.stack[i+1]; i ← i+1 ENDLOOP;
tm.sI ← tm.sI - 1;
RETURN [v]};
MakeNode: PUBLIC PROC[tm: TM, name: Tree.NodeName, count: INTEGER]
RETURNS[Tree.Link]~{
PushNode[tm, name, count]; RETURN [PopTree[tm]]};
PushNode: PUBLIC PROC[tm: TM, name: Tree.NodeName, count: INTEGER] ~ {
nSons: NAT = count.ABS;
node: Tree.Handle~(tm.z).NEW[Tree.Node[nSons]←[name~name, visited~tm.mark, son~]];
IF count >= 0 THEN
FOR i: Tree.SonId DECREASING IN [1..nSons] DO
node.son[i] ← tm.stack[tm.sI←tm.sI-1] ENDLOOP
ELSE
FOR i: Tree.SonId IN [1..nSons] DO
node.son[i] ← tm.stack[tm.sI←tm.sI-1] ENDLOOP;
IF tm.sI >= tm.stack.size THEN ExpandStack[tm];
tm.stack[tm.sI] ← node; tm.sI ← tm.sI+1};
SetAttr: PUBLIC PROC[tm: TM, attr: Tree.AttrId, value: BOOL]~{
FOR node: Tree.Handle ← NARROW[tm.stack[tm.sI-1]], NARROW[node.son[1]] DO
IF node.name # $locator THEN {
node.attrs[attr] ← value; EXIT};
ENDLOOP
};
SetExt: PUBLIC PROC[tm: TM, ext: Tree.Ext]~{
FOR node: Tree.Handle ← NARROW[tm.stack[tm.sI-1]], NARROW[node.son[1]] DO
IF node.name # $locator THEN {
node.ext ← ext; EXIT};
ENDLOOP
};
SetInfo: PUBLIC PROC[tm: TM, info: Tree.Info]~{
WITH tm.stack[tm.sI-1] SELECT FROM
node: Tree.Handle => node.info ← info;
ENDCASE => ERROR
};
structure extraction
GetName: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Name]~{
RETURN [WITH t SELECT FROM
name: Tree.Name => name,
node: Tree.Handle =>
IF node.name # $locator THEN ERROR ELSE GetName[node.son[1]],
ENDCASE => ERROR]
};
GetNode: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Handle]~{
RETURN [WITH t SELECT FROM
node: Tree.Handle =>
IF node.name # $locator THEN node ELSE GetNode[node.son[1]],
ENDCASE => ERROR]
};
GetId: PUBLIC PROC[t: Tree.Link] RETURNS [Tree.Id]~{
RETURN [WITH t SELECT FROM
id: Tree.Id => id,
node: Tree.Handle =>
IF node.name # $locator THEN ERROR ELSE GetId[node.son[1]],
ENDCASE => ERROR]
};
NSons: PUBLIC PROC[t: Tree.Link] RETURNS[NAT] ~ {
RETURN [WITH t SELECT FROM
node: Tree.Handle =>
IF node.name # $locator THEN node.sonLimit-1 ELSE NSons[node.son[1]],
ENDCASE => 0]
};
NthSon: PUBLIC PROC[t: Tree.Link, n: Tree.SonId] RETURNS[Tree.Link] ~ {
RETURN [WITH t SELECT FROM
node: Tree.Handle =>
IF node.name # $locator THEN node.son[n] ELSE NthSon[node.son[1], n],
ENDCASE => ERROR]
};
PutNthSon: PUBLIC PROC[t: Tree.Link, n: Tree.SonId, v: Tree.Link] ~ {
WITH t SELECT FROM
node: Tree.Handle =>
IF node.name # $locator THEN node.son[n] ← v
ELSE PutNthSon[node.son[1], n, v];
ENDCASE => ERROR
};
OpName: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.NodeName] ~ {
RETURN [WITH t SELECT FROM
node: Tree.Handle =>
IF node.name # $locator THEN node.name ELSE OpName[node.son[1]],
ENDCASE => $none]
};
GetAttr: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId] RETURNS[BOOL] ~ {
RETURN [WITH t SELECT FROM
node: Tree.Handle =>
IF node.name # $locator THEN node.attrs[attr] ELSE GetAttr[node.son[1], attr],
ENDCASE => ERROR]
};
PutAttr: PUBLIC PROC[t: Tree.Link, attr: Tree.AttrId, value: BOOL] ~ {
WITH t SELECT FROM
node: Tree.Handle =>
IF node.name # $locator THEN node.attrs[attr] ← value
ELSE PutAttr[node.son[1], attr, value];
ENDCASE => ERROR
};
GetInfo: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Info] ~ {
RETURN [WITH t SELECT FROM
node: Tree.Handle => node.info,
ENDCASE => ERROR]
};
PutInfo: PUBLIC PROC [t: Tree.Link, value: Tree.Info] = {
WITH t SELECT FROM
node: Tree.Handle => node.info ← value;
ENDCASE => ERROR
};
GetExt: PUBLIC PROC[t: Tree.Link] RETURNS[Tree.Ext] ~ {
RETURN [WITH t SELECT FROM
node: Tree.Handle =>
IF node.name # $locator THEN node.ext ELSE GetExt[node.son[1]],
ENDCASE => ERROR]
};
PutExt: PUBLIC PROC[t: Tree.Link, ext: Tree.Ext] ~ {
WITH t SELECT FROM
node: Tree.Handle =>
IF node.name # $locator THEN node.ext ← ext
ELSE PutExt[node.son[1], ext];
ENDCASE => ERROR
};
procedures for tree traversal
StartVisit: PUBLIC PROC[tm: TM] RETURNS[BOOL] ~ {
IF tm.visiting THEN ERROR;
tm.visiting ← TRUE; tm.mark ← ~tm.mark;
RETURN [tm.mark]};
EndVisit: PUBLIC PROC[tm: TM] ~ {
tm.visiting ← FALSE};
ScanSons: PUBLIC PROC[root: Tree.Link, action: TreeOps.Scan] ~ {
WITH root SELECT FROM
node: Tree.Handle =>
FOR i: Tree.SonId IN [1 .. node.sonLimit) DO action[node.son[i]] ENDLOOP;
ENDCASE;
};
SearchSons: PUBLIC PROC[root: Tree.Link, test: TreeOps.Test] RETURNS[BOOL] ~ {
WITH root SELECT FROM
node: Tree.Handle =>
FOR i: Tree.SonId IN [1 .. node.sonLimit) DO
IF test[node.son[i]] THEN RETURN[TRUE]
ENDLOOP;
ENDCASE;
RETURN[FALSE]};
UpdateSons: PUBLIC PROC[tm: TM, root: Tree.Link, map: TreeOps.Map] ~ {
WITH root SELECT FROM
node: Tree.Handle =>
FOR i: Tree.SonId IN [1 .. node.sonLimit) DO
node.son[i] ← map[tm, node.son[i]]
ENDLOOP;
ENDCASE;
};
UpdateLeaves: PUBLIC PROC[tm: TM, root: Tree.Link, map: TreeOps.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[tm, node.son[i]] ENDLOOP;
v ← root};
ENDCASE => v ← map[tm, root];
RETURN};
cross-table tree manipulation
CopyTree: PUBLIC PROC[tm: TM, root: Tree.Link, map: TreeOps.Map]
RETURNS[v: Tree.Link] ~ {
IF root = Tree.null THEN v ← Tree.null
ELSE
WITH root SELECT FROM
sNode: Tree.Handle => {
dNode: Tree.Handle ~ (tm.z).NEW[Tree.Node[NSons[sNode]] ← [
name~sNode.name,
attrs~sNode.attrs,
visited~tm.mark,
info~sNode.info,
son~]];
FOR i: Tree.SonId IN [1..sNode.sonLimit) DO
dNode.son[i] ← map[tm, sNode.son[i]] ENDLOOP;
v ← dNode}
ENDCASE => v ← map[tm, root];
RETURN};
IdentityMap: PUBLIC TreeOps.Map~{
RETURN[IF ISTYPE[t, Tree.Handle] THEN CopyTree[tm, t, IdentityMap] ELSE t]};
}.