-- SakuraRewriteImpl.mesa
-- Created by Suzuki: 6-Dec-81 20:47:27
-- Last edited by Suzuki: 19-Apr-82 13:45:07
DIRECTORY
Convert,
IOStream: TYPE USING [Handle, Close, CreateFileStream, PutChar, SetLength],
PPLeaves USING [HTIndex, IdFromRope, LTIndex, LTNode],
Rope,
SakuraRewrite,
SakuraTree,
SakuraTreeOps USING [Append, Eq, ExpandList,
MakeList, MakeNode, NSons, NthSon, OpName, PopTree, PrintName, PushList,
PushNode,
PushTree, SetAttr],
SymbolTable,
TTY;
SakuraRewriteImpl: PROGRAM
IMPORTS Convert, IOStream, PPLeaves, Rope, SakuraTreeOps, SymbolTable
EXPORTS SakuraRewrite = {
OPEN Tree: SakuraTree, SakuraTreeOps, PPLeaves, TTY;
Direction: TYPE = {Up, Down, Change};
MOSSIMName: TYPE = REF MOSSIMBody;
MOSSIMBody: TYPE = RECORD [next: MOSSIMName, name: Rope.Ref];
CR: CHARACTER = 15C;
NotImplemented: SIGNAL = CODE;
symbolTable: SymbolTable.Ref;
Rewrite: PUBLIC PROC [tree: SakuraTree.Link] RETURNS [SakuraTree.Link] = {
choiceNum ← 0;
symbolTable ← SymbolTable.Create[tableSize: 200];
[tree, , ] ← RewriteBody[tree, Tree.Null, Tree.Null, Tree.Null];
RETURN[tree]};
PutChoiceDecl: PUBLIC PROC [tree: Tree.Link] RETURNS [Tree.Link] = {
RETURN[tree]};
RewriteSons: PROC [root: Tree.Handle, in, out, representation: Tree.Link] RETURNS [newTree, decls, stmts: Tree.Link] = {
tempdecls, son, tempstmts: Tree.Link;
candidate: BOOLEAN ← FALSE;
decls ← stmts ← Tree.Null;
FOR i: NAT IN [1..SakuraTreeOps.NSons[root]]
DO
[son, tempdecls, tempstmts] ← RewriteBody[root.son[i], in, out, representation];
IF OpName[son] = list THEN candidate ← TRUE;
root.son[i] ← son;
decls ← Append[decls, tempdecls];
stmts ← Append[stmts, tempstmts];
ENDLOOP;
IF candidate AND OpName[root]=list THEN root ← Flatten[root];
RETURN[root, decls, stmts]};
Flatten: PROC [root: Tree.Handle] RETURNS [Tree.Handle] = {
sum: CARDINAL ← 0;
FOR i: NAT IN [1..NSons[root]] DO
IF OpName[root.son[i]]=list THEN sum ← sum+ExpandList[root.son[i]]
ELSE {PushTree[root.son[i]]; sum ← sum+1};
ENDLOOP;
RETURN [NARROW[MakeList[sum], Tree.Handle]]};
MOSSIMNames: MOSSIMName ← NIL;
AppendMOSSIMFile: PROC [id: Tree.Link] = {
temp: MOSSIMName ← NEW[MOSSIMBody];
temp.next ← MOSSIMNames;
temp.name ← Name[id];
MOSSIMNames ← temp};
Name: PROC [id: Tree.Link] RETURNS [Rope.Ref] = {
WITH id SELECT FROM
t: HTIndex => RETURN[t.name];
u: Tree.Handle =>
IF u.name=dot THEN
RETURN[Rope.Concat[Name[u.son[1]],
Rope.Concat[".", Name[u.son[2]]]]]
ELSE ERROR;
ENDCASE => ERROR};-- Name
MOSSIMRead: PROC [main, decls, stmts: Tree.Link] RETURNS [Tree.Link] = {
initDecl, initApply: Tree.Link;
num: CARDINAL ← 0;
IF MOSSIMNames = Tree.Null THEN RETURN[main];
-- Otherwise create
-- MAIN: PROC = {
-- SakuraRT.SIMRead[file1]; SakuraRT.SIMRead[file2]; ...};
-- main
-- MAIN[];
-- ...
PushProcTCNode["MAIN"];
PushNullNode[];
PushNullNode[];
UNTIL MOSSIMNames=Tree.Null DO
PushFuncCall[MakeDot["SakuraRT","SIMRead"],
MakeId[Rope.Concat["""", Rope.Concat[MOSSIMNames.name, """"]]]];
num ← num+1;
MOSSIMNames ← MOSSIMNames.next;
ENDLOOP;
PushList[num];
PushNullNode[];
PushNode[body, 4];
initDecl ← MakeNode[decl, 3];
initApply ← MakeFuncCall[MakeId["MAIN"], Tree.Null];
decls ← Append[NthSon[NthSon[main,3],2], decls];
decls ← Append[initDecl, decls];
stmts ← Append[NthSon[NthSon[main,3],3], stmts];
stmts ← Append[initApply, stmts];
LOOPHOLE[NthSon[main,3],Tree.Handle].son[2] ← decls;
LOOPHOLE[NthSon[main,3],Tree.Handle].son[3] ← stmts;
RETURN [main]};
RewriteBody: PROC [tree, in, out, representation: Tree.Link] RETURNS [newTree, decls, stmts: Tree.Link] = {
cond: Tree.Link;
IF tree=Tree.Null THEN RETURN[tree, Tree.Null, Tree.Null];
WITH tree SELECT FROM
node: Tree.Handle => {
SELECT node.name FROM
assign => WITH node.son[1] SELECT FROM
u: HTIndex =>
IF Port[u] THEN RETURN CreateConnectorAssign[node, u, in, out, representation]
ELSE RETURN RewriteSons[node, in, out, representation];
v: Tree.Handle => RETURN RewriteSons[node, in, out, representation];
ENDCASE => ERROR;
block => {
[newTree, decls, stmts] ← RewriteDecl[node, node.son[1], in, out, representation];
node.son[1] ← Append[node.son[1], decls];
decls ← Tree.Null};
body => {
[newTree, decls, stmts] ← RewriteDecl[node, node.son[2], in, out, representation];
node.son[2] ← Append[node.son[2], decls];
decls ← Tree.Null};
choice => RETURN RewriteChoice[node, in, out, representation];
circuit => RETURN RewriteCircuit[node, in, out];
deviceblock, guardedcommand, guardianblock => ERROR;
decl => {
device: Tree.Link ← SakuraTreeOps.NthSon[node, 2];
WITH device SELECT FROM
d: Tree.Handle =>
SELECT d.name FROM
deviceTC => RETURN RewriteDevice[node];
procTC => RETURN RewriteDecl[node, d.son[1], in, out, representation];
programTC => {
[newTree, decls, stmts] ← RewriteSons[node, in, out, representation];
RETURN[MOSSIMRead[newTree, decls, stmts], Tree.Null, Tree.Null]};
ENDCASE => RETURN RewriteSons[node, in, out, representation];
ENDCASE => RETURN[tree, Tree.Null, Tree.Null]};
module => {
[newTree, decls, stmts] ← RewriteSons[node, in, out, representation];
RETURN AddChoiceVarDecl[newTree, decls, stmts]};
on => RETURN RewriteOn[node, in, out, representation];
parallel => RETURN RewriteParallel[node, in, out, representation];
step => RETURN[RewriteStep[node, in, out, representation], Tree.Null, Tree.Null];
when => {
direction: Direction;
n: Tree.Handle;
event: Tree.Link ← SakuraTreeOps.NthSon[node,1];
signal: Tree.Link ← SakuraTreeOps.NthSon[event, 1];
n ← NARROW[signal, Tree.Handle];
SELECT n.name FROM
upsignal => direction ← Up;
downsignal => direction ← Down;
ENDCASE => direction ← Change;
IF (cond ← SakuraTreeOps.NthSon[event,2])#Tree.Null THEN
RETURN CreateWhenLoop[direction, NthSon[signal,1], cond, NthSon[node,2], in, out, representation]
ELSE RETURN CreateWhen[direction, NthSon[signal,1], NthSon[node,2], in, out, representation]};
ENDCASE => RETURN RewriteSons[node, in, out, representation]};
u: HTIndex => IF Port[u] THEN RETURN[MakeNarrow[u], Tree.Null, Tree.Null]
ELSE RETURN[u, Tree.Null, Tree.Null];
ENDCASE => RETURN[tree, Tree.Null, Tree.Null]};
CreateConnectorAssign: PROC[node: Tree.Handle, left: HTIndex, in, out, representation: Tree.Link] RETURNS [newTree, decls, stmts: Tree.Link] = {
node.name ← connectorassign;
PushId["NEW"];
PushTree[SymbolTable.Get[symbolTable, left.name].val];
[newTree, decls, stmts] ← RewriteBody[node.son[2], in, out, representation];
PushTree[newTree];
PushNode[assign, 2];
node.son[2] ← MakeNode[apply, 2];
RETURN[node, decls, stmts]};
RewriteStep: PROC [tree: Tree.Handle, in, out, representation: Tree.Link] RETURNS [Tree.Link] = {
id: Tree.Link;
num: CARDINAL ← 0;
EnumerateComps[in];
DO
[id, ] ← NextComps[];
IF id=Tree.Null THEN EXIT;
IF ~MemReps[id, representation] THEN LOOP;
PushOneArgCall["SakuraRT", "SIMSet", NARROW[id, PPLeaves.HTIndex].name];
num ← num+1;
ENDLOOP;
PushNoArgCall["SakuraRT", "SIMStep"];
EnumerateComps[out];
DO
[id, ] ← NextComps[];
IF id=Tree.Null THEN EXIT;
IF ~MemReps[id, representation] THEN LOOP;
PushOneArgCall["SakuraRT", "SIMGet", NARROW[id, PPLeaves.HTIndex].name];
num ← num+1;
ENDLOOP;
RETURN[MakeList[num+1]]
};
MemReps: PROC [id, representation: Tree.Link] RETURNS [BOOLEAN] = {
name: Rope.Ref ← NARROW[id, PPLeaves.HTIndex].name;
FOR i: NAT IN [1..NSons[representation]] DO
IF Rope.Equal[name, NARROW[NthSon[NthSon[representation, i], 2],
PPLeaves.HTIndex].name] THEN
RETURN [TRUE]
ENDLOOP;
RETURN [FALSE]}; -- MemReps
RewriteDecl: PROC [tree, decl, in, out, representation: Tree.Link] RETURNS [newTree, decls, stmts: Tree.Link] = {
IF decl#Tree.Null THEN {
SymbolTable.Mark[symbolTable];
IF OpName[decl]=list THEN
FOR i: NAT IN [1..NSons[decl]] DO
AddDecl[NthSon[decl, i]]
ENDLOOP
ELSE AddDecl[decl]};
IF OpName[tree]=circuit THEN [newTree, decls, stmts] ← RewriteCircuit[NARROW[tree, Tree.Handle], in, out]
ELSE [newTree, decls, stmts] ← RewriteSons[NARROW[tree, Tree.Handle], in, out, representation];
IF decl#Tree.Null THEN SymbolTable.Pop[symbolTable]};
RewriteChoice: PROC [tree, in, out, representation: Tree.Link] RETURNS [newTree, decls, stmts: Tree.Link] = {
-- change the choice tree. The side effect is that the declarations are made.
choice, guardedcommand, signal, sondecls, sonstmts, temp: Tree.Link;
size: CARDINAL ← 1;
name: Rope.Ref ← GenSymChoice[];
IF OpName[NthSon[tree, 1]]=list THEN
{choice ← NthSon[tree, 1]; size ← NSons[choice]}
ELSE choice ← tree;
-- push the Register statements
FOR i: NAT IN [1..size] DO
PushId["SakuraRT"];
SELECT OpName[signal ← NthSon[NthSon[NthSon[choice,i],1],1]] FROM
upsignal => PushId["RegisterUp"];
downsignal => PushId["RegisterDown"];
changesignal => PushId["RegisterChange"];
ENDCASE;
PushNode[dot, 2];
PushId[name];
PushCARDINAL[i];
PushTree[NthSon[signal,1]];
PushList[3];
PushNode[apply, 2];
ENDLOOP;
stmts ← MakeList[size];
-- push case statements
PushFuncCall[MakeDot["SakuraRT", "GetChoice"], MakeId[name]];
-- push each leg of the case
decls ← Tree.Null;
FOR i: NAT IN [1..size] DO
-- if there is a condition test after the signal receive, it comes here
guardedcommand ← NthSon[choice,i];
IF NSons[NthSon[NthSon[guardedcommand,1],1]]=2 THEN SIGNAL NotImplemented;
PushCARDINAL[i];
[temp, sondecls, sonstmts] ← RewriteBody[NthSon[guardedcommand, 2], in, out, representation];
decls ← Append[decls, sondecls];
stmts ← Append[stmts, sonstmts];
PushTree[temp];
PushNode[item, 2];
ENDLOOP;
PushList[size];
PushNode[syserror, 0];
RETURN[MakeNode[case, 3], decls, stmts]};
RewriteGuardian: PROC [tree, in, out: Tree.Link] RETURNS [Tree.Link] = {
SELECT OpName[NthSon[tree,2]] FROM
control => RETURN[RewriteGuardianControl[tree]];
mossim => RETURN[RewriteGuardianMOSSIM[tree,in, out]];
ENDCASE => ERROR;
};
RewriteGuardianControl: PROC [tree: Tree.Link] RETURNS [Tree.Link] = {
-- Rewrite FROM
-- GUARDIANBLOCK {A; B}
-- TO
-- {guardian: PROC = {A; SakuraRT.ProcessEnd[]};
-- p: PROCESS;
-- p ← SakuraRT.Fork[guardian];
-- B;
-- [] ← SakuraRT.Join[p]};
--
PushNullNode[];
IF NthSon[tree, 1] = Tree.Null THEN {
b: Tree.Link ← NthSon[NthSon[tree, 2], 1];
decl, stmt: Tree.Link;
n: CARDINAL;
IF OpName[b]#block THEN {decl ← Tree.Null; stmt ← b}
ELSE {decl ← NthSon[b,1]; stmt ← NthSon[b,2]};
PushTree[decl];
n ← ExpandList[stmt];
PushProcessEnd[];
PushList[n+1]}
ELSE {
DeclareGuardian[tree];
-- p ← SakuraRT.Fork[guardian];
PushSakuraRTForkNode[process: "p", body: "guardian"];
-- B;
PushTree[NthSon[NthSon[tree, 2], 1]];
-- [] ← SakuraRT.Join[p];
PushSakuraRTJoin["p"];
-- SakuraRT.ProcessEnd[]
PushProcessEnd[];
PushList[5]};
AddEnable[];
PushNullNode[];
RETURN[MakeNode[body, 4]]};
RewriteGuardianMOSSIM: PROC [tree, in, out: Tree.Link] RETURNS [Tree.Link] = {
--Rewrite FROM
-- GUARDIANBLOCK {A; B}
-- TO
-- {
--x guardian: PROC = {A; SakuraRT.ProcessEnd[]};
--x p: PROCESS;
--x p ← SakuraRT.Fork[guardian];
-- SakuraRT.SIMMultiConnectInit[B.3, <number>];
-- ...
-- B;
--x Process.Abort[p];
--x [] ← SakuraRT.Join[p];
-- SakuraRT.ProcessEnd[]}
connectNum: CARDINAL;
guardian: BOOLEAN;
guardStmtNum: CARDINAL = 3;
AppendMOSSIMFile[NthSon[NthSon[tree,2],1]];
IF NthSon[tree, 1] = Tree.Null THEN guardian ← FALSE ELSE guardian ← TRUE;
IF guardian THEN DeclareGuardian[tree]
ELSE PushNullNode[];
--x p ← SakuraRT.Fork[guardian];
IF guardian THEN PushSakuraRTForkNode[process: "p", body: "guardian"];
-- SakuraRT.SIMMultiConnectInit[B.3, <number>];
-- ...
connectNum ← PushRepresentation[NthSon[NthSon[tree,2],2]];
-- B.3;
PushTree[NthSon[NthSon[tree, 2], 3]];
--x Process.Abort[p];
--x [] ← SakuraRT.Join[p];
IF guardian THEN {
PushFuncCall[MakeDot["Process","Abort"], MakeId["p"]];
PushSakuraRTJoin["p"]};
-- SakuraRT.ProcessEnd[]
PushProcessEnd[];
PushList[1+connectNum+(IF guardian THEN guardStmtNum+1 ELSE 0)];
AddEnable[];
PushNullNode[];
RETURN[MakeNode[body,4]]
};
DeclareGuardian: PROC [tree: Tree.Link] = {
-- guardian: PROC = {A};
PushProcTCNode["guardian"];
PushStatementBlock[NthSon[tree, 1]];
PushTree[AppendProcessEnd[]];
AddEnable[];
PushNode[decl, 3];
SetAttrs[TRUE, FALSE, FALSE];
-- p: PROCESS;
PushProcessDecl[MakeId["p"]];
SetAttrs[TRUE, FALSE, FALSE];
PushList[2]};
AddEnable: PROC = {
-- top of the stack is p
-- Replace the top of the stack with
-- enable 37
-- catch 0
-- item 44
-- 44 ABORTED
-- goto 51
-- Aborted
-- NIL
-- p
-- Then at the end do AddExit[]
p: Tree.Link ← PopTree[];
PushId["ABORTED"];
PushId["Aborted"];
PushNode[goto, 1];
PushNode[item, 2];
PushNullNode[];
PushNode[catch, 2];
PushTree[p];
PushNode[enable, 2];
AddExit[]};
AddExit: PROC = {
-- top of the stack is p
-- Replace the top of the stack with
-- label 33
-- p
-- item 82
-- 82 Aborted
-- apply
-- dot
-- SakuraRT
-- ProcessEnd
-- NIL
PushId["Aborted"];
PushNoArgCall["SakuraRT", "Abort"];
PushNode[item, 2];
PushNode[label, 2]};
PushRepresentation: PROC [tree: Tree.Link] RETURNS [CARDINAL] = {
-- argument is an aliaslist
-- Effect: pushes connection statements and returns the number of elements pushed
PushRep: PROC [tree: Tree.Link] RETURNS [CARDINAL] = {
-- argument is an alias
-- Effect: pushes a connection and returns the number of elements pushed
real: Tree.Link ← NthSon[tree, 1];
rep: Tree.Link ← NthSon[tree, 2];
IF OpName[real]=list THEN {
itemNum: CARDINAL ← NSons[real];
pushed: CARDINAL ← 1;
PushTwoArgCall["SakuraRT", "SIMMultiConnectInit", rep,
MakeNum[itemNum]];
FOR i: NAT IN [1..itemNum] DO
PushThreeArgCall["SakuraRT", "SIMMultiConnectAssign", rep,
MakeQuoteName[NthSon[real,i]], MakeNum[i-1]];
pushed ← pushed+1;
ENDLOOP;
RETURN [pushed]}
ELSE {
PushTwoArgCall["SakuraRT", "SIMMultiConnect", rep,
MakeQuoteName[real]];
RETURN[1]}
}; -- PushRep
sum: CARDINAL ← 0;
IF OpName[tree] = list THEN {
FOR i: NAT IN [1..NSons[tree]] DO
sum ← sum + PushRep[NthSon[tree, i]];
ENDLOOP;
RETURN[sum]}
ELSE RETURN PushRep[tree]
};
RewriteOn: PROC [tree: Tree.Handle, in, out, representation: Tree.Link] RETURNS [newTree, decls, stmts: Tree.Link] = {
-- Rewrite FROM
-- ON c UP -> s1 IN s2
-- TO
-- {d1: PROC = {WHEN c UP: s1; Process.Abort[p2]};
-- d2: PROC = {ENABLE ABORTED => GOTO End; s2; EXITS End => NULL};
-- p1, p2: PROCESS;
-- p1 ← SakuraRT.Fork[d1];
-- p2 ← SakuraRT.Fork[d2];
-- [] ← JOIN p1;
-- [] ← JOIN p2};
c, s1, s2: Tree.Link;
c ← NthSon[tree, 1];
s1 ← NthSon[tree, 2];
s2 ← NthSon[tree, 3];
-- d1: PROC = {WHEN c UP: s1; Process.Abort[p2]};
PushProcTCNode["d1"];
PushNullNode[];
PushTree[c];
PushTree[s1];
PushNode[when, 2];
PushFuncCall[MakeDot["Process", "Abort"], MakeId["p2"]];
PushList[2];
PushNode[block, 2];
PushNode[decl, 3];
SetAttrs[TRUE, FALSE, FALSE];
-- d2: PROC = {ENABLE ABORTED => GOTO End; s2; EXITS End => NULL};
PushProcTCNode["d2"];
PushNullNode[];
PushNullNode[];
PushId["ABORTED"];
PushId["End"];
PushNode[goto, 1];
PushNode[item, 2];
PushNullNode[];
PushNode[catch, 2];
PushTree[s2];
PushNode[enable, 2];
PushId["End"];
PushNode[void, 0];
PushNode[item, 2];
PushNode[label, 2];
PushNullNode[];
PushNode[body, 4];
PushNode[decl, 3];
SetAttrs[TRUE, FALSE, FALSE];
-- p1, p2: PROCESS;
PushId["p1"];
PushId["p2"];
PushProcessDecl[MakeList[2]];
PushList[3];
-- p1 ← SakuraRT.Fork[d1];
PushSakuraRTForkNode[process: "p1", body: "d1"];
-- p2 ← SakuraRT.Fork[d2];
PushSakuraRTForkNode[process: "p2", body: "d2"];
-- [] ← SakuraRT.Join[p1];
PushSakuraRTJoin["p1"];
-- [] ← SakuraRT.Join[p2];
PushSakuraRTJoin["p2"];
PushList[6];
RETURN RewriteBody[MakeNode[block, 2], in, out, representation]};
RewriteParallel: PROC [tree: Tree.Handle, in, out, representation: Tree.Link] RETURNS [newTree, decls, stmts: Tree.Link] = {
-- Rewrites FROM
-- PAR {s1 // s2}
-- TO
-- {st1: PROC = {s1; SakuraRT.ProcessEnd[]};
-- st2: PROC = {s2; SakuraRT.ProcessEnd[]};
-- process1: PROCESS ← SakuraRT.Fork[st1];
-- process2: PROCESS ← SakuraRT.Fork[st2];
-- SakuraRT.DecCurrent[];
-- [] ← SakuraRT.Join[process1];
-- [] ← SakuraRT.Join[process2];
-- SakuraRT.IncCurrent[]};
base, tempdecls, tempstmts: Tree.Link;
gensymStart, size: CARDINAL;
decls ← stmts ← Tree.Null;
IF OpName[tree.son[1]]=list THEN {base ← tree.son[1]; size ← NSons[base]}
ELSE {base ← tree; size ← 1};
gensymStart ← processNum;
-- Create process body declarations
FOR i: NAT IN [1..size] DO
PushProcTCNode[GensymProcessBody[]];
PushNullNode[];
[newTree, tempdecls, tempstmts] ←
RewriteBody[NthSon[base, i], in, out, representation];
decls ← Append[decls, tempdecls];
stmts ← Append[stmts, tempstmts];
PushTree[newTree];
PushTree[AppendProcessEnd[]];
PushNode[block, 2];
AddEnable[];
PushNode[decl, 3];
SetAttrs[TRUE, FALSE, FALSE];
ENDLOOP;
-- Create process var declarations
FOR i: NAT IN [1..size] DO
PushId[GensymProcess[]];
ENDLOOP;
PushProcessDecl[MakeList[size]];
SetAttrs[TRUE, FALSE, FALSE];
PushList[size+1];
ResetGensymProcessBody[gensymStart];
-- Create forks
ResetGensymProcess[gensymStart];
FOR i: NAT IN [1..size] DO
PushSakuraRTForkNode[process: GensymProcess[], body: GensymProcessBody[]];
ENDLOOP;
-- Creates DecCurrent
PushFuncCall[MakeDot["SakuraRT", "DecCurrent"], Tree.Null];
-- Create joins
ResetGensymProcess[gensymStart];
FOR i: NAT IN [1..size] DO
PushSakuraRTJoin[process: GensymProcess[]];
ENDLOOP;
-- Create IncCurrent
PushFuncCall[MakeDot["SakuraRT", "IncCurrent"], Tree.Null];
PushList[3*size+2];
RETURN[MakeNode[block, 2], decls, stmts]};
RewriteCircuit: PROC[t: Tree.Handle, in, out: Tree.Link] RETURNS[Tree.Link, Tree.Link, Tree.Link] = { OPEN SakuraTreeOps;
stnum: NAT;
declnum: NAT ← PushNodeDecls[t.son[2]];
declnum ← declnum+PushConnections[t.son[4], t.son[1]];
PushList[declnum];
-- decrement currentProcessSize
PushFuncCall[MakeDot["SakuraRT", "DecCurrent"], Tree.Null];
stnum ← PushJoins[t.son[1]];
-- increment currentProcessSize
PushFuncCall[MakeDot["SakuraRT", "IncCurrent"], Tree.Null];
PushList[stnum+2];
RETURN[MakeNode[block, 2], Tree.Null, Tree.Null]};
RewriteDevice: PROC [tree: Tree.Link] RETURNS [Tree.Link, Tree.Link, Tree.Link] = {
OPEN SakuraTreeOps;
controlLoc: CARDINAL;
devicetc: Tree.Link ← NthSon[tree,2];
args, body, deviceblock, devicebody, guardian,
in, out, new, decls, representation, stmts: Tree.Link;
entry: BOOLEAN;
public: BOOLEAN ← NARROW[tree, Tree.Handle].attr[2];
args ← NthSon[devicetc,1];
IF (body ← NthSon[tree, 3])=Tree.Null THEN {
SymbolTable.Mark[symbolTable];
PushTree[NthSon[tree,1]];
PushList[ExpandList[args]];
PushTree[NthSon[devicetc,2]];
PushNode[procTC, 2];
SymbolTable.Pop[symbolTable];
PushNullNode[];
RETURN[MakeNode[decl, 3], Tree.Null, Tree.Null]};
IF (entry ← (OpName[body] = entry)) THEN
deviceblock ← NthSon[NthSon[body,1],3]
ELSE deviceblock ← NthSon[body,3];
devicebody ← NthSon[deviceblock, 4];
guardian ← NthSon[deviceblock, 3];
in ← NthSon[deviceblock,1];
out ← NthSon[deviceblock,2];
SymbolTable.Mark[symbolTable];
CatalogPorts[in];
CatalogPorts[out];
PushTree[NthSon[tree,1]];
PushList[ExpandList[args]+ExpandNodeList[in, public]
+ExpandNodeList[out, public]];
PushTree[NthSon[devicetc,2]];
PushNode[procTC, 2];
IF OpName[devicebody] = mossim THEN {
representation ← NthSon[devicebody,2];
controlLoc ← 3}
ELSE {
representation ← NIL;
controlLoc ← 1};
IF guardian=NIL AND devicebody=NIL THEN {
PushNullNode[];
SymbolTable.Pop[symbolTable];
PushNode[decl, 3];
SetAttr[2, public];
RETURN[PopTree[], Tree.Null, Tree.Null]};
PushRewriteBody[guardian, in, out, representation];
[new, decls, stmts] ←
RewriteBody[NthSon[devicebody, controlLoc], in, out, representation];
LOOPHOLE[devicebody,Tree.Handle].son[controlLoc] ←
AppendToBlock[decls, new, stmts];
PushTree[devicebody];
SymbolTable.Pop[symbolTable];
PushTree[RewriteGuardian[MakeNode[guardianblock, 2],in,out]];
IF entry THEN PushNode[entry, 1];
PushNode[decl, 3];
SetAttr[2, public];
RETURN[PopTree[], Tree.Null, Tree.Null]};
Port: PROC [tree: HTIndex] RETURNS [BOOLEAN] = {
RETURN[SymbolTable.Get[symbolTable, tree.name].port]};
PushId: PROC [ref: Rope.Ref] = {
PushTree[PPLeaves.IdFromRope[ref,0]]};
MakeId: PROC [ref: Rope.Ref] RETURNS [Tree.Link] = {
RETURN[PPLeaves.IdFromRope[ref,0]]};
MakeNum: PROC [num: CARDINAL] RETURNS [Tree.Link] = {
ret: PPLeaves.LTIndex ← NEW[PPLeaves.LTNode];
ret.index ← 0;
ret.value ← NEW[CARDINAL ← num];
ret.literal ← RopeFromCard[num];
RETURN[ret]};
RopeFromCard: PROC [num: CARDINAL] RETURNS [Rope.Ref] = {
val: Convert.Value ← [value: signed[num, 10]];
RETURN[Convert.ValueToRope[val]]};
MakeQuoteName: PROC [tree: Tree.Link] RETURNS [Tree.Link] = {
val: PPLeaves.HTIndex ← NARROW[tree, PPLeaves.HTIndex];
rope: Rope.Ref ← Rope.Concat["""", val.name];
rope ← Rope.Concat[rope, """"];
RETURN [PPLeaves.IdFromRope[rope, 0]]};
PushIdList: PROC [in, out: Tree.Link] RETURNS [CARDINAL] = {
-- result is 1 if in and out are both NIL, else result is 0
idnum: CARDINAL ← 0;
PushLocName: PROC [id: Tree.Link] = {
PushId[Rope.Concat["loc", NARROW[id,HTIndex].name]]};
id: Tree.Link;
EnumerateComps[in];
DO
[id,] ← NextComps[];
IF id=Tree.Null THEN EXIT;
PushLocName[id];
idnum ← idnum+1;
ENDLOOP;
EnumerateComps[out];
DO
[id,] ← NextComps[];
IF id=Tree.Null THEN EXIT;
PushLocName[id];
idnum ← idnum+1;
ENDLOOP;
IF idnum=0 THEN RETURN [1];
PushList[idnum];
PushId["CARDINAL"];
PushNullNode[];
PushNode[decl, 3];
RETURN [0]};
AddChoiceVarDecl: PROC [tree, oldDecls, oldStmts: Tree.Link]
RETURNS [Tree.Link, Tree.Link, Tree.Link] = {
decl: Tree.Link ← NthSon[NthSon[NthSon[tree,5],3],2];
oldChoiceNum: CARDINAL;
IF choiceNum=0 THEN RETURN[tree, oldDecls, oldStmts];
oldChoiceNum ← choiceNum;
choiceNum ← 0;
FOR i: NAT IN [1..oldChoiceNum] DO
PushId[GenSymChoice[]];
PushDot["SakuraRT", "Choice"];
PushFuncCall[MakeDot["SakuraRT", "CreateChoice"], Tree.Null];
PushNode[decl,3];
ENDLOOP;
IF OpName[decl]=list THEN {
FOR i: NAT IN [1..NSons[decl]] DO
PushTree[NthSon[decl,i]];
ENDLOOP;
PushNode[list, choiceNum+NSons[decl]]}
ELSE {
PushTree[decl];
PushNode[list, choiceNum+1]};
NARROW[NthSon[NthSon[tree,5],3],Tree.Handle].son[2] ← PopTree[];
RETURN[tree, oldDecls, oldStmts]};
CreateWhenLoop: PROC [direction: Direction, left, cond, st, in, out, representation: Tree.Link]
RETURNS [newTree, decls, stmts: Tree.Link] = { OPEN SakuraTreeOps;
tempbody, tempdecl, tempstmts: Tree.Link;
decls ← stmts ← Tree.Null;
PushTree[left];
[tempbody, decls, stmts] ← RewriteBody[cond, in, out, representation];
PushTree[tempbody];
IF st=Tree.Null THEN PushNullNode[]
ELSE {
[tempbody, tempdecl, tempstmts] ← RewriteBody[st, in, out, representation];
PushTree[tempbody];
decls ← Append[decls, tempdecl];
stmts ← Append[stmts, tempstmts]};
RETURN[SELECT direction FROM
Up => MakeNode[whenloopup, 3],
Down => MakeNode[whenloopdown, 3],
ENDCASE => MakeNode[whenloopchange, 3], decls, stmts]};
CreateWhen: PROC [direction: Direction, left, st, in, out, representation: Tree.Link]
RETURNS [newTree, decls, stmts: Tree.Link] = { OPEN SakuraTreeOps;
tempbody: Tree.Link;
decls ← stmts ← Tree.Null;
PushTree[left];
IF st=Tree.Null THEN PushNullNode[]
ELSE {
[tempbody, decls, stmts] ← RewriteBody[st, in, out, representation];
PushTree[tempbody]};
RETURN[SELECT direction FROM
Up => MakeNode[whenup, 2],
Down => MakeNode[whendown, 2],
ENDCASE => MakeNode[whenchange, 2], decls, stmts]};
MakeNarrow: PROC [tree: HTIndex] RETURNS [Tree.Link] = {
-- Returns NARROW[SakuraRT.Get[tree], REF type]↑
type: Tree.Link ← SymbolTable.Get[symbolTable, tree.name].val;
name: Rope.Ref ← Name[type];
IF Rope.Equal[name, "CARDINAL"] THEN
RETURN[MakeFuncCall[MakeDot["SakuraRT", "GetCard"], tree]]
ELSE IF Rope.Equal[name, "BOOLEAN"] THEN
RETURN[MakeFuncCall[MakeDot["SakuraRT", "GetBool"], tree]]
ELSE {
PushId["NARROW"];
PushFuncCall[MakeDot["SakuraRT", "Get"], tree];
PushTree[type];
PushNode[refTC, 1];
PushList[2];
PushNode[apply, 2];
RETURN[MakeNode[uparrow, 1]]}
};
AddDecl: PROC [tree: Tree.Link] = {
AddItem: PROC [name: HTIndex, type: Tree.Link] = {
SymbolTable.Add[symbolTable, name.name, type, FALSE]};
IF OpName[tree]#decl AND OpName[tree]#typedecl THEN ERROR;
WITH NthSon[tree, 1] SELECT FROM
node: Tree.Handle =>
FOR i: NAT IN [1..node.sonLimit) DO
AddItem[NARROW[node.son[i], HTIndex], NthSon[tree, 2]] ENDLOOP;
u: HTIndex => AddItem[u, NthSon[tree, 2]];
ENDCASE => ERROR};
choiceNum: CARDINAL ← 0;
GenSymChoice: PROC RETURNS [ret: Rope.Ref] = {
value: unsigned Convert.Value;
choiceNum ← choiceNum+1;
value ← [value: unsigned[choiceNum]];
ret ← Rope.Concat["choice", Convert.ValueToRope[value]]};
PushCARDINAL: PROC [num: CARDINAL] = {
value: unsigned Convert.Value;
value.unsigned ← num;
PushTree[NEW[PPLeaves.LTNode ← [index: 0, value: NEW[CARDINAL ← num],
literal: Convert.ValueToRope[value]]]]};
PushFuncCall: PROC [name, args: Tree.Link] = {
PushTree[name];
PushTree[args];
PushNode[apply, 2]};
PushNoArgCall: PROC [module, function: Rope.Ref] = {
-- pushes the call module.function[]
PushDot[module, function];
PushNullNode[];
PushNode[apply, 2]
};
PushOneArgCall: PROC [module, function: Rope.Ref, p1: Tree.Link] = {
-- pushes the call module.function[p1]
PushDot[module, function];
PushTree[p1];
PushNode[apply, 2]};
PushTwoArgCall: PROC [module, function: Rope.Ref, p1, p2: Tree.Link] = {
-- pushes the call module.function[p1, p2]
PushDot[module, function];
PushTree[p1];
PushTree[p2];
PushList[2];
PushNode[apply, 2]};
PushThreeArgCall: PROC [module, function: Rope.Ref, p1, p2, p3: Tree.Link] = {
-- pushes the call module.function[p1, p2, p3]
PushDot[module, function];
PushTree[p1];
PushTree[p2];
PushTree[p3];
PushList[3];
PushNode[apply, 2]};
MakeFuncCall: PROC [name, args: Tree.Link] RETURNS [Tree.Link] = {
PushTree[name];
PushTree[args];
RETURN[MakeNode[apply, 2]]};
PushDot: PROC [left, right: Rope.Ref] = {
PushId[left];
PushId[right];
PushNode[dot,2]};
MakeDot: PROC [left, right: Rope.Ref] RETURNS [Tree.Link] = {
PushId[left];
PushId[right];
RETURN[MakeNode[dot,2]]};
PushNullNode: PROC = {
PushTree[Tree.Null]};
PushProcessEnd: PROC = {
-- SakuraRT.ProcessEnd[]
PushFuncCall[MakeDot["SakuraRT", "ProcessEnd"], Tree.Null]};
PushSakuraRTIncCurrent: PROC = {
-- SakuraRT.IncCurrent[];
PushFuncCall[MakeDot["SakuraRT", "IncCurrent"], Tree.Null]};
PushSakuraRTForkNode: PROC [process, body: Rope.Ref] = {
PushId[process];
PushFuncCall[MakeDot["SakuraRT", "Fork"], MakeId[body]];
PushNode[assign, 2];
PushFuncCall[MakeDot["SakuraRT", "CatalogProcId"], MakeId[process]]};
PushSakuraRTJoin: PROC [process: Rope.Ref] = {
PushNullNode[];
PushFuncCall[MakeDot["SakuraRT", "Join"], MakeId[process]];
PushNode[extract, 2]};
IdLengthInDecl: PROC [in: Tree.Link] RETURNS [CARDINAL] = {
sum: CARDINAL ← 0;
id: Tree.Link;
EnumerateComps[in];
DO
[id,] ← NextComps[];
IF id=Tree.Null THEN RETURN [sum];
sum ← sum+1;
ENDLOOP};
PushProcTCNode: PROC [name: Rope.Ref] = {
PushId[name];
PushNullNode[];
PushNullNode[];
PushNode[procTC, 2]};
SetAttrs: PROC [attr1, attr2, attr3: BOOLEAN ← FALSE] =
BEGIN OPEN SakuraTreeOps;
SetAttr[1,attr1]; SetAttr[2,attr2]; SetAttr[3,attr3];
END;
PushStatementBlock: PROC [tree: Tree.Link] = {
IF OpName[tree]=block THEN PushTree[tree]
ELSE {
PushNullNode[];
PushTree[tree];
PushNode[block, 2]}};
AppendProcessEnd: PROC RETURNS [Tree.Link] = {
-- If the top of the stack is a block, then add a statement SakuraRT.ProcessEnd[]
--otherwise create a block with SakuraRT.ProcessEnd[] as the second statement
n: CARDINAL;
t: Tree.Link ← PopTree[];
IF OpName[t]=block THEN {
stmts: Tree.Link ← NthSon[t, 2];
n ← ExpandList[stmts];
PushProcessEnd[];
PushList[n+1];
NARROW[t, Tree.Handle].son[2] ← PopTree[];
RETURN[t]}
ELSE {
PushNullNode[];
PushTree[t];
PushProcessEnd[];
PushList[2];
RETURN[MakeNode[block, 2]]}
};
PushProcessDecl: PROC [name: Tree.Link] = {
PushTree[name];
PushNullNode[];
PushNullNode[];
PushNode[processTC, 2];
PushNullNode[];
PushNode[decl, 3]};
processNum: CARDINAL ← 0;
GensymProcess: PROC RETURNS [ret: Rope.Ref] = {
value: unsigned Convert.Value;
processNum ← processNum+1;
value ← [value: unsigned[processNum]];
ret ← Rope.Concat["process", Convert.ValueToRope[value]]};
ResetGensymProcess: PROC [num: CARDINAL] = {
processNum ← num};
processNumBody: CARDINAL ← 0;
GensymProcessBody: PROC RETURNS [ret: Rope.Ref] = {
value: unsigned Convert.Value;
processNumBody ← processNumBody+1;
value ← [value: unsigned[processNumBody]];
ret ← Rope.Concat["st", Convert.ValueToRope[value]]};
ResetGensymProcessBody: PROC [num: CARDINAL] = {
processNumBody ← num};
PushNodeDecls: PROC [t: Tree.Link] RETURNS [NAT] = {
PushNodeDecl: PROC [t: Tree.Handle] RETURNS [NAT] = { OPEN SakuraTreeOps;
ids, base: Tree.Link;
nsons: NAT ← 1;
IF t.name#decl THEN ERROR;
ids ← NthSon[t, 1];
base ← t;
IF OpName[ids] = list THEN {base ← ids; nsons ← NSons[ids]};
FOR i: NAT IN [1..nsons] DO PushTree[NthSon[base, i]];
PushNode[connectorcreate, 1] ENDLOOP;
RETURN[nsons]};
IF t=Tree.Null THEN RETURN[0];
WITH t SELECT FROM
u: Tree.Handle =>
IF u.name=list THEN {
ret: NAT ← 0;
FOR i: NAT IN [1..u.sonLimit) DO ret ← ret+PushNodeDecl[LOOPHOLE[u.son[i],Tree.Handle]]
ENDLOOP;
RETURN[ret]}
ELSE RETURN[PushNodeDecl[u]];
ENDCASE => ERROR};--PushNodeDecls
PushConnections: PROC [connections, components: Tree.Link] RETURNS [NAT] = { OPEN SakuraTreeOps;
-- components are of the form
-- a,b:t, c,d:s, ...
-- connections are of the form
-- a[n1, n2], b[n3, n4], ..
-- The larger groups a,b:t is counted by pairloc and the small group a,b is counted
--by comploc. compsum is the total number of elements declared
id,sort: Tree.Link;
compcount: CARDINAL;
-- First, create the PROCESS declaration
compcount ← 0;
EnumerateComps[components];
DO
[id, ] ← NextComps[];
IF id=Tree.Null THEN EXIT;
compcount ← compcount + 1;
PushTree[id];
ENDLOOP;
PushProcessDecl[MakeList[compcount]];
-- Next, create SakuraRT.IncCurrent[] and FORK statement
EnumerateComps[components];
DO
[id,sort] ← NextComps[];
IF id=Tree.Null THEN EXIT;
PushFork[id, sort, connections];
ENDLOOP;
RETURN[compsum]};
PushJoins: PROC [t: Tree.Link] RETURNS [sum: NAT] = { OPEN SakuraTreeOps;
PushJoin: PROC [x: Tree.Link] = {
WITH x SELECT FROM
v: Tree.Handle => {
name: Tree.Link ← v.son[1];
WITH name SELECT FROM
w: Tree.Handle =>
IF w.name=list THEN {
FOR i: NAT IN [1..NSons[w]] DO
PushTree[w.son[i]]; PushNode[connectorjoin,1]
ENDLOOP;
sum ← sum+NSons[w]}
ELSE ERROR;
ENDCASE => {
PushTree[name];
PushNode[connectorjoin,1];
sum ← sum+1};
};
ENDCASE => ERROR;
};
sum ← 0;
WITH t SELECT FROM
u: Tree.Handle => IF u.name=list THEN
FOR i: NAT IN [1..NSons[u]] DO
PushJoin[u.son[i]]
ENDLOOP
ELSE IF u.name=compitem THEN PushJoin[u]
ELSE ERROR;
ENDCASE => ERROR};
CatalogPorts: PROC [tree: Tree.Link] = {
CatalogItem: PROC [tree: Tree.Link] = {
WITH NthSon[tree, 1] SELECT FROM
node: Tree.Handle => IF node.name=list THEN
FOR j: NAT IN [1..node.sonLimit) DO
CatalogName[NthSon[node,j],NthSon[tree,2]] ENDLOOP
ELSE ERROR;
u: HTIndex => CatalogName[NthSon[tree, 1], NthSon[tree, 2]];
ENDCASE => ERROR};
CatalogName: PROC [name, val: Tree.Link] = {
SymbolTable.Add[symbolTable,
NARROW[name, HTIndex].name,
val,
TRUE]};
IF tree=Tree.Null THEN RETURN;
SELECT OpName[tree] FROM
decl => CatalogItem[tree];
list => FOR i: NAT IN [1..NSons[tree]] DO
CatalogItem[NthSon[tree,i]]; ENDLOOP;
ENDCASE => ERROR};
ExpandNodeList: PROC [a: Tree.Link, public: BOOLEAN] RETURNS [nLists: CARDINAL] = {
i: NAT;
IF a=Tree.Null THEN RETURN[0];
IF OpName[a]#list THEN {PushTree[ChangeToNodeType[a, public]]; RETURN[1]};
nLists ← NSons[a];
FOR i IN [1..nLists] DO
PushTree[ChangeToNodeType[NthSon[a,i], public]]
ENDLOOP};
PushRewriteBody: PROC [body, in, out, representation: Tree.Link] = {
new, decls, stmts: Tree.Link;
[new, decls, stmts] ← RewriteBody[body, in, out, representation];
PushTree[AppendToBlock[decls, new, stmts]]};--PushRewriteBody
AppendToBlock: PROC [decls,l,r: Tree.Link] RETURNS [Tree.Link] = {
-- decls is a declaration list, l is a statement and r is a statement list.
-- If l is a block, then decls is appended to the decls of l,
--r is appended to the body of l; otherwise create a list
body: Tree.Link;
IF decls=Tree.Null THEN
IF r=Tree.Null THEN RETURN[l]
ELSE IF OpName[l]=block THEN {
body ← NthSon[l, 2];
body ← Append[r, body];
NARROW[l, Tree.Handle].son[2] ← body;
RETURN[l]}
ELSE RETURN[Append[l, r]]
ELSE IF OpName[l] = block THEN {
PushTree[Append[NthSon[l,1], decls]];
PushTree[Append[r, NthSon[l,2]]];
RETURN[MakeNode[block, 2]]}
ELSE {
PushTree[decls];
PushTree[Append[r, l]];
RETURN[MakeNode[block, 2]]}
};
complist: Tree.Link;
compsum, pairloc, comploc: NAT; --These are used only by EnumerateComps and NextComps
EnumerateComps: PROC [list: Tree.Link] = {
complist ← list; compsum ← 0; pairloc ← 1; comploc ← 0;
}; -- end of EnumerateComps
NextComps: PROC RETURNS[id,sort: Tree.Link] = {
component: Tree.Link;
compsum ← compsum+1;
comploc ← comploc+1;
IF complist=Tree.Null THEN RETURN[Tree.Null,Tree.Null];
IF OpName[complist]=list THEN -- pairloc becomes larger than 1
IF pairloc>NSons[complist] THEN RETURN[Tree.Null,Tree.Null]
ELSE component ← NthSon[complist, pairloc]
ELSE IF pairloc>1 THEN RETURN[Tree.Null,Tree.Null]
ELSE component ← complist;
IF OpName[component]=compitem OR OpName[component]=decl THEN {
name: Tree.Link ← NthSon[component,1];
thisSort: Tree.Link ← NthSon[component,2];
IF OpName[name]=list THEN {
component ← name;
IF comploc>NSons[component] THEN {
pairloc ← pairloc+1; comploc ← 0; compsum ← compsum-1;
[id, sort] ← NextComps[]}
ELSE RETURN[NthSon[component, comploc], thisSort]}
ELSE IF comploc>1 THEN {
pairloc ← pairloc+1; comploc ← 0; compsum ← compsum-1;
[id, sort] ← NextComps[]}
ELSE RETURN[name,thisSort]}
ELSE ERROR}; -- end of NextComps
criticalSectionNum: CARDINAL ← 0;
GensymCriticalSection: PROC RETURNS [ret: Rope.Ref] = {
value: unsigned Convert.Value;
criticalSectionNum ← criticalSectionNum+1;
value ← [value: unsigned[criticalSectionNum]];
ret ← Rope.Concat["criticalSection", Convert.ValueToRope[value]]};
PushFork: PROC [id, sort, connections: Tree.Link] = { OPEN SakuraTreeOps;
forkName, args, conn: Tree.Link;
SearchForConn: PROC[id, connections: Tree.Link] RETURNS [Tree.Link] = {
WITH connections SELECT FROM
u: Tree.Handle => IF u.name=list THEN {
FOR i: NAT IN [1..NSons[u]] DO
WITH NthSon[u,i] SELECT FROM
v: Tree.Handle => IF v.name=apply THEN {
IF SakuraTreeOps.Eq[v.son[1],id]
THEN RETURN[v]}
ELSE ERROR;
w: HTIndex => IF SakuraTreeOps.Eq[w,id] THEN RETURN[w];
ENDCASE => ERROR;
ENDLOOP;
RETURN[Tree.Null]}
ELSE IF u.name=apply AND SakuraTreeOps.Eq[u.son[1],id] THEN RETURN[u]
ELSE RETURN[Tree.Null];
x: HTIndex => IF SakuraTreeOps.Eq[x,id] THEN RETURN[x] ELSE ERROR;
ENDCASE => ERROR};
PushTree[id];
WITH sort SELECT FROM
u: Tree.Handle =>
IF u.name=apply THEN {forkName ← u.son[1]; args ← u.son[2]}
ELSE IF u.name=dot THEN {forkName ← u; args ← Tree.Null}
ELSE ERROR;
v: HTIndex => {forkName ← v; args ← Tree.Null};
ENDCASE => ERROR;
conn ← SearchForConn[id, connections];
IF conn=Tree.Null THEN RETURN;
WITH conn SELECT FROM
u: Tree.Handle => IF u.name=apply THEN args ← Append[args,u.son[2]]
ELSE ERROR;
v: HTIndex => NULL;
ENDCASE => ERROR;
PushTree[forkName];
IF args#Tree.Null THEN {PushTree[args]; PushNode[apply,2]};
PushNode[connectorfork,2]};
ChangeToNodeType: PROC [tree: Tree.Link, public: BOOLEAN] RETURNS [Tree.Link] = {
NARROW[tree, Tree.Handle].son[2] ← MakeDot["SakuraRT", "Handle"];
PushTree[tree];
SetAttr[2, public];
RETURN[PopTree[]]
};
PrintTree: PROC [t: Tree.Link] = {
out: IOStream.Handle ← IOStream.CreateFileStream["Sakura.log"];
Print: PROC [name: Rope.Ref] = {
FOR i: LONG INTEGER IN [0..Rope.Size[name]) DO
IOStream.PutChar[out, Rope.Fetch[name,i]] ENDLOOP;
IOStream.PutChar[out, ' ]; IOStream.PutChar[out, ' ]};
PrintLI: PROC [i: LONG INTEGER] = {
value: signed Convert.Value;
value.signed ← i;
Print[Convert.ValueToRope[value]]};
PrintCR: PROC = {
IOStream.PutChar[out, CR]};
PrintTreeRecurse: PROC[t: Tree.Link, indent: NAT] = {
Index[indent];
IF t=NIL THEN {Print["NIL"]; PrintCR[]; RETURN};
WITH t SELECT FROM
hti: HTIndex => {
PrintLI[hti.index]; Print[hti.name]; PrintCR[]};
lti: LTIndex => {
PrintLI[lti.index]; Print[lti.literal]; PrintCR[]};
x: Tree.Handle => {
Print[SakuraTreeOps.PrintName[x.name]]; PrintLI[x.info]; PrintCR[];
FOR i: CARDINAL IN [1..SakuraTreeOps.NSons[t]] DO
PrintTreeRecurse[SakuraTreeOps.NthSon[t, i], indent+2] ENDLOOP};
ENDCASE => {Print["No printable node"]; PrintCR[]}};
Index: PROC [times: NAT] = {
THROUGH [1..times] DO IOStream.PutChar[out, ' ] ENDLOOP};
IOStream.SetLength[out, 0];
PrintTreeRecurse[t, 0];
IOStream.Close[out]};
}.