-- BBEvalQuoteImpl.mesa
-- Russ Atkinson, November 19, 1982 1:12 pm

-- The EvalQuote facility is provided to allow users to augment the language interpreted by BugBane.  The user supplies a procedure 
to be registered with BugBane under a given name such that the procedure will be called with the syntax tree for its invocation 
rather than have its arguments interpreted by BugBane.

DIRECTORY
  BBEval USING [EvalHead, Tree],
  BBEvalQuote USING [EvalQuoteProc, VisitProc],
  BBZones USING [GetPrefixedZone],
  Rope USING [ROPE],
  SymTab USING [Create, Delete, EachPairAction, Fetch, Pairs, Store, Ref];

BBEvalQuoteImpl: CEDAR PROGRAM
  IMPORTS BBZones, SymTab
  EXPORTS BBEvalQuote
  = BEGIN OPEN Rope, BBEvalQuote;

  MyClosure: TYPE = REF MyClosureRep;
  MyClosureRep: TYPE = RECORD [proc: EvalQuoteProc, data: REF _ NIL];

  evqTab: SymTab.Ref _ SymTab.Create[];
  z: ZONE _ BBZones.GetPrefixedZone[];

  Register: PUBLIC PROC [name: ROPE, proc: EvalQuoteProc, data: REF _ NIL] = {
    -- registers the EvalQuoteProc with BugBane
    closure: MyClosure _ z.NEW[MyClosureRep _ [proc: proc, data: data]];
    [] _ SymTab.Store[evqTab, name, closure];
    };

  UnRegister: PUBLIC PROC [name: ROPE] = {
    -- unregisters the name with BugBane
    [] _ SymTab.Delete[evqTab, name];
    };

  Lookup: PUBLIC PROC
      [name: ROPE] RETURNS [proc: EvalQuoteProc _ NIL, data: REF _ NIL] = {
    -- finds the named EvalQuoteProc (if any), returns [NIL, NIL] if no such proc
    closure: MyClosure _ NARROW[SymTab.Fetch[evqTab, name].val];
    IF closure # NIL THEN {proc _ closure.proc; data _ closure.data};
    };

  Pairs: PUBLIC PROC [visit: VisitProc] = {
    -- enumerates the registered procedures
    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];
      };
    [] _ SymTab.Pairs[evqTab, action];
    };
  
  END.