version 1.7, 2012/02/03 06:42:34 |
version 1.10, 2018/03/29 01:32:50 |
|
|
* 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/var.c,v 1.6 2006/08/09 10:08:46 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/var.c,v 1.9 2018/03/27 06:29:19 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
|
|
void Pvar(), Pvars(), Puc(), Pvars_recursive(),Psimple_is_eq(); |
void Pvar(), Pvars(), Puc(), Pvars_recursive(),Psimple_is_eq(); |
|
void Pdelete_uc(); |
|
|
struct ftab var_tab[] = { |
struct ftab var_tab[] = { |
{"var",Pvar,1}, |
{"var",Pvar,1}, |
{"vars",Pvars,1}, |
{"vars",Pvars,1}, |
{"vars_recursive",Pvars_recursive,1}, |
{"vars_recursive",Pvars_recursive,1}, |
{"uc",Puc,0}, |
{"uc",Puc,0}, |
{"simple_is_eq",Psimple_is_eq,2}, |
{"delete_uc",Pdelete_uc,-1}, |
{0,0,0}, |
{"simple_is_eq",Psimple_is_eq,2}, |
|
{0,0,0}, |
}; |
}; |
|
|
void Psimple_is_eq(NODE arg,Q *rp) |
void Psimple_is_eq(NODE arg,Q *rp) |
{ |
{ |
int ret; |
int ret; |
|
|
ret = is_eq(ARG0(arg),ARG1(arg)); |
ret = is_eq(ARG0(arg),ARG1(arg)); |
STOQ(ret,*rp); |
STOQ(ret,*rp); |
} |
} |
|
|
int is_eq(Obj a0,Obj a1) |
int is_eq(Obj a0,Obj a1) |
{ |
{ |
P p0,p1; |
P p0,p1; |
DCP dc0,dc1; |
DCP dc0,dc1; |
|
|
if ( !a0 ) return a1?0:1; |
if ( !a0 ) return a1?0:1; |
else if ( !a1 ) return 0; |
else if ( !a1 ) return 0; |
else if ( OID(a0) != OID(a1) ) return 0; |
else if ( OID(a0) != OID(a1) ) return 0; |
else { |
else { |
switch ( OID(a0) ) { |
switch ( OID(a0) ) { |
case O_P: |
case O_P: |
p0 = (P)a0; p1 = (P)a1; |
p0 = (P)a0; p1 = (P)a1; |
if ( VR(p0) == VR(p1) ) { |
if ( VR(p0) == VR(p1) ) { |
for ( dc0 = DC(p0), dc1 = DC(p1); dc0 && dc1; dc0 = NEXT(dc0), dc1 = NEXT(dc1) ) { |
for ( dc0 = DC(p0), dc1 = DC(p1); dc0 && dc1; dc0 = NEXT(dc0), dc1 = NEXT(dc1) ) { |
if ( cmpq(DEG(dc0),DEG(dc1)) ) return 0; |
if ( cmpq(DEG(dc0),DEG(dc1)) ) return 0; |
if ( !is_eq((Obj)COEF(dc0),(Obj)COEF(dc1)) ) return 0; |
if ( !is_eq((Obj)COEF(dc0),(Obj)COEF(dc1)) ) return 0; |
} |
} |
return (dc0||dc1)?0:1; |
return (dc0||dc1)?0:1; |
} else return 0; |
} else return 0; |
break; |
break; |
default: |
default: |
return !arf_comp(CO,a0,a1); |
return !arf_comp(CO,a0,a1); |
break; |
break; |
} |
} |
} |
} |
} |
} |
|
|
void Pvar(NODE arg,Obj *rp) |
void Pvar(NODE arg,Obj *rp) |
{ |
{ |
Obj t; |
Obj t; |
P p; |
P p; |
V vn,vd,v; |
V vn,vd,v; |
VL vl; |
VL vl; |
|
|
if ( !(t = (Obj)ARG0(arg)) ) |
if ( !(t = (Obj)ARG0(arg)) ) |
v = 0; |
v = 0; |
else |
else |
switch ( OID(t) ) { |
switch ( OID(t) ) { |
case O_P: |
case O_P: |
v = VR((P)t); break; |
v = VR((P)t); break; |
case O_R: |
case O_R: |
vn = VR(NM((R)t)); vd = VR(DN((R)t)); |
vn = VR(NM((R)t)); vd = VR(DN((R)t)); |
for ( vl = CO; (vl->v != vn) && (vl->v != vd); vl = NEXT(vl) ); |
for ( vl = CO; (vl->v != vn) && (vl->v != vd); vl = NEXT(vl) ); |
v = vl->v; break; |
v = vl->v; break; |
default: |
default: |
v = 0; break; |
v = 0; break; |
} |
} |
if ( v ) { |
if ( v ) { |
MKV(v,p); *rp = (Obj)p; |
MKV(v,p); *rp = (Obj)p; |
} else |
} else |
*rp = 0; |
*rp = 0; |
} |
} |
|
|
void Pvars(NODE arg,LIST *rp) |
void Pvars(NODE arg,LIST *rp) |
{ |
{ |
VL vl; |
VL vl; |
NODE n,n0; |
NODE n,n0; |
P p; |
P p; |
|
|
get_vars((Obj)ARG0(arg),&vl); |
get_vars((Obj)ARG0(arg),&vl); |
for ( n0 = 0; vl; vl = NEXT(vl) ) { |
for ( n0 = 0; vl; vl = NEXT(vl) ) { |
NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p; |
NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p; |
} |
} |
if ( n0 ) |
if ( n0 ) |
NEXT(n) = 0; |
NEXT(n) = 0; |
MKLIST(*rp,n0); |
MKLIST(*rp,n0); |
} |
} |
|
|
void Pvars_recursive(NODE arg,LIST *rp) |
void Pvars_recursive(NODE arg,LIST *rp) |
{ |
{ |
VL vl; |
VL vl; |
NODE n,n0; |
NODE n,n0; |
P p; |
P p; |
|
|
get_vars_recursive((Obj)ARG0(arg),&vl); |
get_vars_recursive((Obj)ARG0(arg),&vl); |
for ( n0 = 0; vl; vl = NEXT(vl) ) { |
for ( n0 = 0; vl; vl = NEXT(vl) ) { |
NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p; |
NEXTNODE(n0,n); MKV(vl->v,p); BDY(n) = (pointer)p; |
} |
} |
if ( n0 ) |
if ( n0 ) |
NEXT(n) = 0; |
NEXT(n) = 0; |
MKLIST(*rp,n0); |
MKLIST(*rp,n0); |
} |
} |
|
|
void get_vars_recursive(Obj obj,VL *vlp) |
void get_vars_recursive(Obj obj,VL *vlp) |
{ |
{ |
VL vl,vl0,vl1,vl2,t; |
VL vl,vl0,vl1,vl2,t; |
PFINS ins; |
PFINS ins; |
int argc,i; |
int argc,i; |
PFAD ad; |
PFAD ad; |
|
|
get_vars(obj,&vl); |
get_vars(obj,&vl); |
vl0 = 0; |
vl0 = 0; |
for ( t = vl; t; t = NEXT(t) ) |
for ( t = vl; t; t = NEXT(t) ) |
if ( t->v->attr == (pointer)V_PF ) { |
if ( t->v->attr == (pointer)V_PF ) { |
ins = (PFINS)t->v->priv; |
ins = (PFINS)t->v->priv; |
argc = ins->pf->argc; |
argc = ins->pf->argc; |
ad = ins->ad; |
ad = ins->ad; |
for ( i = 0; i < argc; i++ ) { |
for ( i = 0; i < argc; i++ ) { |
get_vars_recursive(ad[i].arg,&vl1); |
get_vars_recursive(ad[i].arg,&vl1); |
mergev(CO,vl0,vl1,&vl2); vl0 = vl2; |
mergev(CO,vl0,vl1,&vl2); vl0 = vl2; |
} |
} |
} |
} |
mergev(CO,vl,vl0,vlp); |
mergev(CO,vl,vl0,vlp); |
} |
} |
|
|
void get_vars(Obj t,VL *vlp) |
void get_vars(Obj t,VL *vlp) |
{ |
{ |
pointer *vb; |
pointer *vb; |
pointer **mb; |
pointer **mb; |
VL vl,vl1,vl2; |
VL vl,vl1,vl2; |
NODE n; |
NODE n; |
MP mp; |
MP mp; |
int i,j,row,col,len; |
int i,j,row,col,len; |
|
|
if ( !t ) |
if ( !t ) |
vl = 0; |
vl = 0; |
else |
else |
switch ( OID(t) ) { |
switch ( OID(t) ) { |
case O_P: case O_R: |
case O_P: case O_R: |
clctvr(CO,t,&vl); break; |
clctvr(CO,t,&vl); break; |
case O_VECT: |
case O_VECT: |
len = ((VECT)t)->len; vb = BDY((VECT)t); |
len = ((VECT)t)->len; vb = BDY((VECT)t); |
for ( i = 0, vl = 0; i < len; i++ ) { |
for ( i = 0, vl = 0; i < len; i++ ) { |
get_vars((Obj)vb[i],&vl1); mergev(CO,vl,vl1,&vl2); |
get_vars((Obj)vb[i],&vl1); mergev(CO,vl,vl1,&vl2); |
vl = vl2; |
vl = vl2; |
} |
} |
break; |
break; |
case O_MAT: |
case O_MAT: |
row = ((MAT)t)->row; col = ((MAT)t)->col; mb = BDY((MAT)t); |
row = ((MAT)t)->row; col = ((MAT)t)->col; mb = BDY((MAT)t); |
for ( i = 0, vl = 0; i < row; i++ ) |
for ( i = 0, vl = 0; i < row; i++ ) |
for ( j = 0; j < col; j++ ) { |
for ( j = 0; j < col; j++ ) { |
get_vars((Obj)mb[i][j],&vl1); mergev(CO,vl,vl1,&vl2); |
get_vars((Obj)mb[i][j],&vl1); mergev(CO,vl,vl1,&vl2); |
vl = vl2; |
vl = vl2; |
} |
} |
break; |
break; |
case O_LIST: |
case O_LIST: |
n = BDY((LIST)t); |
n = BDY((LIST)t); |
for ( vl = 0; n; n = NEXT(n) ) { |
for ( vl = 0; n; n = NEXT(n) ) { |
get_vars((Obj)BDY(n),&vl1); mergev(CO,vl,vl1,&vl2); |
get_vars((Obj)BDY(n),&vl1); mergev(CO,vl,vl1,&vl2); |
vl = vl2; |
vl = vl2; |
} |
} |
break; |
break; |
case O_DP: |
case O_DP: |
mp = ((DP)t)->body; |
mp = ((DP)t)->body; |
for ( vl = 0; mp; mp = NEXT(mp) ) { |
for ( vl = 0; mp; mp = NEXT(mp) ) { |
get_vars((Obj)mp->c,&vl1); mergev(CO,vl,vl1,&vl2); |
get_vars((Obj)mp->c,&vl1); mergev(CO,vl,vl1,&vl2); |
vl = vl2; |
vl = vl2; |
} |
} |
break; |
break; |
case O_NBP: |
case O_NBP: |
n = BDY((NBP)t); |
n = BDY((NBP)t); |
for ( vl = 0; n; n = NEXT(n) ) { |
for ( vl = 0; n; n = NEXT(n) ) { |
get_vars((Obj)(((NBM)BDY(n))->c),&vl1); |
get_vars((Obj)(((NBM)BDY(n))->c),&vl1); |
mergev(CO,vl,vl1,&vl2); |
mergev(CO,vl,vl1,&vl2); |
vl = vl2; |
vl = vl2; |
} |
} |
break; |
break; |
default: |
default: |
vl = 0; break; |
vl = 0; break; |
} |
} |
*vlp = vl; |
*vlp = vl; |
} |
} |
|
|
void Puc(Obj *p) |
void Puc(Obj *p) |
{ |
{ |
VL vl; |
VL vl; |
V v; |
V v; |
P t; |
P t; |
char buf[BUFSIZ]; |
char buf[BUFSIZ]; |
char *n,*nv; |
char *n,*nv; |
static int UCN; |
static int UCN; |
|
|
NEWV(v); v->attr = (pointer)V_UC; |
NEWV(v); v->attr = (pointer)V_UC; |
sprintf(buf,"_%d",UCN++); |
sprintf(buf,"_%d",UCN++); |
nv = NAME(v) = (char *)CALLOC(strlen(buf)+1,sizeof(char)); |
nv = NAME(v) = (char *)CALLOC(strlen(buf)+1,sizeof(char)); |
strcpy(NAME(v),buf); |
strcpy(NAME(v),buf); |
for ( vl = CO; vl; vl = NEXT(vl) ) |
for ( vl = CO; vl; vl = NEXT(vl) ) |
if ( (n=NAME(VR(vl))) && !strcmp(n,nv) ) break; |
if ( (n=NAME(VR(vl))) && !strcmp(n,nv) ) break; |
else if ( !NEXT(vl) ) { |
else if ( !NEXT(vl) ) { |
NEWVL(NEXT(vl)); VR(NEXT(vl)) = v; NEXT(NEXT(vl)) = 0; |
NEWVL(NEXT(vl)); VR(NEXT(vl)) = v; NEXT(NEXT(vl)) = 0; |
break; |
LASTCO = NEXT(vl); |
} |
break; |
MKV(v,t); *p = (Obj)t; |
} |
|
MKV(v,t); *p = (Obj)t; |
|
} |
|
|
|
void Pdelete_uc(NODE arg,Obj *p) |
|
{ |
|
VL vl,prev; |
|
V v; |
|
|
|
if ( argc(arg) == 1 ) { |
|
asir_assert(ARG0(arg),O_P,"delete_uc"); |
|
v = VR((P)ARG0(arg)); |
|
} else |
|
v = 0; |
|
|
|
for ( prev = 0, vl = CO; vl; vl = NEXT(vl) ) { |
|
if ( (!v || v == vl->v) && vl->v->attr == (pointer)V_UC ) { |
|
if ( prev == 0 ) |
|
CO = NEXT(vl); |
|
else |
|
NEXT(prev) = NEXT(vl); |
|
} else |
|
prev = vl; |
|
} |
|
update_LASTCO(); |
|
*p = 0; |
} |
} |