| version 1.9, 2010/01/31 03:25:54 |
version 1.12, 2018/03/27 06:29:19 |
|
|
| * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
| * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
| * |
* |
| * $OpenXM: OpenXM_contrib2/asir2000/builtin/subst.c,v 1.8 2010/01/28 08:56:26 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/subst.c,v 1.11 2017/09/06 06:25:26 noro Exp $ |
| */ |
*/ |
| #include "ca.h" |
#include "ca.h" |
| #include "parse.h" |
#include "parse.h" |
| Line 55 void Psubstr2np(); |
|
| Line 55 void Psubstr2np(); |
|
| |
|
| struct ftab subst_tab[] = { |
struct ftab subst_tab[] = { |
| {"subst",Psubst,-99999999}, |
{"subst",Psubst,-99999999}, |
| {"substr2np",Psubstr2np,2}, |
{"substr2np",Psubstr2np,-3}, |
| {"subst_quote",Psubst_quote,-99999999}, |
{"subst_quote",Psubst_quote,-99999999}, |
| {"psubst",Ppsubst,-99999999}, |
{"psubst",Ppsubst,-99999999}, |
| {"substf",Psubstf,-99999999}, |
{"substf",Psubstf,-99999999}, |
| Line 64 struct ftab subst_tab[] = { |
|
| Line 64 struct ftab subst_tab[] = { |
|
| |
|
| extern Obj VOIDobj; |
extern Obj VOIDobj; |
| |
|
| |
/* substr2np(P,[[v,a],...]) or substr2np(P,[v1,...],[a1,...]) */ |
| |
|
| void Psubstr2np(NODE arg,Obj *rp) |
void Psubstr2np(NODE arg,Obj *rp) |
| { |
{ |
| Obj a; |
Obj a,b; |
| P nm,dn,p; |
P nm,dn,p,q; |
| R r; |
R r; |
| VL vl,tvl; |
VL vl,tvl; |
| int nv,i; |
int nv,i,ac,j; |
| NODE slist,t,ps; |
NODE slist,t,ps,u,vlist; |
| P s; |
P s; |
| P *svect; |
P *svect; |
| V v; |
V v; |
| V *vvect; |
V *vvect; |
| |
|
| a = (Obj)ARG0(arg); |
a = (Obj)ARG0(arg); |
| if ( !a || NUM(a) ) { |
if ( !a || NUM(a) ) { |
| *rp = a; |
*rp = a; |
| return; |
return; |
| } |
} |
| asir_assert(ARG0(arg),O_R,"substr2np"); |
asir_assert(ARG0(arg),O_R,"substr2np"); |
| asir_assert(ARG1(arg),O_LIST,"substr2np"); |
asir_assert(ARG1(arg),O_LIST,"substr2np"); |
| get_vars(a,&vl); |
get_vars(a,&vl); |
| for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ ); |
for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ ); |
| nv = i; |
nv = i; |
| vvect = (V *)MALLOC(nv*sizeof(V)); |
vvect = (V *)MALLOC((nv)*sizeof(V)); |
| for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ ) vvect[i] = tvl->v; |
for ( i = 0, tvl = vl; tvl; tvl = NEXT(tvl), i++ ) vvect[i] = tvl->v; |
| svect = (P *)MALLOC(nv*sizeof(P)); |
svect = (P *)MALLOC((nv)*sizeof(P)); |
| slist = BDY((LIST)ARG1(arg)); |
ac = argc(arg); |
| for ( i = 0; i < nv; i++ ) svect[i] = (P)VOIDobj; |
if ( ac == 2 ) { |
| for ( t = slist; t; t = NEXT(t) ) { |
slist = BDY((LIST)ARG1(arg)); |
| ps = BDY((LIST)BDY(t)); p = (P)BDY(ps); s = (P)BDY(NEXT(ps)); |
for ( i = 0; i < nv; i++ ) svect[i] = (P)VOIDobj; |
| asir_assert(p,O_P,"substr2np"); asir_assert(s,O_N,"substr2np"); |
for ( t = slist; t; t = NEXT(t) ) { |
| v = VR(p); |
ps = BDY((LIST)BDY(t)); p = (P)BDY(ps); s = (P)BDY(NEXT(ps)); |
| for ( i = 0; i < nv; i++ ) if ( vvect[i] == v ) break; |
asir_assert(p,O_P,"substr2np"); asir_assert(s,O_P,"substr2np"); |
| svect[i] = s; |
v = VR(p); |
| } |
for ( i = 0; i < nv; i++ ) if ( vvect[i] == v ) break; |
| |
svect[i] = s; |
| switch ( OID(a) ) { |
} |
| case O_P: |
} else if ( ac == 3 ) { |
| substpp(vl,(P)a,vvect,svect,nv,&nm); *rp = (Obj)nm; |
asir_assert(ARG2(arg),O_LIST,"substr2np"); |
| return; |
vlist = BDY((LIST)ARG1(arg)); |
| case O_R: |
slist = BDY((LIST)ARG2(arg)); |
| substpp(vl,(P)NM((R)a),vvect,svect,nv,&nm); |
for ( i = 0; i < nv; i++ ) svect[i] = (P)VOIDobj; |
| substpp(vl,(P)DN((R)a),vvect,svect,nv,&dn); |
for ( u = vlist, t = slist; u && t; u = NEXT(u), t = NEXT(t) ) { |
| if ( !dn ) |
v = VR((P)BDY(u)); |
| error("substr2np: division by 0"); |
for ( i = 0; i < nv; i++ ) if ( vvect[i] == v ) break; |
| else if ( !nm ) |
svect[i] = (P)BDY(t); |
| *rp = 0; |
} |
| else if ( NUM(dn) ) { |
} else |
| divsp(vl,nm,dn,&p); |
error("substr2np : argument mismatch"); |
| *rp = (Obj)p; |
for ( i = 0; i < nv; i++ ) { |
| } else { |
if ( (int)(vvect[i]->attr) == V_PF ) { |
| MKRAT(nm,dn,0,r); |
MKV(vvect[i],p); |
| *rp = (Obj)r; |
for ( j = 0; j < nv; j++ ) |
| } |
if ( j != i ) { |
| return; |
substr(CO,0,(Obj)p,vvect[j],(Obj)svect[j],&b); p = (P)b; |
| default: |
} |
| error("substr2np: invalid argument"); |
if ( OID(svect[i]) == O_VOID ) svect[i] = p; |
| } |
else if ( arf_comp(CO,(Obj)p,(Obj)svect[i]) ) |
| |
error("substr2np : inconsistent values for substitution"); |
| |
} |
| |
} |
| |
switch ( OID(a) ) { |
| |
case O_P: |
| |
substpp(CO,(P)a,vvect,svect,nv,&nm); *rp = (Obj)nm; |
| |
return; |
| |
case O_R: |
| |
substpp(CO,(P)NM((R)a),vvect,svect,nv,&nm); |
| |
substpp(CO,(P)DN((R)a),vvect,svect,nv,&dn); |
| |
if ( !dn ) |
| |
error("substr2np: division by 0"); |
| |
else if ( !nm ) |
| |
*rp = 0; |
| |
else if ( NUM(dn) ) { |
| |
divsp(CO,nm,dn,&p); |
| |
*rp = (Obj)p; |
| |
} else { |
| |
MKRAT(nm,dn,0,r); |
| |
*rp = (Obj)r; |
| |
} |
| |
return; |
| |
default: |
| |
error("substr2np: invalid argument"); |
| |
} |
| } |
} |
| |
|
| void Psubst(arg,rp) |
void Psubst(arg,rp) |
|
|
| struct oNODE arg0; |
struct oNODE arg0; |
| MP m,mp,mp0; |
MP m,mp,mp0; |
| DP d; |
DP d; |
| |
VL lastvl,vl,tvl,prev,cur; |
| |
|
| if ( !arg ) { |
if ( !arg ) { |
| *rp = 0; return; |
*rp = 0; return; |
|
|
| *rp = 0; |
*rp = 0; |
| return; |
return; |
| } |
} |
| |
lastvl = LASTCO; |
| switch ( OID(a) ) { |
switch ( OID(a) ) { |
| case O_N: case O_P: case O_R: |
case O_N: case O_P: case O_R: |
| reductr(CO,(Obj)ARG0(arg),&a); |
reductr(CO,(Obj)ARG0(arg),&a); |
|
|
| break; |
break; |
| default: |
default: |
| error("subst : invalid argument"); |
error("subst : invalid argument"); |
| |
} |
| |
if ( lastvl != LASTCO ) { |
| |
get_vars_recursive(*rp,&vl); |
| |
prev = lastvl; cur = NEXT(prev); |
| |
while ( cur ) { |
| |
v = cur->v; |
| |
for ( tvl = vl; tvl && tvl->v != v; tvl = NEXT(tvl) ); |
| |
if ( !tvl ) NEXT(prev) = NEXT(cur); |
| |
else prev = cur; |
| |
cur = NEXT(cur); |
| |
} |
| |
update_LASTCO(); |
| } |
} |
| } |
} |
| |
|