
<<PLStoreImpl.Mesa, stolen from Jim Morris>>
<<Copyright (c) Xerox Corporation, 1981, 1982.  All rights reserved.>>
<<Last Modified On 27-Oct-81  8:47:55 By Paul Rovner>>
<<Last Modified On September 28, 1982 5:27 pm by Schmidt>>
<<Last modified by Satterthwaite, April 18, 1986 5:07:48 pm PST>>

<<used to be PStore.Mesa>>

DIRECTORY
Basics: 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[NodeRecord.FAIL_[TRUE,FAIL[]]];
MTSt: rSTR = N.NEW[NodeRecord.STR_[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, [,,VALUE[NIL]], FALSE];
};

Lookup1: PROC[s: Rope.ROPE, R: PL.SymbolRecord, inserting: BOOL]
RETURNS[t: Symbol] = {
whichSon: INTEGER _ 0;
father: Symbol _  SymbolTree;
t _ father.son[0];
UNTIL t=NIL DO
i: Basics.Comparison _ s.Compare[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 _ [,,VALUE[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[BOOL]] = 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;



}.



