version 1.4, 2017/08/31 02:36:20 |
version 1.5, 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/reduct.c,v 1.3 2000/08/22 05:03:59 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/reduct.c,v 1.4 2017/08/31 02:36:20 noro Exp $ |
*/ |
*/ |
#include "ca.h" |
#include "ca.h" |
#include "parse.h" |
#include "parse.h" |
|
|
void Pred(), Predc(), Pprim(); |
void Pred(), Predc(), Pprim(); |
|
|
struct ftab reduct_tab[] = { |
struct ftab reduct_tab[] = { |
{"red",Pred,1}, |
{"red",Pred,1}, |
{"redc",Predc,2}, |
{"redc",Predc,2}, |
{"prim",Pprim,-2}, |
{"prim",Pprim,-2}, |
{0,0,0}, |
{0,0,0}, |
}; |
}; |
|
|
void Pred(NODE arg,Obj *rp) |
void Pred(NODE arg,Obj *rp) |
{ |
{ |
Obj a,b,t; |
Obj a,b,t; |
LIST l; |
LIST l; |
V v; |
V v; |
int row,col,len; |
int row,col,len; |
VECT vect; |
VECT vect; |
MAT mat; |
MAT mat; |
int i,j; |
int i,j; |
NODE n0,n,nd; |
NODE n0,n,nd; |
struct oNODE arg0; |
struct oNODE arg0; |
MP m,mp,mp0; |
MP m,mp,mp0; |
DP d; |
DP d; |
|
|
a = (Obj)ARG0(arg); |
a = (Obj)ARG0(arg); |
if ( !a ) { |
if ( !a ) { |
*rp = 0; |
*rp = 0; |
return; |
return; |
} |
} |
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),rp); |
reductr(CO,(Obj)ARG0(arg),rp); |
break; |
break; |
case O_LIST: |
case O_LIST: |
n0 = 0; |
n0 = 0; |
for ( nd = BDY((LIST)a); nd; nd = NEXT(nd) ) { |
for ( nd = BDY((LIST)a); nd; nd = NEXT(nd) ) { |
NEXTNODE(n0,n); |
NEXTNODE(n0,n); |
arg0.body = (pointer)BDY(nd); |
arg0.body = (pointer)BDY(nd); |
arg0.next = 0; |
arg0.next = 0; |
Pred(&arg0,&b); |
Pred(&arg0,&b); |
BDY(n) = (pointer)b; |
BDY(n) = (pointer)b; |
} |
} |
if ( n0 ) |
if ( n0 ) |
NEXT(n) = 0; |
NEXT(n) = 0; |
MKLIST(l,n0); |
MKLIST(l,n0); |
*rp = (Obj)l; |
*rp = (Obj)l; |
break; |
break; |
case O_VECT: |
case O_VECT: |
len = ((VECT)a)->len; |
len = ((VECT)a)->len; |
MKVECT(vect,len); |
MKVECT(vect,len); |
for ( i = 0; i < len; i++ ) { |
for ( i = 0; i < len; i++ ) { |
arg0.body = (pointer)BDY((VECT)a)[i]; |
arg0.body = (pointer)BDY((VECT)a)[i]; |
arg0.next = 0; |
arg0.next = 0; |
Pred(&arg0,&b); |
Pred(&arg0,&b); |
BDY(vect)[i] = (pointer)b; |
BDY(vect)[i] = (pointer)b; |
} |
} |
*rp = (Obj)vect; |
*rp = (Obj)vect; |
break; |
break; |
case O_MAT: |
case O_MAT: |
row = ((MAT)a)->row; |
row = ((MAT)a)->row; |
col = ((MAT)a)->col; |
col = ((MAT)a)->col; |
MKMAT(mat,row,col); |
MKMAT(mat,row,col); |
for ( i = 0; i < row; i++ ) |
for ( i = 0; i < row; i++ ) |
for ( j = 0; j < col; j++ ) { |
for ( j = 0; j < col; j++ ) { |
arg0.body = (pointer)BDY((MAT)a)[i][j]; |
arg0.body = (pointer)BDY((MAT)a)[i][j]; |
arg0.next = 0; |
arg0.next = 0; |
Pred(&arg0,&b); |
Pred(&arg0,&b); |
BDY(mat)[i][j] = (pointer)b; |
BDY(mat)[i][j] = (pointer)b; |
} |
} |
*rp = (Obj)mat; |
*rp = (Obj)mat; |
break; |
break; |
case O_DP: |
case O_DP: |
mp0 = 0; |
mp0 = 0; |
for ( m = BDY((DP)a); m; m = NEXT(m) ) { |
for ( m = BDY((DP)a); m; m = NEXT(m) ) { |
arg0.body = (pointer)C(m); |
arg0.body = (pointer)C(m); |
arg0.next = 0; |
arg0.next = 0; |
Pred(&arg0,&b); |
Pred(&arg0,&b); |
if ( b ) { |
if ( b ) { |
NEXTMP(mp0,mp); |
NEXTMP(mp0,mp); |
C(mp) = b; |
C(mp) = b; |
mp->dl = m->dl; |
mp->dl = m->dl; |
} |
} |
} |
} |
if ( mp0 ) { |
if ( mp0 ) { |
MKDP(NV((DP)a),mp0,d); |
MKDP(NV((DP)a),mp0,d); |
d->sugar = ((DP)a)->sugar; |
d->sugar = ((DP)a)->sugar; |
*rp = (Obj)d; |
*rp = (Obj)d; |
} else |
} else |
*rp = 0; |
*rp = 0; |
|
|
break; |
break; |
default: |
default: |
error("red : invalid argument"); |
error("red : invalid argument"); |
} |
} |
} |
} |
|
|
void Predc(NODE arg,P *rp) |
void Predc(NODE arg,P *rp) |
{ |
{ |
asir_assert(ARG0(arg),O_P,"redc"); |
asir_assert(ARG0(arg),O_P,"redc"); |
asir_assert(ARG1(arg),O_P,"redc"); |
asir_assert(ARG1(arg),O_P,"redc"); |
remsdcp(CO,(P)ARG0(arg),(P)ARG1(arg),rp); |
remsdcp(CO,(P)ARG0(arg),(P)ARG1(arg),rp); |
} |
} |
|
|
void Pprim(NODE arg,P *rp) |
void Pprim(NODE arg,P *rp) |
{ |
{ |
P t,p,p1,r; |
P t,p,p1,r; |
V v; |
V v; |
VL vl; |
VL vl; |
|
|
asir_assert(ARG0(arg),O_P,"prim"); |
asir_assert(ARG0(arg),O_P,"prim"); |
p = (P)ARG0(arg); |
p = (P)ARG0(arg); |
if ( NUM(p) ) |
if ( NUM(p) ) |
*rp = (P)ONE; |
*rp = (P)ONE; |
else { |
else { |
if ( argc(arg) == 2 ) { |
if ( argc(arg) == 2 ) { |
v = VR((P)ARG1(arg)); |
v = VR((P)ARG1(arg)); |
change_mvar(CO,p,v,&p1); |
change_mvar(CO,p,v,&p1); |
if ( VR(p1) != v ) { |
if ( VR(p1) != v ) { |
*rp = (P)ONE; return; |
*rp = (P)ONE; return; |
} else { |
} else { |
reordvar(CO,v,&vl); pcp(vl,p1,&r,&t); |
reordvar(CO,v,&vl); pcp(vl,p1,&r,&t); |
restore_mvar(CO,r,v,rp); |
restore_mvar(CO,r,v,rp); |
} |
} |
} else |
} else |
pcp(CO,p,rp,&t); |
pcp(CO,p,rp,&t); |
} |
} |
} |
} |