-- file SakuraTreeImpl.Mesa
-- last modified by Satterthwaite, January 13, 1981 9:27 AM
-- last edit by Russ Atkinson, 5-Jun-81 14:32:03
-- last edit by Suzuki 28-Dec-81 8:41:10
DIRECTORY
PPLeaves: TYPE USING [HTIndex, ISEIndex],
Rope: TYPE USING [Equal, Ref],
SakuraTree: TYPE USING [
AttrId, Id, Handle, Link, Map, Node, NodeName, Scan, SonId, Test,
Null, NullHandle],
SakuraTreeOps: TYPE USING [];
SakuraTreeImpl: PROGRAM IMPORTS Rope EXPORTS SakuraTreeOps =
BEGIN OPEN PPLeaves, Tree: SakuraTree;
initialized: BOOLEAN ← FALSE;
LinkStack: TYPE = RECORD [SEQUENCE size: NAT OF Tree.Link];
stack: REF LinkStack;
sI: NAT;
Initialize: PUBLIC PROC = {
IF initialized THEN Finalize[];
stack ← AllocStack[256]; sI ← 0;
initialized ← TRUE};
Reset: PUBLIC PROC = {
IF initialized AND stack.size > 256
THEN {FreeStack[stack]; stack ← AllocStack[256]}};
Finalize: PUBLIC PROC = {initialized ← FALSE; stack ← NIL};
AllocStack: PROC [size: NAT] RETURNS [REF LinkStack] = INLINE {
RETURN [NEW[LinkStack[size]]]};
FreeStack: PROC [s: REF LinkStack] = INLINE {NULL};
ExpandStack: PROC = {
newStack: REF LinkStack = AllocStack[stack.size+256];
FOR i: NAT IN [0 .. stack.size) DO newStack[i] ← stack[i] ENDLOOP;
FreeStack[stack]; stack ← newStack};
Eq: PUBLIC PROC [l,r: Tree.Link] RETURNS [BOOLEAN] = {
WITH l SELECT FROM
u: Tree.Handle => {
WITH r SELECT FROM
n: Tree.Handle => {
IF u.name#n.name THEN RETURN [FALSE];
IF u.sonLimit# n.sonLimit THEN RETURN [FALSE];
FOR i: NAT IN [1..u.sonLimit) DO
IF NOT Eq[u.son[i],n.son[i]] THEN RETURN [FALSE];
ENDLOOP;
RETURN[TRUE]};
ENDCASE => RETURN[FALSE]};
v: HTIndex => {
WITH r SELECT FROM
n: HTIndex => RETURN[Rope.Equal[v.name, n.name]];
ENDCASE => RETURN[FALSE]};
ENDCASE => ERROR};
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 ~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: BOOLEAN] = {
v: Tree.Link = stack[sI-1];
WITH v SELECT FROM
node: Tree.Handle => node.attr[which] ← value;
ENDCASE => ERROR};
PrintName: PUBLIC PROC [name: Tree.NodeName] RETURNS[Rope.Ref] = {
RETURN[PrintTable[name]]};
PrintTable: ARRAY Tree.NodeName OF Rope.Ref ← ["list","item",
-- declarations --
"decl","typedecl","basicTC","enumeratedTC","recordTC","monitoredTC","variantTC",
"refTC","pointerTC","listTC","arrayTC","arraydescTC","sequenceTC","procTC",
"processTC","portTC","signalTC","errorTC","programTC","anyTC","definitionTC",
"unionTC","relativeTC","subrangeTC","longTC","opaqueTC","zoneTC","linkTC",
"spareTC","implicitTC","frameTC","discrimTC","entry","internal","unit",
"diritem","module","body","inline","lambda","block",
-- statements --
"assign","extract","if","case","casetest","caseswitch","bind","do","forseq",
"upthru","downthru","return","result","goto","exit","loop","free","resume",
"reject","continue","retry","catchmark","restart","stop","lock","wait","notify",
"broadcast","unlock","null","label","open","enable","catch","dst","lst","lstf",
"syscall","spareS1","spareS2","spareS3","subst","call","portcall","signal",
"error","syserror","xerror","start","join",
-- expressions --
"apply","callx","portcallx","signalx","errorx","syserrorx","startx","fork",
"joinx","index","dindex","seqindex","reloc","construct","union","rowcons",
"sequence","substx","ifx","casex","bindx","assignx","extractx","or","and",
"relE","relN","relL","relGE","relG","relLE","in","notin","plus","minus","times",
"div","mod","dot","cdot","dollar","create","not","uminus","addr","uparrow",
"min","max","lengthen","abs","all","size","first","last","pred","succ",
"arraydesc","length","base","loophole","nil","new","void","clit","llit","cast",
"check","float","pad","chop","safen","syscallx","narrow","istype","openx",
"mwconst","atom","typecode","stringinit","textlit","signalinit","procinit",
"intOO","intOC","intCO","intCC",
"thread","none",
"exlist","initlist","ditem",
"self","mergecons",
-- Sakura nodes--
"connectorassign","connectorcreate","connectorfork","connectorjoin",
"componentcreate","compitem","deviceTC","deviceblock","devicehead","devicebody",
"transfer","parallel","guardedcommand","guardianblock","choice","on","when",
"whenloopup","whenloopdown","whenloopchange","whenup","whendown","whenchange",
"event","upsignal","downsignal","changesignal",
"circuit",
"alias","control","mossim","step"];
-- 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]};
-- stack manipulation
GetIth: PUBLIC PROC [i: CARDINAL] RETURNS [Tree.Link] = {
RETURN [stack[i]]};
StackSize: PUBLIC PROC RETURNS [CARDINAL] = {RETURN[sI]};
-- procedures for tree traversal
Append: PUBLIC PROC[l,r: Tree.Link] RETURNS [Tree.Link] = {
IF l=Tree.Null THEN RETURN[r]
ELSE RETURN[MakeList[ExpandList[l]+ExpandList[r]]]};
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] ← UpdateLeaves[node.son[i], map] 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]]};
ExpandList: PUBLIC PROC [a: Tree.Link] RETURNS [nLists: NAT] = {
i: NAT;
IF a=Tree.Null THEN RETURN[0];
IF OpName[a]#list THEN {PushTree[a]; RETURN[1]};
nLists ← NSons[a];
FOR i IN [1..nLists] DO
PushTree[NthSon[a,i]]
ENDLOOP};
-- cross-table tree manipulation
CopyTree: PUBLIC PROC [root: Tree.Id, map: Tree.Map] RETURNS [v: Tree.Link] = {
IF root=Tree.Null THEN v ← root
ELSE 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.