-- filename evaluate.adb 3:21PM  10/25/95
-- Defines a read-eval-print loop for the simple expression language defined
-- in package expr.

with expr.io,evalenv, text_io;
use expr, expr.io, evalenv, text_io;
package body evaluate is

procedure EvalDef(Ex:in Exp; En:in out Env; ExpVal:in out Exp) is
begin
     Eval(DefBody(Ex), En, ExpVal);
     AddEntry(DefName(Ex), ExpVal, En);
end EvalDef;

procedure EvalSet(Ex:in Exp; En:in out ENv; ExpVal:in out Exp) is
begin
     Eval(SetBody(Ex), En, ExpVal);
     ChangeEntry(SetName(Ex), ExpVal, En);
end EvalSet;

procedure EvalList(Ex:in Exp; En:in out ENv; ExpVal:in out Exp) is
-- evaluate each expression in sequence and set ExpVal to value of
-- the last expression in the sequence
     Ptr : ExpList := Seq(Ex);
begin
  while not IsEmpty(Ptr)
    loop
     eval(first(ptr), En, ExpVal);
     Ptr:= rest(Ptr);
    end loop;
end EvalList;

procedure Evalargs(Args:in ExpList; En:in out Env; Vals:in out
ExpList) is
-- build a list of values (Vals) of the expressions in the given
-- list (Args)
     Ptr : ExpList := Args;
     ExpVal : Exp;
     ValPtr : ExpList;
Begin
  if not IsEmpty(Ptr)
  then eval(first(Ptr), En, ExpVal);
       Vals := cons(ExpVal, Empty);
       Ptr := rest(Ptr);
       ValPtr := Vals;
       while not IsEmpty(Ptr)
         loop
          eval(first(Ptr), En, ExpVal);
          SetRest(ValPtr, cons(ExpVal, Empty));
          ValPtr := rest(ValPtr);
          Ptr := rest(Ptr);
         end loop;
  else Vals := Empty;
  end if;
end Evalargs;

-- the primitive functions are the binary arithmetic operators defined
-- on integer arguments. First and Second select the appropriate 
-- arguments for application of these functions.

function First(Args:ExpList) return Integer is
begin
     return ConstVal(first(Args));
end First;

function Second(Args: ExpList) return Integer is
begin
     return ConstVal(first(rest(Args)));
end Second;


procedure apply(opr:in Exp; Actuals: in ExpList; En: in out Env;
                           ExpVal:in out Exp) is
     Val : Integer;
begin
  case TypeOfFcn(opr) is
     when primitive => if FcnName(opr) = "+       " 
                    then Val := First(Actuals) + Second(Actuals);
                    elsif FcnName(opr) = "-       " 
                    then Val := First(Actuals) - Second(Actuals);
                    elsif FcnName(opr) = "*       " 
                    then Val := First(Actuals) * Second(Actuals);
                    elsif FcnName(opr) = "/       " 
                    then Val := First(Actuals) / Second(Actuals);
                    else raise unknown_primitive;
                    end if;
                       ExpVal := MkConst(Val);
     when compound => ExtendEnv(FcnParams(opr), Actuals, En);
                      Eval(FcnBody(opr), En, ExpVal);
                      FlushFrame(En);
  end case;
exception
     when storage_error => raise EnvOverflow;
end apply;

procedure Eval(Ex:in Exp; En:in out Env; ExpVal:in out Exp) is
     ExpValF : Exp;
     ExpValList: ExpList;
begin
  case TypeOfExp(Ex) is
     when const => ExpVal := Ex;
     when var => ExpVal := lookup(VarName(Ex), En);
     when def => evalDef(Ex, En, ExpVal);
     when set => EvalSet(Ex, En, ExpVal);
     when fcn => ExpVal:= Ex;
     when seq => EvalList(Ex, En, ExpVal);
     when app => Eval(AppOp(Ex), En, ExpValF);
                 EvalArgs(AppArgs(Ex), En, ExpValList);
                 Apply(ExpValF, ExpValList, En, ExpVal);
     when done => raise eval_called_on_exit;
     when endparen => raise eval_called_on_endparen;
  end case;
end Eval;

procedure AddPrimitives(E: in out Env) is
begin
  AddEntry("+       ", 
           MkFcn(primitive, "+       ", Empty, null), E);
  AddEntry("-       ", 
           MkFcn(primitive, "-       ", Empty, null), E);
  AddEntry("*       ", 
           MkFcn(primitive, "*       ", Empty, null), E);
  AddEntry("/       ", 
           MkFcn(primitive, "/       ", Empty, null), E);
end AddPrimitives;

procedure Driver is
     E, EV :Exp;
     TheGlobalEnv: Env; -- making this local means you start over
                         -- each time Driver is called, i.e., no
                         -- defs can be remembered
     finished : Boolean := false;
begin
  Initialize(TheGlobalEnv);
  AddPrimitives(TheGlobalEnv);
  new_line;
  text_io.put("expression: ");
  get(E); 
    while TypeOfExp(E) /= done and not finished
    loop
     text_io.put( "The value of ");
     new_line;
     put( E);
     new_line;
     text_io.put( " is  ");
     eval(E, TheGlobalEnv, EV);
     put(EV);
     new_line;
     new_line;
     text_io.put("expression: ");
     if not End_Of_File
        then get(E);
	else finished := true;
	end if;
    end loop;
exception
     when EnvOverflow => put_line("Environments are nested too deeply.");
                put_line("You might have an infinite recursion.");
 		text_io.put("The current expression is ");
                new_line; put(E);
     when program_error => text_io.put("Program_error was raised. ");
			 text_io.put("The current expression is ");
                         new_line; put(E);
end Driver;

                         
end evaluate;