-- filename evalenv.adb 3:17PM  10/25/95

with framelist.stacks, text_io, expr.io, Frame; 
use framelist.stacks, expr.io;
package body EvalEnv is

  procedure Initialize(E:in out Env) is
-- creates an evaluation environment containing a single empty frame
     F:Frame.Table;
  begin
     Frame.Clear(F);
     MkEmpty(E);
     AddFrame(F,E);
  end Initialize;

  function RestOf(E:Env) return Env is
     RestOfEnv:Env;
  begin
     Assign(E, RestOfEnv); -- assign is safe here because I know the
     FlushFrame(RestOfEnv); -- representation of stacks as lists, and
     return RestOfEnv;      -- that FlushFrame won't hurt E, but simply
  end RestOf;              -- move RestOfEnv down the stack of frames.


-- the following procedures and functions operate on environments
-- by operating on the frames in the environments, thus many are 
-- defined in terms of similar operations on frames

-- Find is a utility to locate the frame of a binding for a given 
-- symbol (if it exists) in an environment.
-- If it is there, on return, Current is pointing at the frame
-- containing it
-- If it is not there, an error message is printed, and Current is
-- set to the empty frame. This
-- procedure is only invoked when a binding SHOULD already exist.

  procedure Find(S: in Symbol; E: in Env;
                 Current : in out Frame.Table) is
     IterE: Env;
  begin
     Assign(E, IterE);
     Current := FirstFrame(IterE);
     while not Frame.IsBound(S, Current)
       loop
          FlushFrame(IterE);
          Current:= FirstFrame(IterE);
       end loop;
  exception
     when Underflow -- tried to take firstframe of an empty
                           -- environment (i.e., it's not there)
               => text_io.put("looking for a binding of ");
                  put(S); text_io.put(" but it's not there "); 
		  text_io.new_line;
		  Frame.Clear(Current);
  end Find;


  procedure AddEntry(S: in Symbol; V: in Exp; 
                                   E: in out Env) is
-- new definitions are always added to the current (local) frame
     T: Frame.Table;
  begin
     T := FirstFrame(E);
     Frame.AddEntry(S, V, T);
     FlushFrame(E);
     AddFrame(T,E);
  exception 
     when Frame.multiple_binding => text_io.put("binding already exists for ");
				    put(S);
  end AddEntry;
     
  procedure ChangeEntry(S:in Symbol; V: in Exp; E:in out Env) is
     T: Frame.Table;
  begin
     Find(S, E, T);
     Frame.ChangeEntry(S, V, T);
  exception
     when Frame.entry_not_found => 
			text_io.put("Cannot locate existing binding for ");
			put(S);
			text_io.put(" so I cannot change it as requested.");
  end ChangeEntry;

  function Lookup(S:in Symbol; E:in Env) return Exp is
     T: Frame.Table;
  begin
     Find(S, E, T);
     if Frame.IsEmpty(T) 
	then return expr.MkDummy(S); 
	else return Frame.Retrieve(S, T);
     end if;
  exception
     when Frame.entry_not_found =>
		-- actually, this problem should cause Find to raise an
		-- an exception before Retrieve could.
			text_io.put("Cannot find binding for ");
			put(S);
  end Lookup;

  function IsBound(S: in Symbol; E:in Env) return Boolean is
     T: Frame.Table;
     IterE: Env;
  begin
     T := FirstFrame(E);
     Assign(E, IterE);
     while not Frame.IsBound(S, T)
       loop
          FlushFrame(IterE);
          T := FirstFrame(IterE);
       end loop;
     return True; -- if you got out of the loop safely, it's there
  exception
     when Underflow  -- tried to search past the end of env
               =>   return False;
  end IsBound;


  procedure MakeFrame(Names:in SymbolList; Vals:in ExpList;
                      T:in out Frame.Table) is
     Nptr: SymbolList := Names;
     Vptr: ExpList := Vals;
  begin
     Frame.Clear(T);
     while Nptr /= Empty
       loop
          Frame.AddEntry(First(Nptr), First(Vptr), T);
          Nptr := Rest(Nptr);
          Vptr := Rest(Vptr);
       end loop;
     if Vptr /= Empty then text_io.put("too many actuals");
     end if;
exception
     when NoElements    -- more names than values
               => text_io.put("not enough actual parameters");
  end MakeFrame;

  procedure ExtendEnv(Names:in SymbolList; Vals:in ExpList;
                      E:in out Env) is
     T: Frame.Table;
  begin
     MakeFrame(Names, Vals, T);
     AddFrame(T, E);
  end ExtendEnv;

  procedure put(E:in Env) is
     IterE : Env;
     Current: Frame.Table;
  begin
     Assign(E, IterE);
     while not IsEmpty(IterE) 
       loop                   
          Current:= FirstFrame(IterE);
          text_io.put("start of frame");
          text_io.new_line;
          Frame.put(Current);
          FlushFrame(IterE);
       end loop;
  end put;



end EvalEnv;