Subversion Repositories wimsdev

/*    Copyright (C) 1998-2003 XIAO, Gang of Universite de Nice - Sophia Antipolis

 *

 *  This program is free software; you can redistribute it and/or modify

 *  it under the terms of the GNU General Public License as published by

 *  the Free Software Foundation; either version 2 of the License, or

 *  (at your option) any later version.

 *

 *  This program is distributed in the hope that it will be useful,

 *  but WITHOUT ANY WARRANTY; without even the implied warranty of

 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

 *  GNU General Public License for more details.

 *

 *  You should have received a copy of the GNU General Public License

 *  along with this program; if not, write to the Free Software

 *  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 */

#include "../Lib/libwims.h"

#include "msg2wims.h"

int dollar_subst=1;

/* variable substitution. buffer p must have MAX_LINELEN */

void substdoc(char *p)

{

  char *pp, *pe;

  for(pp=p;pp-p<MAX_LINELEN && *pp; pp++) {

    if(*pp=='   ') *pp=' ';

    if(*pp=='\n') *pp=' ';

    if(*pp=='$' && dollar_subst) {

      string_modify(p,pp,pp+1,"$");

      pp++; continue;

    }

    if(*pp=='!' && isalnum(*(pp+1)) && dollar_subst) {

      string_modify(p,pp,pp+1,"!");

      pp++; continue;

    }

    if(*pp!='\\') continue;

    if(*(pp+1)=='\\') {

      pp++; continue;

    }

    if(!isalpha(*(pp+1))) continue;

    for(pe=pp+1;isalnum(*pe) || *pe=='_'; pe++);

    if(pe-pp<MAX_NAMELEN && *pe=='[') {

      char *pt;

      pt=find_matching(pe+1,']'); if(pt!=NULL && pt-pe<MAX_LINELEN) {

        string_modify(p,pt+1,pt+1,")");

        string_modify(p,pp,pp+1,"$(m_");

      }

      else goto nobrack;

    }

    else {

      nobrack: string_modify(p,pp,pp+1,"$m_");

    }

  }

}

void putval(char *p, char *name, int ptype)

{

  switch(ptype) {

    case pt_int: {

      fprintf(outf,"%sm_%s=$[rint(%s)]\n",setpre,name,p);

      break;

    }

    case pt_real: {

      fprintf(outf,"%sm_%s=$[%s]\n",setpre,name,p);

      break;

    }

    case pt_func: {

      fprintf(outf,"%sm_%s=!rawmath %s \n",setpre,name,p);

      break;

    }

    case pt_complex: {

      fprintf(outf,"%st_=!rawmath %s \n%st_=!exec pari print($t_)\n\

%sm_%s=!mathsubst I=i in $t_\n",

                setpre,p,setpre,setpre,name);

      break;

    }

    case pt_matrix: {

      fprintf(outf,"%stmp=!trim %s \n\

%sm_%s=!translate internal $    $ to ; in $tmp\n",setpre,p,setpre,name);

      break;

    }

    case pt_rat: {

      fprintf(outf,"%st_=!rawmath %s \n%sm_%s=!exec pari print($t_)\n",

                setpre,p,setpre,name);

      break;

    }

    default: {

      fprintf(outf,"%sm_%s=%s\n\n",setpre,name,p);

      break;

    }

  }

}

void parm(char *p[MAX_PARM], int ptype)

{

  char *pp, *p2;

  char vbuf[MAX_LINELEN+1];

  setpre="!set ";

  p[0]=find_word_start(p[0]);

  if(*p[0]=='\\') p[0]++;

/* bad name */

  if(!isalpha(*p[0])) return;

  strip_trailing_spaces(p[0]);

  for(pp=p[0];*pp;pp++) if(!isalnum(*pp) && *pp!='_') {

/* bad name and security risk */

    if(!isspace(*pp)) return;

    ovlstrcpy(pp,pp+1); pp--;

  }

  p[1]=find_word_start(p[1]);

  snprintf(vbuf,sizeof(vbuf),"%s",p[1]); substdoc(vbuf);

  fprintf(outf,"\n");

  if((pp=strparchr(vbuf,'?'))!=NULL && pp[1]!='?' && check_compare(vbuf)) {

    char buf[MAX_LINELEN+1];

    p2=strparchr(pp,':'); *pp++=0; if(p2!=NULL) *p2++=0;

    snprintf(buf,sizeof(buf),"%s",vbuf);

    prepcnt=0; fprintf(outf,"!ifval %s \n",vbuf);

    snprintf(buf,sizeof(buf),"%s",pp);

    parmprep(buf, ptype); putval(buf,p[0],ptype);

    if(p2!=NULL) {

      snprintf(buf,sizeof(buf),"%s",p2);

      fprintf(outf,"!else\n");

      parmprep(buf, ptype); putval(buf,p[0],ptype);

    }

    fprintf(outf,"!endif\n");return;

  }

  prepcnt=0; parmprep(vbuf, ptype);

  putval(vbuf,p[0],ptype);

}

void p_int(char *p[MAX_PARM]) {parm(p,pt_int);}

void p_rational(char *p[MAX_PARM]) {parm(p,pt_rat);}

void p_real(char *p[MAX_PARM]) {parm(p,pt_real);}

void p_complex(char *p[MAX_PARM]) {parm(p,pt_complex);}

void p_func(char *p[MAX_PARM]) {parm(p,pt_func);}

void p_text(char *p[MAX_PARM]) {parm(p,pt_text);}

void p_matrix(char *p[MAX_PARM]) {parm(p,pt_matrix);}

void p_parm(char *p[MAX_PARM])

{

  parm(p,pt_real);

}

struct {

    char *name;

    void (*processor) (char *p[MAX_PARM]);

} ptype[]={

  {"complex",  p_complex},

  {"function", p_func},

  {"int",  p_int},

  {"integer",  p_int},

  {"matrix",  p_matrix},

  {"parameter", p_parm},

  {"rational", p_rational},

  {"real",  p_real},

  {"text",  p_text},

  {"variable", p_parm}

};

#define ptypeno (sizeof(ptype)/sizeof(ptype[0]))

void def(char *p)

{

  char *p1,*p2,*pp[2];

  int i;

  p1=find_word_start(p);

  pp[1]=strchr(p1,'='); if(*pp[1]==0) return;

  *pp[1]=0; pp[1]++;

  p2=find_word_start(find_word_end(p1));

  if(*p2==0) {pp[0]=p1; p_parm(pp); return;}

  pp[0]=p2; *find_word_end(p1)=0;

  for(p2=p1; *p2; p2++) *p2=tolower(*p2);

  for(i=0;i<ptypeno;i++) if(strcmp(p1,ptype[i].name)==0) break;

  if(i<ptypeno) ptype[i].processor(pp);

  else p_parm(pp);

}