-- PLStoreImpl.Mesa, stolen from Jim Morris
-- Last Modified On 27-Oct-81  8:47:55 By Paul Rovner
-- Last Modified On September 28, 1982 5:27 pm by Schmidt

-- used to be PStore.Mesa

DIRECTORY
  Environment: TYPE USING[Comparison],
  PL: TYPE USING [LSTNode, LSTNodeRecord, NewNail, Node, NodeRecord,
  	PBug, rASS, rCAT, rCATL, rCLOSURE, rCOMB, rDELETE, rEQUAL, rFAIL,
  	rFCN, rGOBBLE, rGTR, rHOLE, rID, rITER, rLST, rMAPPLY, rMINUS, rOPT,
  	rPALT, rPAPPLY, rPATTERN, rPLUS, rPROG, rSEQ, rSEQOF, rSEQOFC, rSTR,
  	rTILDE, rUNDEFINED, rWILD, SN, Symbol, SymbolRecord, Z],
  Rope: TYPE USING [Compare, ROPE];


PLStoreImpl: CEDAR PROGRAM IMPORTS P:PL, Rope	
                EXPORTS PL  = {
OPEN PL;
--
Node: TYPE = PL.Node;
LSTNode: TYPE = PL.LSTNode;
NodeRecord: TYPE = PL.NodeRecord;
Symbol: TYPE = PL.Symbol;
SymbolRecord: TYPE = PL.SymbolRecord;
--
nSyms: CARDINAL = 250;
--
--
N: ZONE = P.Z;

Fail: rFAIL = N.NEW[FAIL NodeRecord←[TRUE,FAIL[]]];
MTSt: rSTR = N.NEW[STR NodeRecord←[TRUE,STR[""]]];
Nail: LSTNode = N.NEW[PL.LSTNodeRecord←[TRUE,LST[NIL,NIL]]];

SymbolTree: Symbol;

GetSpecialNodes: PUBLIC PROC RETURNS[rFAIL,rSTR,LSTNode] = {
RETURN[Fail,MTSt,Nail];
};


Insert: PUBLIC PROC[s: Rope.ROPE, r: PL.SymbolRecord] RETURNS[t: Symbol] = {
-- these are never freed
t ← Lookup1[s, r, TRUE];
};

Lookup: PUBLIC PROC[s: Rope.ROPE] RETURNS[t: Symbol] = {
t ← Lookup1[s, [,,VAL[NIL]], FALSE];
};

Lookup1: PROC[s: Rope.ROPE, R: PL.SymbolRecord, inserting: BOOLEAN]
			RETURNS[t: Symbol] = {
whichSon: INTEGER ← 0;
father: Symbol ←  SymbolTree;
t ← father.son[0];
UNTIL t=NIL DO
	i: Environment.Comparison ← Rope.Compare[s, t.name];
	IF i=equal THEN RETURN[t];
	IF i=less THEN {whichSon ← 0; father ← t; t ← t.son[0]}
	ELSE {whichSon ← 1; father ← t; t ← t.son[1]}
	ENDLOOP;
IF inserting THEN {
	father.son[whichSon] ← t ← N.NEW[SymbolRecord ← R];
	t.name ← s}
};

StoreCleanup: PUBLIC PROC = {
SymbolTree ← NIL;
};

StoreSetup: PUBLIC PROC = {
SymbolTree ← N.NEW[SymbolRecord ← [,,VAL[NIL]]];
[] ← Insert["symbol",[,,ZARY[SymbolRoutine]]];
};

SymbolRoutine: PUBLIC PROC[Node] RETURNS[ans:Node] = {
-- zary
n: LSTNode ← P.NewNail[];
R: PROC[s: Symbol] = {
	IF s = NIL THEN RETURN;
	R[s.son[0]];
	n↑ ← [TRUE, LST[P.SN[s.name], P.NewNail[]]];
	n ← n.listtail;
	R[s.son[1]]};
ans ← n;
R[SymbolTree.son[0]];
};

Preorder: PUBLIC PROC[n: Node,p: PROC[Node] RETURNS[BOOLEAN]] = BEGIN
-- this proc applies p recursively to node n and in preorder all nodes accessible from it
-- if p returns false node n's descendants are not searched
DO
IF n = NIL THEN RETURN;
IF ~p[n] THEN RETURN;
WITH n SELECT  FROM
 x: rFAIL => RETURN;
 x: rID => RETURN;
 x: rWILD => RETURN;
 x: rHOLE => RETURN;
 x: rUNDEFINED => RETURN;
 x: rSTR => RETURN;
 x: rCOMB => n ← x.parm;
 x: rASS => n ← x.rhs;
 x: rLST => {Preorder[x.listhead,p]; n ← x.listtail};
 x: rSEQOF => RETURN;
 x: rSEQOFC => RETURN;
 x: rOPT => RETURN;
 x: rDELETE => n ← x.pat;
x: rCAT=> {Preorder[x.left,p]; n ← x.right};
x: rCATL=> {Preorder[x.left,p]; n ← x.right};
x: rGTR=> {Preorder[x.left,p]; n ← x.right};
x: rPALT=> {Preorder[x.left,p]; n ← x.right};
x: rPAPPLY=> {Preorder[x.left,p]; n ← x.right};
x: rMAPPLY=> {Preorder[x.left,p]; n ← x.right};
x: rGOBBLE=> {Preorder[x.left,p]; n ← x.right};
x: rITER=> {Preorder[x.left,p]; n ← x.right};
x: rPROG=> {Preorder[x.left,p]; n ← x.right};
x: rSEQ=> {Preorder[x.left,p]; n ← x.right};
x: rPLUS=> {Preorder[x.left,p]; n ← x.right};
x: rMINUS=> {Preorder[x.left,p]; n ← x.right};
x: rEQUAL=> {Preorder[x.left,p]; n ← x.right};
x: rEQUAL=> {Preorder[x.left,p]; n ← x.right};
x: rTILDE => n ← x.not;
x: rPATTERN => n ← x.pattern;
x: rCLOSURE => n ← x.exp;
x: rFCN=> {Preorder[x.parms,p]; n ← x.fcn};
ENDCASE => P.PBug["Unknown variant"];
ENDLOOP;
END;



}.