EvalQuoteImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Russ Atkinson, April 11, 1985 3:22:36 pm PST
Spreitzer, May 21, 1985 1:53:22 pm PDT
DIRECTORY
AMBridge USING [RefFromTV, TVForReferent],
AMTypes USING [TV],
EvalQuote USING [EvalQuoteProc, NameClosure, NameClosureRep, NameProc, VisitProc],
InterpreterOps USING [Eval, GetArg, Tree],
InterpreterPrivate USING [GetGlobalSymTab],
Rope USING [ROPE],
SymTab USING [Create, EachPairAction, Fetch, Pairs, Store, Ref];
EvalQuoteImpl:
CEDAR
PROGRAM
IMPORTS AMBridge, InterpreterOps, InterpreterPrivate, SymTab
EXPORTS EvalQuote
= BEGIN OPEN EvalQuote;
MyClosure: TYPE = REF MyClosureRep;
MyClosureRep: TYPE = RECORD [proc: EvalQuoteProc, data: REF ← NIL];
ROPE: TYPE = Rope.ROPE;
TV: TYPE = AMTypes.TV;
Register:
PUBLIC
PROC [name:
ROPE, proc: EvalQuoteProc, symTab: SymTab.Ref, data:
REF ←
NIL ] = {
closure: MyClosure ← NEW[MyClosureRep ← [proc: proc, data: data]];
found: BOOL;
sttv: TV;
IF symTab = NIL THEN symTab ← InterpreterPrivate.GetGlobalSymTab[];
[found, sttv] ← symTab.Fetch["&EvalQuoteSymTab"];
TRUSTED{
IF found THEN symTab ← NARROW[AMBridge.RefFromTV[sttv]]
ELSE {
newST: SymTab.Ref = SymTab.Create[];
[] ← symTab.Store["&EvalQuoteSymTab", AMBridge.TVForReferent[newST]];
symTab ← newST;
};
};
[] ← symTab.Store[name, closure];
};
Lookup:
PUBLIC
PROC [symTab: SymTab.Ref, name:
ROPE]
RETURNS [proc: EvalQuoteProc ←
NIL, data:
REF ←
NIL] = {
finds the named EvalQuoteProc (if any), returns [NIL, NIL] if no such proc
closure: MyClosure;
found: BOOL;
wasNilSymTab: BOOL = symTab = NIL;
sttv: TV;
No longer a good idea, since we want to allow a statement (and hence procedure definition) interpreter:
IF name.Fetch[0] # '& THEN RETURN;
IF symTab = NIL THEN symTab ← InterpreterPrivate.GetGlobalSymTab[];
[found, sttv] ← symTab.Fetch["&EvalQuoteSymTab"];
IF
NOT found
THEN {
IF NOT wasNilSymTab THEN [proc, data] ← Lookup[NIL, name]; -- try the global one
RETURN;
};
TRUSTED{symTab ← NARROW[AMBridge.RefFromTV[sttv]]};
closure ← NARROW[symTab.Fetch[name].val];
IF closure =
NIL
THEN {IF NOT wasNilSymTab THEN [proc, data] ← Lookup[NIL, name]}
ELSE {proc ← closure.proc; data ← closure.data};
};
Enumerate:
PUBLIC
PROC [symTab: SymTab.Ref, visit: VisitProc] = {
enumerates the registered EvalQuote procs
action: SymTab.EachPairAction = {
[key: Key, val: Val] RETURNS [quit: BOOL];
closure: MyClosure ← NARROW[val];
IF closure #
NIL
THEN
quit ← visit[key, closure.proc, closure.data];
};
found: BOOL;
sttv: TV;
IF symTab = NIL THEN symTab ← InterpreterPrivate.GetGlobalSymTab[];
[found, sttv] ← symTab.Fetch["&EvalQuoteSymTab"];
IF NOT found THEN RETURN;
TRUSTED{symTab ← NARROW[AMBridge.RefFromTV[sttv]]};
[] ← symTab.Pairs[action];
};
EvalQ: EvalQuote.EvalQuoteProc =
TRUSTED {
[head: EvalHead, tree: Tree, target: Type ← nullType, data: REF ← NIL]
RETURNS [return: TV]
arg: InterpreterOps.Tree ← InterpreterOps.GetArg[tree, 1];
tv: TV ← InterpreterOps.Eval[arg, head, target];
ref: REF ← NEW[TV ← tv];
RETURN [AMBridge.TVForReferent[ref]];
};
RegisterNameProc:
PUBLIC
PROC [name: Rope.
ROPE, symTab: SymTab.Ref, proc: NameProc, data:
REF
ANY ←
NIL] = {
nc: NameClosure ← NEW [NameClosureRep ← [proc, data]];
IF symTab = NIL THEN symTab ← InterpreterPrivate.GetGlobalSymTab[];
[] ← symTab.Store[name, nc];
};
LookupNameProc:
PUBLIC
PROC [symTab: SymTab.Ref, name: Rope.
ROPE]
RETURNS [proc: NameProc, data:
REF
ANY] = {
nc: NameClosure;
IF symTab = NIL THEN symTab ← InterpreterPrivate.GetGlobalSymTab[];
nc ← NARROW[symTab.Fetch[name].val];
IF nc # NIL THEN RETURN [nc.proc, nc.data] ELSE RETURN [NIL, NIL];
};
EnumerateNameProcs:
PUBLIC
PROC [symTab: SymTab.Ref, perRegistration:
PROC [name: Rope.
ROPE, proc: NameProc, data:
REF
ANY]
RETURNS [stop:
BOOL] ] = {
PerPair:
PROC [key:
ROPE, val:
REF
ANY]
RETURNS [quit:
BOOL]
--SymTab.EachPairAction-- = {
quit ← FALSE;
IF val #
NIL
THEN
WITH val
SELECT
FROM
nc: NameClosure => quit ← perRegistration[key, nc.proc, nc.data];
ENDCASE;
};
IF symTab = NIL THEN symTab ← InterpreterPrivate.GetGlobalSymTab[];
[] ← symTab.Pairs[PerPair];
};
Register["&evq", EvalQ,
NIL,
NIL];
END.