version 1.18, 2003/01/16 00:33:27 |
version 1.26, 2017/02/28 07:06:28 |
|
|
* 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.25 2016/03/31 05:30:32 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 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 */ |