[ivy]<Satterthwaite>Poplar>PLStoreImpl.Mesa!5

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