-- 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]};

}.