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] = { closure: MyClosure; found: BOOL; wasNilSymTab: BOOL = symTab = NIL; sttv: TV; 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] = { action: SymTab.EachPairAction = { 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 { 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. 8EvalQuoteImpl.mesa Copyright c 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 finds the named EvalQuoteProc (if any), returns [NIL, NIL] if no such proc No longer a good idea, since we want to allow a statement (and hence procedure definition) interpreter: IF name.Fetch[0] # '& THEN RETURN; enumerates the registered EvalQuote procs [key: Key, val: Val] RETURNS [quit: BOOL]; [head: EvalHead, tree: Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV] Э╩YШcodeЪЬЩKЪЬ ╧mЬ7ЩBKЪЬ,Щ,KЩ&ЧKШЪ╧k Ш KЪЬ ЮЬШ*KЪЬЮЬЮЬШKЪЬ ЮЬCШRKЪЬЮЬШ*KЪЬЮЬШ+KЪЬЮЬЮЬШKЪЬЮЬ4Ш@KШЧЪЬЮЬЮШKЪЮЬ5Ш