Sindbad~EG File Manager

Current Path : /usr/home/beeson/Otter-Lambda/yyy/automode/
Upload File :
Current File : /usr/home/beeson/Otter-Lambda/yyy/automode/exec.c

/* execute an operator:  exec() */
/* M. Beeson, for Mathpert
Original date 11.9.90
Last modified 6.18.99
*/

#define AUTOMODE_DLL
#include <string.h>
#include <assert.h>
#include <math.h>     /* abs */
#include "globals.h"
#include "graphstr.h"
#include "display.h"
#include "document.h"
#include "checkarg.h"
#include "operator.h"
#include "probtype.h"
#include "prover.h"
#include "ops.h"
#include "trig.h"
#include "calc.h"
#include "exec.h"
#include "mtext.h"
#include "optable.h"
#include "cmdmenus.h"
#include "automode.h"
#include "optable.h"
#include "nextline.h"
#include "symbols.h"
#include "cflags.h"
#include "autosimp.h"
#include "binders.h"
#include "islinear.h"
#include "getarg.h"    /* needs_arg */

static int toponly(actualop op);
static int contradictory(term,term);

/*____________________________________________________________________*/
int exec(operation op, term arg, term *next, char *reason)
 /* execute an op;  arg is supplied in case the op needs an arg;
    otherwise a dummy term will be supplied which is ignored.
    Return 0 for success;  1 for inapplicable operator,
    and 2 for failure-on-purpose.
      If selected_equation is nonzero, try applying the op only to the
    selected argument of history[currentline] (or its subterms)
      If selected_equation is nonzero and history[currentline] is
    an OR whose arguments are ANDS, consider selected_equation as
    an equation number over all the args of the ANDS. Example,
    in or(and(a=b,c=d),e=f), if selected_equation is 3 it means e=f,
    if 2 it means c=d.
*/

/* The call to 'copy' guarantees that different entries in the
history[] array do not overlap in space, so that 'undo' can safely call
destroy_term on the no-longer-needed entries in the history[] array.
*/

{ term t,p,v,temp;
  term vlist;
  unsigned short i,j,k;
  int err,which_equation;
  int nvariables = get_nvariables();
  varinf *varinfo = get_varinfo();
  int (*code)(term,term,term *, char *);
  int currentline = get_currentline();
  int activeline = currentline;
  int selected_equation = get_selected_equation();
  controldata d;
  reset_maxscope();  /* see nextline.c */
  get_controldata(&d);
  if(d.autosteps == 0)
    /* If the last step was taken in auto mode then we don't have to
       worry about specialops.  */
     { while(specialop(zero,access_optable(d.opseq[activeline].men)[d.opseq[activeline].choice-1]) && activeline > 0)
         --activeline;
     }

  if(activeline < currentline)
     set_currentline(activeline);  /* till done executing this operator */
  copy(history(activeline),&t);   /* destroyed below if operator fails     */
  /* however t has some colored subterms; we need to erase the color fields */
  erasecolors(&t);
  if(FUNCTOR(t) == OR)
     { for(i=0;i<ARITY(t);i++)
          { if(FUNCTOR(ARG(i,t)) == AND)
               break;  /* as in related rate problems */
          }
       if(i<ARITY(t))
          { /* selected_equation refers to the total aggregate of equations. */
            *next = make_term(OR,ARITY(t));
            k = 0;
            for(i=0;i<ARITY(t);i++)
               { v = ARG(i,t);
                 if(FUNCTOR(v) == AND)
                    { ARGREP(*next,i,make_term(AND,ARITY(v)));
                      for(j=0;j<ARITY(v);j++)
                         { ++k;
                           if(k == abs(selected_equation))
                               { code = access_optable(op.men)[op.choice-1];
                                 err = exec_aux(ARG(j,v),ARG(j,v),code,arg,NULL,&temp,reason);
                                 if(!err)
                                     { ARGREP(ARG(i,*next),j,temp);
                                       save_path();
                                     }
                                 else
                                    { destroy_term(t);
                                      set_currentline(currentline);
                                      return err;
                                    }
                               }
                           else
                              ARGREP(ARG(i,*next),j,ARG(j,v));
                         }
                    }
                 else
                    { /* v is an equation */
                      ++k;
                      if(k == abs(selected_equation))
                         { code = access_optable(op.men)[op.choice-1];
                           err = exec_aux(v,v,code,arg,NULL,&temp,reason);
                           if(!err)
                              { ARGREP(*next,i,temp);
                                save_path();
                              }
                           else
                              { destroy_term(t);
                                set_currentline(currentline);
                                return err;
                              }
                         }
                    }
               }
            set_currentline(currentline);
            /* don't return; selected_equation was zero and nothing has
               been done.  The operation must have been chosen from the
               Operations menu. */
          }
     }
  assert(abs(selected_equation) < ARITY(t) + 1);
  code = access_optable(op.men)[op.choice-1]; /* .choice field starts from 1, not 0 */
    /* following two lines initialize all the locus fields to ILLEGAL; they
       are set to legal terms only when we pass through operators binding
       the variables. */
  for(i=0;i<nvariables;i++)
     SETFUNCTOR(varinfo[i].locus,ILLEGAL,0);
  if(selected_equation == 0 ||
     code == showalleqns
       /* showalleqns is the only op you can apply at toplevel when some
          equation is selected */
    )
    { err = exec_aux(t,t,code,arg,NULL,next,reason);
      set_currentline(currentline);
      if(err)
         { destroy_term(t);  /* made by 'copy' above */
           return err;
         }
      save_path();
      return 0;
    }
  else
    { *next = make_term(FUNCTOR(t),ARITY(t));
      which_equation = abs(selected_equation);
      for(i=0;i<ARITY(t);i++)
         { if(i != which_equation -1)
              ARGREP(*next,i,ARG(i,t));
         }
      p = ARG(which_equation-1,t);
      err = exec_aux(p,p,code,arg,NULL,ARGPTR(*next)+which_equation-1,reason);
      set_currentline(currentline);
      if(err)
         { RELEASE(*next);
           destroy_term(t);  /* made by 'copy' above */
         }
      else
         save_path();
      if(FUNCTOR(t) == AND && LINEUP(t))
         { /* are the variables to be lined up in *next, or not?
              If so, then we need to so indicate with the LINEUP bit. */
           if(!is_linear_system(t,currentline,&vlist))
              { SET_LINEUP(*next);
                RELEASE(vlist);
                SET_FACTORME(ARG(which_equation-1,t));
              }
           else
              { for(i=0;i<ARITY(t);i++)
                   { if(FACTORME(ARG(i,t)))      /* the FACTORME bit says the variables should be lined up */
                         UNSET_FACTORME(ARG(i,t));
                   }
              }
         }
      return err;
    }
}
/*_____________________________________________________________________*/
/* p is usually a subterm of t when exec_aux is called, but NOT ALWAYS,
see comments near "a bit tricky"  in automode.c.  If it is NOT a
subterm of p, exec_aux should fail (return 1). */

/* execute op  on t by applying it to the leftmost subterm of p
to which it will apply.  Arg is an argument if op requires one; otherwise
it is a dummy term with functor ILLEGAL.  The result of the application
will be the term *next which is to become history[++currentline], and
*reason is the justification for the step */
/* zero return value means success, 1 means failure */
/*  reason should already have enough space to hold the answer */

/* Note:  If the operator applies successfully at a subterm u of t,
then (1) any duplicate occurrences of u also get replaced by the answer,
unless the operator is 'contextsensitive', and (2) we go on applying
that operator to other subterms to the right, even if the occurrences
aren't identical.  Thus we might collect powers in many different summands
of a long sum at one step.  (However, (2) does NOT apply to terms with
functor '^'; what we do in the base will not also be done in the power,
unless it's covered by (1).)

   When continuing to the right, we keep on working on the ORIGINAL
term, not on the result of the substitutions made in (1).  (If we
make the substitutions first, then we'll be working on the results of
the operator maybe, and besides since substitution flattens terms our
numbering of arguments will be confused.)  Thus if there
is a duplication of the 'focus' (term on which the operator worked),
the work would be duplicated.  This is prevented by the use of the
static variables 'checkfocus' and 'focus';  when we're checking for a possible
second application, checkfocus==1, and in that case, we don't apply operators
to terms equal to focus.  Since it's static its value carries through levels
of recursion to where it's needed.

   There's another hitch:  what if there's a second term to which the operator
is applicable, and it happens to occur in the result of the first application?
Then at the second application it will get replaced too. Example:  start with
2+2 and use complexfactorsofinteger to replace 2 = -i(1+i)^2.  Now the
second 2 is also replaced by the result of the first application,
yielding  -i(1+i)^2 -i(1+i)^2.  But now the 2 in the second exponent would get
worked on as exec_aux moves right, and it and the 2 in the
first exponent would ALSO be replaced, yielding an unwanted (but correct)
result.  This 'hitch' was dealt with in this case simply by declaring
the offending operators to be 'contextsensitive'.

Another related example eventually came up: using rectangulartopolar
on (1+i)i produces sqrt(2) e^(i pi/2) i at first, but then it should
apply to the i also, and without something to prevent it, it would
replace not only THAT i with e^(i pi/2) but also the one in the exponent,
that resulted from the FIRST application.  To prevent this, 'nextline'
has to be smart enough not to substitute the result into COLORed terms.

Another hitch is this:  the second attempted application can leave an
inappropriate comment in comment_buffer[0].  This happened only once, and
I decided to fix it by simply fixing operators to not leave the offending
comments, rather than more fundamentally by redirecting comments during
attempted second applications.

If firstreason is not NULL, and the operation succeeds with reason a different
string from firstreason, then failure is forced (1 is returned).  This is used
to prevent an operation from succeeding in a second focus where it really does
succeed but the reason string is different (for example if SetShowStepOperation
were used; but it can happen anyway, even in the same operation).
*/

int exec_aux(term t, term p, actualop code, term arg, char *firstreason, term *next, char *reason)
{ int err,savej;
  unsigned short i,j,nargs;
  unsigned short f = FUNCTOR(p);
  term ShowStepArg1, ShowStepArg2;
  term q,temp,x;
  short savenextassumption;
  int nvariables = get_nvariables();
  term *varlist = get_varlist();
  varinf *varinfo = get_varinfo();
  term savelocus,savemaxscope;
  char localbuf[80];
  static int checkfocus;  /* whether to look at focus before applying op */
  static term focus;  /* last term to which an operator was successfully applied */
     /* now apply code to p and put the result in q, using arg if needed */
  assert(code != NULL);
  if(checkfocus && equals(p,focus))
     return 1;
  savenextassumption = get_nextassumption();
  if(BINDING2(p))
      /* if f is a binding operator, set varinfo[].locus */
      /* and enter the appropriate assumptions in 'binders' */
     { x = BOUNDVAR(p);
       for(i=0; (int) i < nvariables;i++)
         { if(equals(x,varlist[i]))
              break;
         }
       assert((int) i < nvariables);  /* you must find the variable in varlist */
       savelocus = varinfo[i].locus;
       savej = i;
       varinfo[i].locus = p;
       fillbinders(p);
       savemaxscope = get_maxscope();
       set_maxscope(p);
                /* used in 'nextline'; should be the smallest enclosing
                   subterm binding a variable */
     }
  err =  (* code)(p,arg,&q,reason);
  if(!err && firstreason != NULL && strcmp(firstreason,reason))
     err = 1;  /* fail if reason differs from the first-focus reason */
  if(err)
     set_nextassumption(savenextassumption);
  if(err == 2 || /* means it failed on purpose */
     err == 3   /* means user pressed Cancel at a dialog box to back out */
    )
     { if(BINDING2(p))
          { varinfo[savej].locus = savelocus;
            releasebinders();
            set_maxscope(savemaxscope);
          }
       return err;
     }
  if(err == 0)   /* success at node p, with one possible exception noted below */
     { assert(FUNCTOR(q) != 0 || ARITY(q)==1); /* guard against errors in
          operator definitions that result in returning ill-formed terms */
       focus = p;
       if(BINDING2(p))
          { varinfo[savej].locus = savelocus;
            releasebinders();
            err = nextline(code,arg,q,p,t,next);
            set_maxscope(savemaxscope);
          }
       else
          err = nextline(code,arg,q,p,t,next);
       if(err)
          return 1;  /* if q wasn't a subterm of p, see comments above */
       if(!specialop(arg,code))
          update_assumptions(p,q,next);
       if(FUNCTOR(arg) != ILLEGAL &&
          (
            code ==  evaluatesigmatorational ||
            code ==  evaluatesigmatodecimal ||
            code ==  integratenumerically
          )
         )
              /* the sum which has been evaluated for a particular value of
                 a parameter may not be the whole current line, so we have
                 to substitute arg for the parameter; but what IS the
                 parameter?  It can be extracted from the reason string.
               */
          { char pname[33];
            int ii=0;
            term param,temp;
            while (reason[ii] != 32 && ii<32)
               { pname[ii] = reason[ii];
                 ++ii;
               }
            pname[ii] ='\0';
            param = make_atom_from_string(pname);
            subst(arg,param,*next,&temp);
            *next = temp;
          }
       assert(*reason != '\0'); /*  reason string must be returned */
       save_path();
       return 0;
     }
   /*  so if we get here, code doesn't apply at node p */
  if( (f == '=' || f == OR) &&
      code ==  checkroot
    )
     set_checked();
  if( f  == INTEGRAL &&
      ( code ==  intsub || code == choosesubstitution) &&
      FUNCTOR(arg) == ILLEGAL
    )
     set_prime(p);
  if( FRACTION(p) &&  code ==  cancelgcd)
     set_prime(p);  /* don't try cancelgcd again */
  if(ATOMIC(p))
     return 1;    /* failure, at a leaf node */
  if(toponly(code) ||
     ((void  *)code == (void  *) makesubstitution && get_pathlength() > 2)
    )
     { if(BINDING2(p))
          { varinfo[savej].locus = savelocus;
            releasebinders();
            err = (* code)(t,arg,next,reason);
            set_maxscope(savemaxscope);
            if(!err)
                save_path();
            return err;
          }
       return 1;   /* this op can only apply at toplevel */
     }
  if(f == '/')
     increment_infractionflag();  /* keep track of nested compound fractions */

  nargs =  ARITY(p);
  if(f==SUM &&  code ==  devalop)
     nargs = 1;  /* don't evaluate limits of a SUM to a double */
  for(i=0;i<nargs;i++)     /* go down the tree to the daughter nodes */
      /* FINISH THIS--if there's a selected term, don't go into daughter nodes
         that don't overlap the selected term.  Example, if a term is selected
         as the arg of a substitution from the third equation, don't apply
         makesubstitution only to the first equation. */
     { push(f);
       push((unsigned short)(i+1));
       err = exec_aux(t,ARG(i,p),code,arg,firstreason,next,reason);
       pop();
       pop();
       if(err==0)
         { int csflag = contextsensitive(code);
           int needsargflag = 0;
           int tempint;
           char prompt[MAXPROMPTLENGTH];
           if( !csflag && FUNCTOR(t) != '^')
              { operation op;
                code_to_op(code,&op);
                if(needs_arg(op,prompt) || needs_two_args(op,&tempint))
                   needsargflag = 1;
              }

           if( !csflag && !needsargflag &&
               FUNCTOR(t) != '^' &&   /* don't go into exponents */
               !(f == AND && interval_as_and(p))
                 /* for an interval_as_and, exec_aux has already
                    used fixup in nextline to apply the operator
                    to both inequalities
                 */
             )
             /* apply the operator elsewhere to the right if possible */
              { int loopbound,nextarg;
                checkfocus = 1;
                if(FRACTION(p) && i==1)
                   /* go into the numerator AFTER the denom */
                   { nextarg = 0;
                     loopbound = 1;
                   }
                else
                   { nextarg = i+1;
                     loopbound = ARITY(p);
                   }
                for(j=nextarg;j<loopbound;j++)
                   { SETFUNCTOR(arg,ILLEGAL,0);
                     SaveShowStepState();
                     push(f);
                     push((unsigned short)(j+1));
                     err = exec_aux(*next,ARG(j,p),code,arg,reason,&temp,localbuf);
                     pop();
                     pop();
                     GetShowStepArgs(&ShowStepArg1,&ShowStepArg2);
                     if(get_pathtail()[0] || GetShowStepOperation() ||
                        FUNCTOR(GetShowStepArg()) != ILLEGAL ||
                        FUNCTOR(ShowStepArg1) != ILLEGAL ||
                        FUNCTOR(ShowStepArg2) != ILLEGAL
                       )
                        err = 1;
                     RestoreShowStepState();
                     if(!err)
                        *next = temp;
                       /* don't do it in the same step unless the reason string
                          generated is the same.  */
                   }
                checkfocus = 0;
              }
           if(f == '/')
              decrement_infractionflag();
           if(BINDING2(p))
              { varinfo[savej].locus = savelocus;
                releasebinders();
                set_maxscope(savemaxscope);
              }
           return 0;       /* success */
         }
     }
  if(f == '/')
     decrement_infractionflag();
  if(BINDING2(p))
     { varinfo[savej].locus = savelocus;
       releasebinders();
       set_maxscope(savemaxscope);
     }
  return 1;       /* failed to apply op at any daughter node */
}
/*_____________________________________________________________________*/
MEXPORT_AUTOMODE void erasecolors(term *t)
/* erase the color info in all subterms of *t */
{ unsigned i,n;
  if(COLOR(*t))   /* don't try to erase the color bit unless it's set, because
                     if you try SETCOLOR on one of the constant integers, it
                     causes an access violation in Win32 */
     SETCOLOR(*t,0);
  if(!ATOMIC(*t))
     { n = ARITY(*t);
       for(i=0;i<n;i++)
          erasecolors(ARGPTR(*t) + i);
     }
}
/*_________________________________________________________________*/
int toponly(actualop op)
/* return 1 if op is only applicable to the toplevel node and hence
need not be tried on subterms */

{ if( op ==  lineupvars ||
      op ==  unwinddefinition ||
      op ==  autosubstitution ||
      op ==  invisiblesub ||
      op ==  selecteqn ||
      op ==  showalleqns ||
      op ==  showcallingproblem ||
      op ==  equatetoproblem ||
      op ==  evalatpoint ||
      op ==  basiscase ||
      op ==  inductionstep ||
      op ==  thereforeasdesired ||
      op ==  selectinductionvariable ||
      op ==  useinductionhyp ||
      op ==  addcriticalpoints ||
      op ==  addundefinedpoints ||
      op ==  addlimits ||
      op ==  rejectpoint ||
      op ==  tabulate ||
      op ==  checkroot ||
      op ==  substforvar
    )
     return 1;
  if(op ==  arithmetic)
     return (status(arithmetic) <= LEARNING ? 0 : 1);
  return 0;
}
/*__________________________________________________________________*/
int check_for_contradictions(int *ii, int *jj)
/* Check the assumptions for an immediate contradiction between two
of them; each one individually has been checked by 'value' already */
/* Does not check for contradictions involving more than two assumptions */
/* Return 1 if no contradiction is found, -1 if one is */
/* Return in *ii and *jj the indices of the contradictory propositions
   if they are found; if not these will contain garbage. */

{ int i,j,err;
  int nextassumption = get_nextassumption();
  for(i=0;i<nextassumption-1; i++)
    { for(j=i+1; j < nextassumption; j++)
        { err = contradictory(get_assumption(i), get_assumption(j));
          if(!err)
             { *ii = i;
               *jj = j;
               return -1;  /* contradiction found */
             }
        }
    }
  return 1;  /* no contradiction found */
}
/*__________________________________________________________________*/
static int contradictory(term p, term q)
/* return 0 if p and q are immediately contradictory, 1 if not */
/* used on assumptions, which are always written with < and LE
and not with > and GE */
/* it is assumed that p and q are not individually contradictory, i.e.
they aren't 'false' and have been checked by 'value' */
{ unsigned f = FUNCTOR(p);
  unsigned g = FUNCTOR(q);
  term ans;
  int err;
  assert(f != FALSEFUNCTOR);
  assert(g != FALSEFUNCTOR);
  if(ATOMIC(p) || ATOMIC(q))
     return 1;
  if(ARITY(p) != 2 || ARITY(q) != 2)
     return 1;  /* we are only going to check equalities and inequalities */
  err = conjoin(p,q,&ans);
  if(err)
     return 1;  /* conjoin can't do anything, so we can't find a contradiction */
  if(equals(ans,false))
     return -1;      /* found a contradiction */
  return 1;          /* can't find a contradiction */
}

Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists