version 1.2, 2001/03/08 07:49:11 |
version 1.5, 2001/10/09 01:36:04 |
|
|
|
/* $OpenXM: OpenXM_contrib2/asir2000/builtin/al.c,v 1.4 2001/03/09 01:14:13 noro Exp $ */ |
/* ---------------------------------------------------------------------- |
/* ---------------------------------------------------------------------- |
$Id$ |
$Id$ |
---------------------------------------------------------------------- |
---------------------------------------------------------------------- |
|
|
#include <parse.h> |
#include <parse.h> |
#include <al.h> |
#include <al.h> |
|
|
|
void Preverse(); |
void Phugo(); |
void Phugo(); |
void Pex(); |
void Pex(); |
void Pall(); |
void Pall(); |
|
|
void Pfopargs(); |
void Pfopargs(); |
void Pcompf(); |
void Pcompf(); |
void Patnum(); |
void Patnum(); |
|
int gauss_abc(); |
int compf(); |
int compf(); |
void Patl(); |
void Patl(); |
void Pqevar(); |
void Pqevar(); |
Line 37 void simpl_th2atl(); |
|
Line 40 void simpl_th2atl(); |
|
int simpl_gand_udnargls(); |
int simpl_gand_udnargls(); |
int simpl_gand_thupd(); |
int simpl_gand_thupd(); |
int simpl_gand_thprsism(); |
int simpl_gand_thprsism(); |
|
int simpl_gand_smtbdlhs(); |
|
int simpl_gand_smtbelhs(); |
void lbc(); |
void lbc(); |
void replaceq(); |
void replaceq(); |
void deleteq(); |
void deleteq(); |
Line 60 void qeblock_verbose0(); |
|
Line 65 void qeblock_verbose0(); |
|
int getmodulus(); |
int getmodulus(); |
int qevar(); |
int qevar(); |
int gausselim(); |
int gausselim(); |
|
int delv(); |
int translate(); |
int translate(); |
int translate_a(); |
int translate_a(); |
void translate_a1(); |
void translate_a1(); |
|
|
void getqcoeffs(); |
void getqcoeffs(); |
void mkdiscr(); |
void mkdiscr(); |
int al_reorder(); |
int al_reorder(); |
int indices(); |
void indices(); |
void mkeset(); |
void mkeset(); |
int selectside(); |
int selectside(); |
int cmp2n(); |
int cmp2n(); |
|
|
void gpp(); |
void gpp(); |
void esetp(); |
void esetp(); |
void nodep(); |
void nodep(); |
|
void gauss_mkeset1(); |
|
void gauss_mkeset2(); |
|
|
extern Verbose; |
extern Verbose; |
|
|
|
|
NODE th; |
NODE th; |
int n; |
int n; |
{ |
{ |
F h,hh; |
F h; |
oFOP op=FOP(f); |
oFOP op=FOP(f); |
|
|
if (AL_ATOMIC(op)) { |
if (AL_ATOMIC(op)) { |
Line 568 NODE th,*patl,*patlc; |
|
Line 576 NODE th,*patl,*patlc; |
|
int n; |
int n; |
{ |
{ |
NODE atl=NULL,atlc=NULL; |
NODE atl=NULL,atlc=NULL; |
LBF h; |
|
F at,negat; |
F at,negat; |
|
|
switch (gand) { |
switch (gand) { |
Line 1252 int *pleft,*pmodulus; |
|
Line 1259 int *pleft,*pmodulus; |
|
int i=0; |
int i=0; |
|
|
if (!Verbose) |
if (!Verbose) |
return; |
/* added by noro */ |
|
return 0; |
if (*pleft == 0) { |
if (*pleft == 0) { |
for (; cvl; cvl=NEXT(cvl)) |
for (; cvl; cvl=NEXT(cvl)) |
i++; |
i++; |
|
|
if (!w) |
if (!w) |
continue; |
continue; |
*px = v; |
*px = v; |
delvip(v,pvl); |
delv(v,*pvl,pvl); |
if (a) { |
if (a) { |
gauss_mkeset2(rlhs,a,b,c,peset); |
gauss_mkeset2(rlhs,a,b,c,peset); |
return 2; |
return 2; |
|
|
return (NZNUMBER(*pa) || NZNUMBER(*pb) || NZNUMBER(*pc)); |
return (NZNUMBER(*pa) || NZNUMBER(*pb) || NZNUMBER(*pc)); |
} |
} |
|
|
gauss_mkeset1(rlhs,b,peset) |
void gauss_mkeset1(rlhs,b,peset) |
P rlhs,b; |
P rlhs,b; |
NODE *peset; |
NODE *peset; |
{ |
{ |
|
|
MKNODE(*peset,hgp,NULL); |
MKNODE(*peset,hgp,NULL); |
} |
} |
|
|
gauss_mkeset2(rlhs,a,b,c,peset) |
void gauss_mkeset2(rlhs,a,b,c,peset) |
P rlhs,a,b,c; |
P rlhs,a,b,c; |
NODE *peset; |
NODE *peset; |
{ |
{ |
RE hre; |
|
F hf; |
|
GP hgp; |
GP hgp; |
P discr; |
NODE esetc=NULL; |
NODE esetc; |
|
|
|
*peset = NULL; |
*peset = NULL; |
if (!NUM(a)) { |
if (!NUM(a)) { |
|
|
BDY(esetc) = (pointer)hgp; |
BDY(esetc) = (pointer)hgp; |
} |
} |
|
|
int delvip(v,pvl) |
int delv(v,vl,pnvl) |
V v; |
V v; |
VL *pvl; |
VL vl,*pnvl; |
{ |
{ |
VL prev; |
VL nvl=NULL,nvlc; |
|
|
if (v == VR(*pvl)) { |
if (v == VR(vl)) { |
*pvl = NEXT(*pvl); |
*pnvl = NEXT(vl); |
return 1; |
return 1; |
} |
} |
for (prev=*pvl; NEXT(prev); prev=NEXT(prev)) |
for (; vl && (VR(vl) != v); vl=NEXT(vl)) { |
if (VR(NEXT(prev)) == v) { |
NEXTVL(nvl,nvlc); |
NEXT(prev) = NEXT(NEXT(prev)); |
VR(nvlc) = VR(vl); |
return 1; |
} |
} |
if (vl) { |
|
NEXT(nvlc) = NEXT(vl); |
|
*pnvl = nvl; |
|
return 1; |
|
} |
|
*pnvl = nvl; |
return 0; |
return 0; |
} |
} |
|
|
|
|
NODE trans[]; |
NODE trans[]; |
{ |
{ |
NODE sc,transc[8]; |
NODE sc,transc[8]; |
RE hre; |
|
GP hgp; |
|
int bt,w=0; |
int bt,w=0; |
P h; |
|
|
|
for (bt=BTMIN; bt<=BTMAX; bt++) |
for (bt=BTMIN; bt<=BTMAX; bt++) |
trans[bt] = NULL; |
trans[bt] = NULL; |
Line 1487 NODE trans[],transc[]; |
|
Line 1494 NODE trans[],transc[]; |
|
return 1; |
return 1; |
}; |
}; |
error("degree violation in translate_a"); |
error("degree violation in translate_a"); |
|
/* XXX : NOTREACHED */ |
|
return -1; |
} |
} |
|
|
void translate_a1(op,mp,trans,transc) |
void translate_a1(op,mp,trans,transc) |
|
|
P discr; |
P discr; |
RE hre; |
RE hre; |
F hf; |
F hf; |
NODE n=NULL,nc; |
NODE n=NULL,nc=NULL; |
|
|
mkdiscr(a,b,c,&discr); |
mkdiscr(a,b,c,&discr); |
MKRE(hre,mp,discr,rootno,itype); |
MKRE(hre,mp,discr,rootno,itype); |
|
|
return 0; |
return 0; |
} |
} |
|
|
int indices(op,s,pit,pbt) |
void indices(op,s,pit,pbt) |
oFOP op; |
oFOP op; |
int s,*pit,*pbt; |
int s,*pit,*pbt; |
{ |
{ |
Line 1662 void mkeset(trans,x,peset) |
|
Line 1671 void mkeset(trans,x,peset) |
|
NODE trans[],*peset; |
NODE trans[],*peset; |
V x; |
V x; |
{ |
{ |
NODE esetc; |
NODE esetc=NULL; |
P h; |
P h; |
RE hre; |
RE hre; |
GP hgp; |
GP hgp; |
|
|
V v; |
V v; |
GP gp; |
GP gp; |
{ |
{ |
NODE argl=NULL,arglc; |
NODE argl=NULL,arglc=NULL; |
|
|
NEXTNODE(argl,arglc); |
NEXTNODE(argl,arglc); |
BDY(arglc) = (pointer)GUARD(gp); |
BDY(arglc) = (pointer)GUARD(gp); |
|
|
RE re; |
RE re; |
{ |
{ |
VL no; |
VL no; |
P rlhs,prem,bdn,nlhs; |
P rlhs,prem,nlhs; |
Q dd,dndeg; |
Q dd,dndeg; |
|
|
reordvar(CO,v,&no); |
reordvar(CO,v,&no); |
|
|
F *pf; |
F *pf; |
{ |
{ |
F hf; |
F hf; |
NODE cj=NULL,cjc; |
NODE cj=NULL,cjc=NULL; |
P hp1,hp2; |
P hp1,hp2; |
|
|
NEXTNODE(cj,cjc); |
NEXTNODE(cj,cjc); |
|
|
F *pf; |
F *pf; |
{ |
{ |
F hf; |
F hf; |
NODE cj=NULL,cjc,dj=NULL,djc; |
NODE cj=NULL,cjc=NULL,dj=NULL,djc=NULL; |
P hp1,hp2; |
P hp1,hp2; |
|
|
NEXTNODE(dj,djc); |
NEXTNODE(dj,djc); |
|
|
F *pf; |
F *pf; |
{ |
{ |
F hf,hf0; |
F hf,hf0; |
NODE cj=NULL,cjc,d1=NULL,d1c,d2=NULL,d2c; |
NODE cj=NULL,cjc=NULL,d1=NULL,d1c=NULL,d2=NULL,d2c=NULL; |
P hp1,hp2; |
P hp1,hp2; |
|
|
NEXTNODE(d1,d1c); |
NEXTNODE(d1,d1c); |
Line 2027 P prem,*pa,*pb,*pc,*pld; |
|
Line 2036 P prem,*pa,*pb,*pc,*pld; |
|
Q fdeg; |
Q fdeg; |
RE re; |
RE re; |
{ |
{ |
P a,b,c,alpha,beta,h1,h2,h3; |
P a,b,c,alpha,beta,h1,h2; |
Q two; |
Q two; |
|
|
alpha = COEF(DC(prem)); |
alpha = COEF(DC(prem)); |
|
|
{ |
{ |
P an; |
P an; |
F h; |
F h; |
NODE c=NULL,cc,d=NULL,dc; |
NODE c=NULL,cc=NULL,d=NULL,dc=NULL; |
|
|
if (lhsdcp == 0) { |
if (lhsdcp == 0) { |
MKAF(*pnf,op,0); |
MKAF(*pnf,op,0); |
|
|
{ |
{ |
Q deg; |
Q deg; |
F h; |
F h; |
NODE c=NULL,cc,d=NULL,dc; |
NODE c=NULL,cc=NULL,d=NULL,dc=NULL; |
P df; |
P df; |
|
|
degp(v,lhs,°); |
degp(v,lhs,°); |
|
|
int neg,disj; |
int neg,disj; |
{ |
{ |
F h; |
F h; |
NODE sc,nargl=NULL,narglc; |
NODE sc,nargl=NULL,narglc=NULL; |
oFOP op=FOP(f); |
oFOP op=FOP(f); |
|
|
if (AL_ATOMIC(op) || AL_TVAL(op)) { |
if (AL_ATOMIC(op) || AL_TVAL(op)) { |