| version 1.18, 2003/01/16 00:33:27 |
version 1.27, 2017/09/06 06:25:26 |
|
|
| * 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/poly.c,v 1.17 2002/09/27 04:42:59 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/poly.c,v 1.26 2017/02/28 07:06:28 noro Exp $ |
| */ |
*/ |
| #include "ca.h" |
#include "ca.h" |
| #include "parse.h" |
#include "parse.h" |
|
|
| |
|
| void Pranp(); |
void Pranp(); |
| |
|
| |
void Pheadsgn(); |
| |
void Pmul_trunc(),Pquo_trunc(); |
| void Pumul(),Pumul_ff(),Pusquare(),Pusquare_ff(),Putmul(),Putmul_ff(); |
void Pumul(),Pumul_ff(),Pusquare(),Pusquare_ff(),Putmul(),Putmul_ff(); |
| void Pkmul(),Pksquare(),Pktmul(); |
void Pkmul(),Pksquare(),Pktmul(); |
| void Pord(), Pcoef0(), Pcoef(), Pdeg(), Pmindeg(), Psetmod(); |
void Pord(), Premove_vars(), Pcoef0(), Pcoef(), Pdeg(), Pmindeg(), Psetmod(); |
| void Pcoef_gf2n(); |
void Pcoef_gf2n(); |
| void getcoef(), getdeglist(), mergedeglist(), change_mvar(), restore_mvar(); |
void getcoef(), getdeglist(), mergedeglist(), change_mvar(), restore_mvar(); |
| |
|
| Line 111 void field_order_ff(N *); |
|
| Line 113 void field_order_ff(N *); |
|
| int current_ff; |
int current_ff; |
| |
|
| struct ftab poly_tab[] = { |
struct ftab poly_tab[] = { |
| |
{"headsgn",Pheadsgn,1}, |
| |
{"quo_trunc",Pquo_trunc,2}, |
| |
{"mul_trunc",Pmul_trunc,3}, |
| {"homogeneous_deg",Phomogeneous_deg,-2}, |
{"homogeneous_deg",Phomogeneous_deg,-2}, |
| {"homogeneous_part",Phomogeneous_part,-3}, |
{"homogeneous_part",Phomogeneous_part,-3}, |
| {"reorder",Preorder,3}, |
{"reorder",Preorder,3}, |
| Line 119 struct ftab poly_tab[] = { |
|
| Line 124 struct ftab poly_tab[] = { |
|
| {"p_mag",Pp_mag,1}, |
{"p_mag",Pp_mag,1}, |
| {"maxblen",Pmaxblen,1}, |
{"maxblen",Pmaxblen,1}, |
| {"ord",Pord,-1}, |
{"ord",Pord,-1}, |
| |
{"remove_vars",Premove_vars,1}, |
| |
{"delete_vars",Premove_vars,1}, |
| {"coef0",Pcoef0,-3}, |
{"coef0",Pcoef0,-3}, |
| {"coef",Pcoef,-3}, |
{"coef",Pcoef,-3}, |
| {"coef_gf2n",Pcoef_gf2n,2}, |
{"coef_gf2n",Pcoef_gf2n,2}, |
| Line 141 struct ftab poly_tab[] = { |
|
| Line 148 struct ftab poly_tab[] = { |
|
| {"ch_mv",Pch_mv,2}, |
{"ch_mv",Pch_mv,2}, |
| {"re_mv",Pre_mv,2}, |
{"re_mv",Pre_mv,2}, |
| |
|
| {"ptomp",Pptomp,2}, |
{"ptomp",Pptomp,-2}, |
| {"mptop",Pmptop,1}, |
{"mptop",Pmptop,1}, |
| |
|
| {"ptolmp",Pptolmp,1}, |
{"ptolmp",Pptolmp,1}, |
| Line 223 struct ftab poly_tab[] = { |
|
| Line 230 struct ftab poly_tab[] = { |
|
| {0,0,0}, |
{0,0,0}, |
| }; |
}; |
| |
|
| |
void Pheadsgn(NODE arg,Q *rp) |
| |
{ |
| |
int s; |
| |
|
| |
s = headsgn((P)ARG0(arg)); |
| |
STOQ(s,*rp); |
| |
} |
| |
|
| |
void Pmul_trunc(NODE arg,P *rp) |
| |
{ |
| |
P p1,p2,p,h; |
| |
VL vl0,vl1,vl2,tvl,vl; |
| |
VN vn; |
| |
int i,n; |
| |
|
| |
p1 = (P)ARG0(arg); |
| |
p2 = (P)ARG1(arg); |
| |
get_vars((Obj)p1,&vl1); get_vars((Obj)p2,&vl2); mergev(CO,vl1,vl2,&tvl); |
| |
p = (P)ARG2(arg); |
| |
get_vars((Obj)p,&vl0); mergev(CO,tvl,vl0,&vl); |
| |
for ( tvl = vl, n = 0; tvl; tvl = NEXT(tvl), n++ ); |
| |
vn = (VN) ALLOCA((n+1)*sizeof(struct oVN)); |
| |
for ( i = 0, tvl = vl; i < n; tvl = NEXT(tvl), i++ ) { |
| |
vn[i].v = tvl->v; |
| |
vn[i].n = 0; |
| |
} |
| |
vn[i].v = 0; |
| |
vn[i].n = 0; |
| |
for ( h = p, i = 0; OID(h) == O_P; h = COEF(DC(h)) ) { |
| |
for ( ; vn[i].v != VR(h); i++ ); |
| |
vn[i].n = QTOS(DEG(DC(h))); |
| |
} |
| |
mulp_trunc(vl,p1,p2,vn,rp); |
| |
} |
| |
|
| |
void Pquo_trunc(NODE arg,P *rp) |
| |
{ |
| |
P p1,p2,p,h; |
| |
VL vl0,vl1,vl2,tvl,vl; |
| |
VN vn; |
| |
int i,n; |
| |
|
| |
p1 = (P)ARG0(arg); |
| |
p2 = (P)ARG1(arg); |
| |
if ( !p1 ) |
| |
*rp = 0; |
| |
else if ( NUM(p2) ) |
| |
divsp(CO,p1,p2,rp); |
| |
else { |
| |
get_vars((Obj)p1,&vl1); get_vars((Obj)p2,&vl2); mergev(CO,vl1,vl2,&vl); |
| |
for ( tvl = vl, n = 0; tvl; tvl = NEXT(tvl), n++ ); |
| |
vn = (VN) ALLOCA((n+1)*sizeof(struct oVN)); |
| |
for ( i = 0, tvl = vl; i < n; tvl = NEXT(tvl), i++ ) { |
| |
vn[i].v = tvl->v; |
| |
vn[i].n = 0; |
| |
} |
| |
vn[i].v = 0; |
| |
vn[i].n = 0; |
| |
for ( h = p2, i = 0; OID(h) == O_P; h = COEF(DC(h)) ) { |
| |
for ( ; vn[i].v != VR(h); i++ ); |
| |
vn[i].n = QTOS(DEG(DC(h))); |
| |
} |
| |
quop_trunc(vl,p1,p2,vn,rp); |
| |
} |
| |
} |
| |
|
| void Phomogeneous_part(NODE arg,P *rp) |
void Phomogeneous_part(NODE arg,P *rp) |
| { |
{ |
| if ( argc(arg) == 2 ) |
if ( argc(arg) == 2 ) |
| Line 373 void Pp_mag(NODE arg,Q *rp) |
|
| Line 446 void Pp_mag(NODE arg,Q *rp) |
|
| |
|
| void Pord(NODE arg,LIST *listp) |
void Pord(NODE arg,LIST *listp) |
| { |
{ |
| NODE n,tn; |
NODE n,tn,p,opt; |
| |
char *key; |
| |
Obj value; |
| |
int overwrite=0; |
| LIST l; |
LIST l; |
| VL vl,tvl,svl; |
VL vl,tvl,svl; |
| P t; |
P t; |
| Line 381 void Pord(NODE arg,LIST *listp) |
|
| Line 457 void Pord(NODE arg,LIST *listp) |
|
| V *va; |
V *va; |
| V v; |
V v; |
| |
|
| |
if ( current_option ) { |
| |
for ( opt = current_option; opt; opt = NEXT(opt) ) { |
| |
p = BDY((LIST)BDY(opt)); |
| |
key = BDY((STRING)BDY(p)); |
| |
value = (Obj)BDY(NEXT(p)); |
| |
if ( !strcmp(key,"overwrite") && value ) { |
| |
overwrite = value ? 1 : 0; |
| |
break; |
| |
} |
| |
} |
| |
} |
| |
|
| if ( argc(arg) ) { |
if ( argc(arg) ) { |
| asir_assert(ARG0(arg),O_LIST,"ord"); |
asir_assert(ARG0(arg),O_LIST,"ord"); |
| for ( vl = 0, i = 0, n = BDY((LIST)ARG0(arg)); |
for ( vl = 0, i = 0, n = BDY((LIST)ARG0(arg)); |
| Line 394 void Pord(NODE arg,LIST *listp) |
|
| Line 482 void Pord(NODE arg,LIST *listp) |
|
| error("ord : invalid argument"); |
error("ord : invalid argument"); |
| VR(tvl) = VR(t); |
VR(tvl) = VR(t); |
| } |
} |
| va = (V *)ALLOCA(i*sizeof(V)); |
if ( !overwrite ) { |
| for ( j = 0, svl = vl; j < i; j++, svl = NEXT(svl) ) |
va = (V *)ALLOCA(i*sizeof(V)); |
| va[j] = VR(svl); |
for ( j = 0, svl = vl; j < i; j++, svl = NEXT(svl) ) |
| for ( svl = CO; svl; svl = NEXT(svl) ) { |
va[j] = VR(svl); |
| v = VR(svl); |
for ( svl = CO; svl; svl = NEXT(svl) ) { |
| for ( j = 0; j < i; j++ ) |
v = VR(svl); |
| if ( v == va[j] ) |
for ( j = 0; j < i; j++ ) |
| break; |
if ( v == va[j] ) |
| if ( j == i ) { |
break; |
| if ( !vl ) { |
if ( j == i ) { |
| NEWVL(vl); tvl = vl; |
if ( !vl ) { |
| } else { |
NEWVL(vl); tvl = vl; |
| NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
} else { |
| |
NEWVL(NEXT(tvl)); tvl = NEXT(tvl); |
| |
} |
| |
VR(tvl) = v; |
| } |
} |
| VR(tvl) = v; |
|
| } |
} |
| |
} else { |
| |
for ( svl = vl; svl; svl = NEXT(svl) ) { |
| |
if ( svl->v->attr == (pointer)V_PF ) |
| |
((PFINS)svl->v->priv)->pf->ins = 0; |
| |
} |
| } |
} |
| if ( vl ) |
if ( vl ) |
| NEXT(tvl) = 0; |
NEXT(tvl) = 0; |
| Line 421 void Pord(NODE arg,LIST *listp) |
|
| Line 516 void Pord(NODE arg,LIST *listp) |
|
| NEXT(tn) = 0; MKLIST(l,n); *listp = l; |
NEXT(tn) = 0; MKLIST(l,n); *listp = l; |
| } |
} |
| |
|
| |
void Premove_vars(NODE arg,LIST *listp) |
| |
{ |
| |
NODE l,nd,tnd; |
| |
V *v,*va; |
| |
int n,na,i,j; |
| |
VL vl,vl1; |
| |
P t; |
| |
LIST list; |
| |
|
| |
asir_assert(ARG0(arg),O_LIST,"remove_vars"); |
| |
l = BDY((LIST)ARG0(arg)); n = length(l); |
| |
v = (V *)ALLOCA(n*sizeof(V)); |
| |
for ( i = 0; i < n; i++, l = NEXT(l) ) |
| |
if ( !(t = (P)BDY(l)) || (OID(t) != O_P) ) |
| |
error("ord : invalid argument"); |
| |
else v[i] = VR(t); |
| |
|
| |
for ( na = 0, vl = CO; vl; vl = NEXT(vl), na++ ); |
| |
va = (V *)ALLOCA(na*sizeof(V)); |
| |
for ( i = 0, vl = CO; i < na; i++, vl = NEXT(vl) ) va[i] = VR(vl); |
| |
for ( i = 0; i < na; i++ ) |
| |
for ( j = 0; j < n; j++ ) if ( va[i] == v[j] ) va[i] = 0; |
| |
for ( vl = 0, i = na-1; i >= 0; i-- ) |
| |
if ( va[i] ) { |
| |
NEWVL(vl1); VR(vl1) = va[i]; NEXT(vl1) = vl; vl = vl1; |
| |
} |
| |
CO = vl; |
| |
for ( nd = 0, vl = CO; vl; vl = NEXT(vl) ) { |
| |
NEXTNODE(nd,tnd); MKV(VR(vl),t); BDY(tnd) = (pointer)t; |
| |
} |
| |
if ( nd ) NEXT(tnd) = 0; |
| |
MKLIST(list,nd); *listp = list; |
| |
} |
| |
|
| void Pcoef0(NODE arg,Obj *rp) |
void Pcoef0(NODE arg,Obj *rp) |
| { |
{ |
| Obj t,n; |
Obj t,n; |
| Line 697 void Psetmod_ff(NODE arg,Obj *rp) |
|
| Line 826 void Psetmod_ff(NODE arg,Obj *rp) |
|
| if ( ac == 1 ) { |
if ( ac == 1 ) { |
| mod = (Obj)ARG0(arg); |
mod = (Obj)ARG0(arg); |
| if ( !mod ) |
if ( !mod ) |
| error("setmod_ff : invalid argument"); |
current_ff = FF_NOT_SET; |
| switch ( OID(mod) ) { |
else { |
| |
switch ( OID(mod) ) { |
| case O_N: |
case O_N: |
| current_ff = FF_GFP; |
current_ff = FF_GFP; |
| setmod_lm(NM((Q)mod)); |
setmod_lm(NM((Q)mod)); |
| Line 708 void Psetmod_ff(NODE arg,Obj *rp) |
|
| Line 838 void Psetmod_ff(NODE arg,Obj *rp) |
|
| setmod_gf2n((P)mod); break; |
setmod_gf2n((P)mod); break; |
| default: |
default: |
| error("setmod_ff : invalid argument"); |
error("setmod_ff : invalid argument"); |
| } |
} |
| |
} |
| } else if ( ac == 2 ) { |
} else if ( ac == 2 ) { |
| if ( OID(ARG0(arg)) == O_N ) { |
if ( OID(ARG0(arg)) == O_N ) { |
| /* small finite field; primitive root representation */ |
/* small finite field; primitive root representation */ |
| Line 1008 void mergedeglist(NODE d0,NODE d1,NODE *dr) |
|
| Line 1139 void mergedeglist(NODE d0,NODE d1,NODE *dr) |
|
| |
|
| void Pptomp(NODE arg,P *rp) |
void Pptomp(NODE arg,P *rp) |
| { |
{ |
| ptomp(QTOS((Q)ARG1(arg)),(P)ARG0(arg),rp); |
int mod; |
| |
|
| |
if ( argc(arg) == 1 ) { |
| |
if ( !current_mod ) |
| |
error("ptomp : current_mod is not set"); |
| |
else |
| |
mod = current_mod; |
| |
} else |
| |
mod = QTOS((Q)ARG1(arg)); |
| |
ptomp(mod,(P)ARG0(arg),rp); |
| } |
} |
| |
|
| void Pmptop(NODE arg,P *rp) |
void Pmptop(NODE arg,P *rp) |