-- 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.