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(); |
} |
} |
} |
} |
|
|