% 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.
%
% 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; !*allbranch:=t; !*allfac:=t; !*backtrace:=nil;
!*bigfloat:=nil; !*comp:=nil; !*complex:=nil; !*convert:=t;
!*cramer:=nil; !*cref:=nil; !*defn:=nil; !*demo:=nil;
!*div:=nil; !*echo:=nil; !*errcont:=nil; !*exp:=t;
!*ezgcd:=nil; !*factor:=nil; !*failhard:=nil;!*float:=nil;
!*fort:=nil; !*gcd:=nil; !*heugcd:=nil; !*ifactor:=nil;
!*int:=t; !*intstr:=nil; !*lcm:=t; !*list:=nil;
!*mcd:=t; !*modular:=nil; !*msg:=t; !*nat:=t;
!*nero:=nil; !*nolnr:=nil; !*numval:=nil; !*output:=t;
!*overview:=nil; !*period:=t; !*pgen:=nil; !*pgwd:=nil;
!*plap:=nil; !*precise:=nil; !*pret:=nil; !*pri:=t;
!*pwrds:=t; !*quotenewnam:=t;!*raise:=t; !*rat:=nil;
!*ratarg:=nil; !*rational:=nil; !*rationalize:=nil;
!*ratpri:=t; !*reduced:=nil; !*revpri:=nil; !*savestructr:=nil;
!*solvesingular:=t;!*time:=nil; !*timings:=nil; !*trallfac:=nil;
!*trfac:=nil; !*trint:=nil;
% Now work down previous inputs
foreach stat in inputbuflis!* do <<
statno:=car stat;
mode:=cddr stat;
comm:=cadr 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);
end;