Sindbad~EG File Manager

Current Path : /usr/home/beeson/MathXpert/docdata/
Upload File :
Current File : /usr/home/beeson/MathXpert/docdata/fexec.c

/* M. Beeson for Windows Mathpert */
/*
1.31.95 original date
11.22.99 last modified
12.29.99 modified fexec at 'equatetoproblem'
1.10.00 added FUNCTOR(q) != LIMIT
1.18.06  changed handles to pointers etc.
8.30.07 modified replace_aux and added 'flatten'
6.24.13 added stddef.h  and stdlib.h
3.13.23 removed include dowith.h
3.18.23  put it back, needed for on_path
4.11.24 changed code = access_optable(op.men)[op.choice-1]; to ...[op.choice]  [undid 4.12]
7.21.24 removed an 'unused variable' line
*/
#include <assert.h>
#include <math.h>
#include <stddef.h>
#include <stdlib.h>
#include "globals.h"
#include "graphstr.h"
#include "mpdoc.h"
#include "checkarg.h"   /* needed by execute.h */
#include "execute.h"
#include "display.h"
#include "display1.h"   /* block */
#include "bigrect.h"
#include "lterm.h"
#include "mtext.h"      /* MAXMENUS    */
#include "optable.h"
#include "exec.h"       /* erasecolors */
#include "selectop.h"   /* abstract    */
#include "automode.h"   /* get_activeline */
#include "cflags.h"
#include "fexec.h"
#include "getarg.h"     /* needs_arg   */
#include "prover.h"     /* interval_as_and, fillbinders */
#include "probtype.h"   /* MINMAX      */
#include "nextline.h"   /* strip_multiplicities and update_assumptions */
#include "errbuf.h"
#include "order.h"      /* numerical */
#include "ops.h"        /* showalleqns */
#include "pvalaux.h"    /* topflatten */
#include "mplimits.h"   /* LIMITAND   */
#include "binders.h"
#include "autosimp.h"   /* setprimebits */
#include "calc.h"       /* choosesubstitution etc. */
#include  "dowith.h"    /*  on_path  */

static int replace(pathlist *path, term q, term t, term *ans);
/*_________________________________________________________________*/
int fexec(PDOCDATA pDocData,operation op, ltermlist *selected)
/* pDocData points to the active symbol document.
op is the operator chosen by the user.
selected is a nonempty list of terms selected by the user.
Apply (or try to apply at least) op to the selected terms.
Return 1 for failure of the operation,
return 3 if the user cancels out of a GetArg dialog.
Return 0 for success; in that case increment
currentline and put the result in history[currentline].
*/

{ int activeline = get_activeline();
  int currentline = get_currentline();
  int savej;
  varinf *varinfo = get_varinfo();
  int nvariables = get_nvariables();
  term *varlist = get_varlist();
  short savenextassumption = get_nextassumption();
  int failed_on_purpose = 0;
  char buffer[128];
  int success;
  int i,err;
  term t,u,p,q,s,x,savelocus;
  term arg, next;
  int saveeigen = get_eigenindex();
  int orderflag = get_orderflag();
  condition c;
  char reason[DIMREASONBUFFER];
  ltermlist *marker;
  lterm focus;
  pathlist *z;
  int (*code)(term,term,term *, char *);
  void  *savenode = heapmax();
  int selected_equation = get_selected_equation();
  int bindersflag = 0;
  int savemode = get_mathmode();
  clear_error_buffer();
  clear_comment_buffer();
  selectionmode();  /* set mathmode to SELECTIONMODE */
  copy(history(activeline),&t);
  erasecolors(&t);
  if(abs(selected_equation) > ARITY(t))
     assert(0);
  set_currentline(activeline);
  code = access_optable(op.men)[op.choice-1];
  for(i=0;i<nvariables;i++)
     SETFUNCTOR(varinfo[i].locus,ILLEGAL,0);
  assert(selected);
  success = 0;
  c = needs_arg(op,buffer);
  if(c)
      { /* Since wget_arg will use the selected term for the arg if there
           is one, we must make it think there is none, by saving the
           pointer to the list of selected terms and temporarily setting
           it to NULL.  It's a hassle to get at that pointer first: */
        assert(0);  // this better not be called if op needs an arg.
        #if 0
        ltermlist *saveit;
        saveit = pPapyrus->selected;
        pPapyrus->selected = 0;
        err = wget_arg(pDocData,c,&arg,buffer);
        pPapyrus->selected = saveit;
        if(err)
           { set_mathmode(savemode);
             return 3;  /* user refused to supply an acceptable arg */
           }
        #endif 
      }
   else
      SETFUNCTOR(arg,ILLEGAL,0);

  for(marker=selected;marker;marker=marker->next)
     { focus = marker->data;
       /* Any binding operators on the path to focus ? */
       for(z = marker->data.path, q=t; z && z->data>=0; q= ARG(z->data,q),z= z->next)
          { unsigned short ff = FUNCTOR(q);
            if(z->data == 1 && z->functor == '^' && orderflag == ASCENDING)
               set_orderflag(DESCENDING);
            if(ff == LIMIT || ff == INTEGRAL || ff == DIFF || ff == PRODUCT || ff == SUM)
               /* on indefinite integrals and derivatives we still have to set the
                  eigenvariable.  On true binding ops, we have to call fillbinders */
               { x = BOUNDVAR(q);
                 for(i=0;i<nvariables;i++)
                    { if(FUNCTOR(x)==FUNCTOR(varlist[i]))
                         break;
                    }
                 if(i == nvariables)
                    assert(0);
                 set_eigenvariable(i);
                 if(BINDING2(q))
                    { varinfo[i].locus = q;
                      fillbinders(q);
                      ++bindersflag;
                    }
               }
          }
       if( selected_equation < 0 && (void  *) code == (void  *) showalleqns)
          copy(history(activeline),&p);
       else
          p = abstract(focus);
       erasecolors(&p); /* otherwise colored subterms of one line can get
                           inherited to the next. */
       if(BINDING2(p))
          { x = BOUNDVAR(p);
            fillbinders(p);
            setlocus(x,&savelocus,&savej,p);
            ++bindersflag;
            for(i=0;i<nvariables;i++)
               { if(FUNCTOR(x)==FUNCTOR(varlist[i]))
                    break;
               }
            if(i == nvariables)
               assert(0);
            set_eigenvariable(i);
          }
       if(FUNCTOR(p) == AND && interval_as_and(p))
          { /* if it doesn't apply to the AND, then
               apply code separately to the right and left conjuncts */
            term right,left;
            /* First see if it will work on the AND */
            err = (*code)(p,arg,&q,reason);
            set_eigenvariable(saveeigen);
            if(err)
               { err = (*code)(ARG(0,p),arg,&left,reason);
                 if(err)
                    continue;
                 err = (*code)(ARG(1,p),arg,&right,reason);
                 if(err)
                   continue;
                 q = and(left,right);
                 if(!interval_as_and(q))
                    q = and(right,left);
                    /* for example, if  a < -x < b goes to -b < x < -a */
                 if(!interval_as_and(q))
                    continue;
                    /* Whatever you do don't go to an & instead of an interval_as_and */
               }
          }
       else
          { int savecomdenomflag = get_polyvalcomdenomflag();
            if(on_path(focus.path,'/'))
               set_polyvalcomdenomflag(1);
            err = (*code)(p,arg,&q,reason);
            if(err > 1)
               failed_on_purpose = 1;
            set_polyvalcomdenomflag(savecomdenomflag);
            set_eigenvariable(saveeigen);
            if(orderflag == ASCENDING)
               set_orderflag(orderflag);
            if(err)
               continue;
          }
       if(orderflag == ASCENDING)
          set_orderflag(orderflag);
       success = 1;
       if(FUNCTOR(p) == INTEGRAL && ARITY(p) == 4 && IMPROPER(p) && FUNCTOR(q) != LIMIT)
          setimproper(&q);
       for(i=0;i<nvariables;i++)
          SETFUNCTOR(varinfo[i].locus,ILLEGAL,0);
       for(; bindersflag; --bindersflag)
          releasebinders();  /* as many times as fillbinders was called */
          /* You CAN have nested binders in Mathpert by taking an
             integral or limit of a SIGMA term  */
       if(get_problemtype() == MINMAX && contains(q,MULTIPLICITY))
          q = strip_multiplicities(q);
       if(selected_equation < 0 && (void  *) code != (void  *) showalleqns)
          { int k = - selected_equation -1;
            err = replace(marker->data.path,q,ARG(k,t),&s);
            if(err)
               assert(0);
            SET_SELECTED(s);
            u = make_term(FUNCTOR(t),ARITY(t));
            for(i=0;i<ARITY(t);i++)
               ARGREP(u,i,i == k ? s : ARG(i,t));
            s = u;
          }
       else if((void  *) code == (void  *) choosesubstitution ||
               (void  *) code == (void  *) autochoosesubstitution || 
               (void  *) code == (void  *) showalleqns ||
               (void  *) code == (void  *) showcallingcubic || 
               (void  *) code == (void  *) lineupvars ||
               /* see autosimp.c for a list of these operations, 
                  search for showalleqns to find it */
               (void  *) code == (void  *) equatetoproblem
              )
          copy(q,&s);
       else
          err = replace(marker->data.path,q,t,&s);
       if(err)
          assert(0);   /* since the path was generated by select_term,
                          replace cannot fail. */
       t = s;
     }
  if(!success)
     { /* the operator could not be applied */
       for(; bindersflag; --bindersflag)
          releasebinders();  /* as many times as fillbinders was called */
       set_nextassumption(savenextassumption);
       reset_heap(savenode);
       set_currentline(currentline);
       next = zero;  /* avoid a warning message that
         next hasn't been defined; it isn't used
         in the next call because the first arg is 1,
         but the compiler doesn't know that. */
       finish_exec(pDocData,1+failed_on_purpose,op,next,reason);
       /* so 2 is passed if the operator failed on purpose; this
          will suppress an 'Operator Failed' message. */
       set_mathmode(savemode);
       return 1;
     }
  /* OK, the operator worked */
  next = push_multiplicities(topflatten(t));
  set_currentline(currentline);
  update_assumptions(p,q,&next);
  finish_exec(pDocData,0,op,next,reason);
  set_mathmode(savemode);
  return 0;
}
/*_______________________________________________________________*/
static int legal_path(pathlist *path, term t)
/* return 1 if path does not run out of t, i.e. there
is a term at the location in t specified by path.
return -1 if the path is legal but ends in a negative
integer, signifying the selection of a 'generalized subterm'.
Return 0 otherwise.
*/

{ int k,j;
  unsigned f;
  if(!path)
     return 1;
  if(ATOMIC(t))
     return 0;
  f = FUNCTOR(t);
  k = path->data;
  if(k==-1 && path->functor == '-')
     { /* selected  -a from -ab for example, or -ab from -abc */
       if(path->next == 0)
          return 0;
       return legal_path(path->next,ARG(0,t));
     }
  if(k >= ARITY(t))
     return 0;
  if(path->next && path->next->data < 0 && path->next->functor != '-')
  /* this path tries to select a range of args of t */
     { j = - path->next->data;
       if(f != '+' && f != '*' && f != AND && f != OR)
          return 0;  /* not legal to select a range */
       if(j > k && j <= ARITY(t))
          return 1;
       return 0;
     }
  return legal_path(path->next, ARG(k,t));
}
/*_______________________________________________________________*/

static term replace_aux(pathlist *path, term q, term t)
/* Given that path is legal in t, substitute q for
the subterm found in t along that path.  Must work even if
the path selects a subrange of a sum (etc.)
   Take care that if q is colored, the
result of substituting for q is colored too, even if it
is just part of a flattened term. 
   Do NOT mess up t outside the path leading to q,  as
in case of multiple selections,  those parts of t still 
need to be accessible by paths already computed in t,
but with those paths being interpreted in the result of 
replace_aux.  In particular do not flatten the result--
that will have to be done after all those paths have been used.
*/

{ unsigned short n = ARITY(t);
  unsigned short f = FUNCTOR(t);
  int m,err;
  term u,ans,temp;
  int i,j,k;
  if(!path)
    { if(f == INTEGRAL && n == 4 && IMPROPER(t) && FUNCTOR(q) == INTEGRAL)
         SETIMPROPER(q);
      return q;
    }
  if(ZERO(q) && path->next == 0 &&
     f == '/' && path->data == 1 &&
     FUNCTOR(ARG(1,t)) == LIMIT
    )
     { /* substituting zero into a denominator.  The fraction must
          be marked with SET_INFINITESIMAL if necessary. */
       ans = make_fraction(ARG(0,t),zero);
       u = LIMITAND(ARG(1,t));
       fillbinders(ARG(1,t));
       err = infer(le(zero,u));
       if(!err)
          { SETPOSITIVE(ans);
            releasebinders();
            return ans;
          }
       err = infer(le(u,zero));
       if(!err)
          { SETNEGATIVE(ans);
            releasebinders();
            return ans;
          }
       SETINFINITESIMAL(ans);
       releasebinders();
       return ans;
     }
  if(path->data == -1 && path->functor == '-')
     { /* t is -ab and q must replace -a, or t is -abc and q must replace -ab, etc. */
       if(!NEGATIVE(t) || FUNCTOR(ARG(0,t)) != '*')
          assert(0);
       if(path->next->data != 0)
          assert(0);
       if(path->next->functor != '*')
          assert(0);
       if(path->next->next  && path->next->next->data < 0)
          { /* example, selecting - 8*8 from -8*8*x */
            m = -path->next->next->data; /* m is 2 in the example */
            /* m factors, 0,1,...,m-1, have been selected from the negated product
               along with the minus sign */
          }
       else 
          m = 1;
       temp = make_term('*',(unsigned short)(ARITY(ARG(0,t))-m + 1));
       ARGREP(temp,0,q);
       for(i=1;i<ARITY(temp);i++)
          ARGREP(temp,i,ARG((unsigned short)(m+i-1),ARG(0,t)));
       return temp;
     }
  ans = make_term(f,n);
  if(f == INTEGRAL && n == 4 && IMPROPER(t))
     SETIMPROPER(ans);
  k = path->data;
  if(path->next && path->next->data < 0 && path->next->functor != '-')
      /* this path selects a subrange */
      { j = -path->next->data;
        assert(j > k && j <= n);
        /* Replace args k through j-1 by q. That's j-k args */
        if(FUNCTOR(q) == f)
           m =(unsigned short)(n-(j-k) + ARITY(q));
        else
           m =(unsigned short)(n-j+k+1);
        ans = make_term(f,(unsigned short)m);
        for(i=0;i<k;i++)
           ARGREP(ans,i,ARG(i,t));
        if(FUNCTOR(q) == f)
           { for(i=0;i<ARITY(q);i++)
                ARGREP(ans,k+i,ARG(i,q));
             for(i=j;i<n;i++)
                ARGREP(ans,(unsigned short)(i-j+k+ARITY(q)), ARG(i,t));
           }
        else
           { ARGREP(ans,k,q);
             for(i=j;i<n;i++)
                ARGREP(ans,i-j+k+1, ARG(i,t));
           }
        return ans;  /* Whew! */
      }
  for(i=0;i<n;i++)
     ARGREP(ans,i, i==k ? replace_aux(path->next,q,ARG(i,t)) : ARG(i,t));
  if(f == '/' && SOME_INFINITESIMAL(t))
     { if(POSITIVE_INFINITESIMAL(t))
          SETPOSITIVE(ans);
       else if(NEGATIVE_INFINITESIMAL(t))
          SETNEGATIVE(ans);
       else
          SETINFINITESIMAL(ans);
     }
  return ans;
}
/*_______________________________________________________________*/
static int replace(pathlist *path, term q, term t, term *ans)
/* put q at the position in t given by path, if the path
defines a legal position in t. It the path
does not define a legal position in t return 1.
Otherwise return 0 for success.
  The path can terminate in two numbers (i,-j) signififying that
instead of replacing arg i  of the last sum (or product, AND, or OR)
we are to replace the range i to j-1 of its args.
  The path is constructed from an lterm; if the lterm was a MATRIX
term and t is an AND or OR of equations, replace has to take account
of this.
*/

{ if(!path)
     { *ans = q;
       return 0;
     }
  if(ATOMIC(t))  /* and path is nonempty */
     return 1;
  /* Before allocating any memory, determine if the path is legal */
  if(!legal_path(path,t))
      return 1;   /* when written, this function was never called
                     except on paths generated by select_term, so
                     those HAVE to be legal; but I didn't put an
                     assertion here but rather allowed the function
                     a return value for more general use later. */
  /* OK, it fits */
  *ans = replace_aux(path,q,t);
  return 0;
}

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