/* 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 subst(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;
}
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: {
%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 */
strip_trailing_spaces(p[0]);
for(pp
=p
[0];*pp
;pp
++) if(!isalnum(*pp
) && *pp
!='_') {
/* bad name and security risk */
ovlstrcpy(pp,pp+1); pp--;
}
p[1]=find_word_start(p[1]);
snprintf(vbuf
,sizeof(vbuf
),"%s",p
[1]); subst
(vbuf
);
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;
prepcnt
=0; fprintf(outf
,"!ifval %s \n",vbuf
);
parmprep(buf, ptype); putval(buf,p[0],ptype);
if(p2!=NULL) {
parmprep(buf, ptype); putval(buf,p[0],ptype);
}
}
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);
}