reduce-historical/r38/packages/misc/reset.red

module reset;  % Code to reset REDUCE to the initial state.

% John Fitch, Codemist Ltd 1988 <jpff@maths.bath.ac.uk>
% Given to the REDUCE community for what it is worth.
% Revised August 1995 for Reduce 3.6.
%
create!-package('(reset),'(contrib misc));

% The command RESETREDUCE works through the history of previous
% commands, and clears any values which have been assigned, plus any
% rules, arrays and the like.  It also sets the various switches to
% their initial values.  It is not complete, but does work for most
% things that cause a gradual loss of space.  It would be relatively
% easy to make it interactive, so allowing for selective resetting.

symbolic procedure resetreduce;
 begin
  scalar mode,statno,comm;
 % Set all switches back to initial values
 % These may vary from system to system!!

  !*algint:=nil;      !*adjprec:=nil; !*allbranch:=nil;  !*allfac:=t;
  !*arbvars:=nil;     !*asterisk:=t;  !*backtrace:=nil;
  !*balanced_mod:=nil; !*bfspace:=nil; !*combineexpt:=nil;
  !*combinelogs:=nil; !*comp:=nil;    !*complex:=nil;
  !*compxroots:=nil;  !*cramer:=nil;  !*cref:=nil;       !*defn:=nil;
  !*demo:=nil;        !*dfprint:=nil; !*div:=nil;        !*echo:=nil;
  !*errcont:=nil;     !*evallhseqp:=nil;                 !*exp:=t;
  !*expandexpt:=t;    !*expandlogs:=nil;                 !*ezgcd:=nil;
  !*factor:=nil;      !*fastfor:=nil; !*force:=nil;      !*fort:=nil;
  !*fortupper:=nil;   !*fullprec:=nil;!*fullprecision:=nil;
  !*fullroots:=nil;   !*gcd:=nil;     !*heugcd:=nil;     !*horner:=nil;
  !*ifactor:=nil;     !*int:=nil;     !*intstr:=nil;     !*lcm:=t;
  !*lessspace:=nil;   !*limitedfactors:=nil;             !*list:=nil;
  !*listargs:=nil;    !*lower:=t;     !*mcd:=t;          !*modular:=nil;
  !*msg:=t;           !*multiplicities:=nil;             !*nat:=t;
  !*nero:=nil;        !*noarg:=t;     !*noconvert:=nil;  !*nonlnr:=nil;
  !*nosplit:=t;       !*numval:=t;    !*output:=t;       !*period:=t;
		      !*pgwd:=nil;    !*plap:=nil;       !*precise:=t;
  !*pret:=nil;        !*pri:=t;       !*pwrds:=t;
  !*quotenewnam:=t;   !*raise:=nil;   !*rat:=nil;        !*ratarg:=nil;
  !*rational:=nil;    !*rationalize:=nil;                !*ratpri:=t;
  !*reduced:=nil;     !*revpri:=nil;  !*rlisp88:=nil;    !*rootmsg:=nil;
  !*roundall:=t;      !*roundbf:=nil; !*rounded:=nil;  % !*savedef:=nil;
  !*savestructr:=nil; !*solvesingular:=nil;              !*time:=nil;
  !*trallfac:=nil;    !*trfac:=nil;   !*trint:=nil;      !*trroot:=nil;

  % Now work down previous inputs
  foreach stat in inputbuflis!* do <<
        statno:=car stat;
        mode:=cadr stat;
        comm:=caddr stat;
%       princ "Dealing with input "; princ statno;
%       princ " in mode "; print mode;
%       prin2t comm;
%       princ "car comm="; prin2t car comm;
        if mode='algebraic then algreset(comm)
        else if mode='symbolic then symbreset(comm)
    >>;
 inputbuflis!*:=nil
 end;

symbolic procedure algreset(comm);
 begin scalar forallfn;
    if atom comm then return nil;
    forallfn:='forall;
    if car comm='setk then remprop(cadadr comm,'avalue)
    else if car comm='arrayfn then
        foreach y in cdaddr comm do <<
            remprop(cadadr y,'dimension);
            remprop(cadadr y,'rvalue);
            remprop(cadadr y,'rtype) >>
    else if car comm='progn then foreach y in cdr comm do algreset(y)
    else if car comm='prog then foreach y in cdr comm do algreset(y)
    else if car comm='setq then nil
    else if car comm='go then nil
    else if car comm='cond then
        foreach y in cdr comm do <<
            algreset(car comm); algreset(cadr comm) >>
    else if car comm='flag then eval('remflag . (cdr comm))
    else if car comm='de then remd cadr comm
    else if car comm='let then
        foreach xx in cdadr comm do clear car cdaddr xx
    else if car comm='clear then nil
    else if car comm='forall and caadr cadddr cadr comm = 'let then
        foreach xx in cdadr cadddr cadr comm do
           forallfn list(cadr cadadr comm,cadr cadr cdadr comm,
                        list('clear, list('list, caddr cadr xx)))
 %   else I do not know what to do!!
 end;

symbolic procedure symbreset(comm);
  <<
    if car comm='setq then set(cadr comm,nil)
    else if car comm='progn then foreach y in cdr comm do symbreset(y)
    else if car comm='flag then eval('remflag . (cdr comm))
    else if car comm='de then remd cadr comm
%   else I do not know what to do!!
  >>;

put('resetreduce,'stat,'endstat);

endmodule;

end;