endIndex: Tree.Index = Tree.Index.LAST;
endMark: Tree.Link = [subtree[index: endIndex]];
initialized: PRIVATE BOOL ← FALSE;
table: PRIVATE Alloc.Handle;
LinkSeq: PRIVATE TYPE = RECORD [SEQUENCE length: CARDINAL OF Tree.Link];
LinkStack: PRIVATE TYPE = REF 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] = {
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:
PROC = {
IF initialized
AND stack.length > 250
THEN {
stack ← NEW[LinkSeq[250]]}};
Finalize:
PROC = {
table.DropNotify[UpdateBase]; table ← NIL;
stack ← NIL;
initialized ← FALSE};
ExpandStack:
PRIVATE
PROC = {
newStack: LinkStack = NEW[LinkSeq[stack.length + 256]];
FOR i: CARDINAL IN [0 .. stack.length) DO newStack[i] ← stack[i] ENDLOOP;
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].attrs ← ALL[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].attrs ← ALL[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].attrs ← ALL[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 tb[v.index].attrs[attr] ← value;
ENDCASE => ERROR};
FreeNode:
PROC [node: Tree.Index] = {
IF node # Tree.nullIndex
AND ~tb[node].shared
THEN {
i: CARDINAL;
t: Tree.Link;
n: CARDINAL ← 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, 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] = {
RETURN [
IF t # Tree.null
THEN tb[NARROW[t, Tree.Link.subtree].index].attrs[attr]
ELSE ERROR]};
PutAttr:
PROC [t: Tree.Link, attr: Tree.AttrId, value:
BOOL] = {
IF t = Tree.null THEN ERROR;
tb[NARROW[t, Tree.Link.subtree].index].attrs[attr] ← value};
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
subtree => IF t = Tree.null THEN FALSE ELSE tb[index].shared,
ENDCASE => FALSE]};
MarkShared:
PROC [t: Tree.Link, shared:
BOOL] = {
WITH t
SELECT
FROM
subtree => IF t # Tree.null 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]]};