===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/gr.c,v
retrieving revision 1.51
retrieving revision 1.65
diff -u -p -r1.51 -r1.65
--- OpenXM_contrib2/asir2000/builtin/gr.c	2003/07/09 07:11:07	1.51
+++ OpenXM_contrib2/asir2000/builtin/gr.c	2009/02/09 10:21:29	1.65
@@ -45,7 +45,7 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.50 2003/07/01 08:12:38 noro Exp $
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.64 2007/09/19 05:56:01 noro Exp $
 */
 #include "ca.h"
 #include "parse.h"
@@ -69,7 +69,7 @@ double get_rtime();	
 
 struct oEGT eg_nf,eg_nfm;
 struct oEGT eg_znfm,eg_pz,eg_np,eg_ra,eg_mc,eg_gc;
-int TP,NBP,NMP,NFP,NDP,ZR,NZR;
+int TP,N_BP,NMP,NFP,NDP,ZR,NZR;
 
 extern int (*cmpdl)();
 extern int do_weyl;
@@ -95,21 +95,22 @@ int DP_NFStat = 0;
 LIST Dist = 0;
 int NoGCD = 0;
 int GenTrace = 0;
+int GenSyz = 0;
 int OXCheck = -1;
 
-static int NoSugar = 0;
+int NoSugar = 0;
 static int NoCriB = 0;
 static int NoGC = 0;
 static int NoMC = 0;
 static int NoRA = 0;
 static int ShowMag = 0;
 static int Stat = 0;
-static int Denominator = 1;
-static int Top = 0;
-static int Reverse = 0;
+int Denominator = 1;
+int Top = 0;
+int Reverse = 0;
 static int Max_mag = 0;
 static int Max_coef = 0;
-static char *Demand = 0;
+char *Demand = 0;
 static int PtozpRA = 0;
 
 int doing_f4;
@@ -298,12 +299,13 @@ void pdl(NODE f)
 void dp_gr_main(LIST f,LIST v,Num homo,int modular,int field,struct order_spec *ord,LIST *rp)
 {
 	int i,mindex,m,nochk;
-	struct order_spec ord1;
+	struct order_spec *ord1;
 	Q q;
 	VL fv,vv,vc;
 	NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
 	NODE ind,ind0;
 	LIST trace,gbindex;
+	int input_is_dp = 0;
 
 	mindex = 0; nochk = 0; dp_fcoeffs = field;
 	get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
@@ -316,14 +318,22 @@ void dp_gr_main(LIST f,LIST v,Num homo,int modular,int
 		homogenize_order(ord,NVars,&ord1);
 		for ( fd0 = fi0 = 0, t = BDY(f); t; t = NEXT(t) ) {
 			NEXTNODE(fd0,fd); NEXTNODE(fi0,fi);
-			ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fi)); dp_homo((DP)BDY(fi),(DP *)&BDY(fd));
+			if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+				dp_sort((DP)BDY(t),(DP *)&BDY(fi)); input_is_dp = 1;
+			} else 
+				ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fi));
+			dp_homo((DP)BDY(fi),(DP *)&BDY(fd));
 		}
 		if ( fd0 ) NEXT(fd) = 0;
 		if ( fi0 ) NEXT(fi) = 0;
-		initd(&ord1);
+		initd(ord1);
 	} else {
 		for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
-			NEXTNODE(fd0,fd); ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+			NEXTNODE(fd0,fd);
+			if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+				dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
+			} else
+				ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
 		}
 		if ( fd0 ) NEXT(fd) = 0;
 		fi0 = fd0;
@@ -340,7 +350,7 @@ void dp_gr_main(LIST f,LIST v,Num homo,int modular,int
 	init_stat();
 	while ( 1 ) {
 		if ( homo ) {
-			initd(&ord1); CNVars = NVars+1;
+			initd(ord1); CNVars = NVars+1;
 		}
 		if ( DP_Print && modular ) {
 			fprintf(asir_out,"mod= %d, eval = ",m); printsubst(subst);
@@ -371,7 +381,10 @@ void dp_gr_main(LIST f,LIST v,Num homo,int modular,int
 	}
 	for ( r0 = 0, ind0 = 0; x; x = NEXT(x) ) {
 		NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
-		dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+		if ( input_is_dp )
+			BDY(r) = (pointer)ps[(int)BDY(x)];
+		else
+			dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
 		NEXTNODE(ind0,ind);
 		STOQ((int)BDY(x),q); BDY(ind) = q;
 	}
@@ -395,13 +408,60 @@ void dp_gr_main(LIST f,LIST v,Num homo,int modular,int
 		fprintf(asir_out,"\nMax_mag=%d, Max_coef=%d\n",Max_mag, Max_coef);
 }
 
+void dp_interreduce(LIST f,LIST v,int field,struct order_spec *ord,LIST *rp)
+{
+	int i,mindex,m,nochk;
+	struct order_spec *ord1;
+	Q q;
+	VL fv,vv,vc;
+	NODE fd,fd0,fi,fi0,r,r0,t,subst,x,s,xx;
+	NODE ind,ind0;
+	LIST trace,gbindex;
+	int input_is_dp = 0;
+
+	mindex = 0; nochk = 0; dp_fcoeffs = field;
+	get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
+	NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
+	CNVars = NVars;
+	if ( ord->id && NVars != ord->nv )
+		error("dp_interreduce : invalid order specification");
+	initd(ord);
+	for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
+		NEXTNODE(fd0,fd);
+		if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+			dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
+		} else
+			ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+	}
+	if ( fd0 ) NEXT(fd) = 0;
+	fi0 = fd0;
+	setup_arrays(fd0,0,&s);
+	init_stat();
+	x = s;
+	reduceall(x,&xx); x = xx;
+	for ( r0 = 0, ind0 = 0; x; x = NEXT(x) ) {
+		NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
+		if ( input_is_dp )
+			BDY(r) = (pointer)ps[(int)BDY(x)];
+		else
+			dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+		NEXTNODE(ind0,ind);
+		STOQ((int)BDY(x),q); BDY(ind) = q;
+	}
+	if ( r0 ) NEXT(r) = 0;
+	if ( ind0 ) NEXT(ind) = 0;
+	MKLIST(*rp,r0);
+	MKLIST(gbindex,ind0);
+}
+
 void dp_gr_mod_main(LIST f,LIST v,Num homo,int m,struct order_spec *ord,LIST *rp)
 {
-	struct order_spec ord1;
+	struct order_spec *ord1;
 	VL fv,vv,vc;
 	NODE fd,fd0,r,r0,t,x,s,xx;
 	DP a,b,c;
-extern struct oEGT eg_red_mod;
+	extern struct oEGT eg_red_mod;
+	int input_is_dp = 0;
 
 	get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
 	NVars = length((NODE)vv); PCoeffs = vc ? 1 : 0; VC = vc;
@@ -411,7 +471,11 @@ extern struct oEGT eg_red_mod;
 	initd(ord);
 	if ( homo ) {
 		for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
-			ptod(CO,vv,(P)BDY(t),&a); dp_homo(a,&b);
+			if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+				dp_sort((DP)BDY(t),&a); input_is_dp = 1;
+			} else 
+				ptod(CO,vv,(P)BDY(t),&a);
+			dp_homo(a,&b);
 			if ( PCoeffs )
 				dp_mod(b,m,0,&c);
 			else
@@ -420,10 +484,13 @@ extern struct oEGT eg_red_mod;
 				NEXTNODE(fd0,fd); BDY(fd) = (pointer)c;
 			}
 		}
-		homogenize_order(ord,NVars,&ord1); initd(&ord1);
+		homogenize_order(ord,NVars,&ord1); initd(ord1);
 	} else {
 		for ( fd0 = 0, t = BDY(f); t; t = NEXT(t) ) {
-			ptod(CO,vv,(P)BDY(t),&b);
+			if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+				dp_sort((DP)BDY(t),&b); input_is_dp = 1;
+			} else 
+				ptod(CO,vv,(P)BDY(t),&b);
 			if ( PCoeffs )
 				dp_mod(b,m,0,&c);
 			else
@@ -437,7 +504,7 @@ extern struct oEGT eg_red_mod;
 	setup_arrays(fd0,m,&s);
 	init_stat();
 	if ( homo ) {
-		initd(&ord1); CNVars = NVars+1;
+		initd(ord1); CNVars = NVars+1;
 	}
 /* init_eg(&eg_red_mod); */
 	x = gb_mod(s,m);
@@ -449,11 +516,19 @@ extern struct oEGT eg_red_mod;
 	reduceall_mod(x,m,&xx); x = xx;
 	if ( PCoeffs )
 		for ( r0 = 0; x; x = NEXT(x) ) {
-			NEXTNODE(r0,r); mdtop(CO,m,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+			NEXTNODE(r0,r); 
+			if ( input_is_dp )
+				mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
+			else
+				mdtop(CO,m,vv,ps[(int)BDY(x)],(P *)&BDY(r));
 		}
 	else
 		for ( r0 = 0; x; x = NEXT(x) ) {
-			NEXTNODE(r0,r); _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+			NEXTNODE(r0,r); 
+			if ( input_is_dp )
+				_mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
+			else
+				_dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
 		}
 	print_stat();
 	if ( r0 ) NEXT(r) = 0;
@@ -465,6 +540,7 @@ void dp_f4_main(LIST f,LIST v,struct order_spec *ord,L
 	int homogen;
 	VL fv,vv,vc;
 	NODE fd,fd0,r,r0,t,x,s,xx;
+	int input_is_dp = 0;
 
 	dp_fcoeffs = 0;
 	get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
@@ -474,7 +550,11 @@ void dp_f4_main(LIST f,LIST v,struct order_spec *ord,L
 		error("dp_f4_main : invalid order specification");
 	initd(ord);
 	for ( fd0 = 0, t = BDY(f), homogen = 1; t; t = NEXT(t) ) {
-		NEXTNODE(fd0,fd); ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
+		NEXTNODE(fd0,fd); 
+		if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+			dp_sort((DP)BDY(t),(DP *)&BDY(fd)); input_is_dp = 1;
+		} else 
+			ptod(CO,vv,(P)BDY(t),(DP *)&BDY(fd));
 		if ( homogen )
 			homogen = dp_homogeneous(BDY(fd));
 	}
@@ -486,7 +566,10 @@ void dp_f4_main(LIST f,LIST v,struct order_spec *ord,L
 	}
 	for ( r0 = 0; x; x = NEXT(x) ) {
 		NEXTNODE(r0,r); dp_load((int)BDY(x),&ps[(int)BDY(x)]);
-		dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+		if ( input_is_dp )
+			BDY(r) = (pointer)ps[(int)BDY(x)];
+		else
+			dtop(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
 	}
 	if ( r0 ) NEXT(r) = 0;
 	MKLIST(*rp,r0);
@@ -498,6 +581,7 @@ void dp_f4_mod_main(LIST f,LIST v,int m,struct order_s
 	VL fv,vv,vc;
 	DP b,c,c1;
 	NODE fd,fd0,r,r0,t,x,s,xx;
+	int input_is_dp = 0;
 
 	dp_fcoeffs = 0;
 	get_vars((Obj)f,&fv); pltovl(v,&vv); vlminus(fv,vv,&vc);
@@ -507,7 +591,10 @@ void dp_f4_mod_main(LIST f,LIST v,int m,struct order_s
 		error("dp_f4_mod_main : invalid order specification");
 	initd(ord);
 	for ( fd0 = 0, t = BDY(f), homogen = 1; t; t = NEXT(t) ) {
-		ptod(CO,vv,(P)BDY(t),&b);
+		if ( BDY(t) && OID(BDY(t)) == O_DP ) {
+			dp_sort((DP)BDY(t),&b); input_is_dp = 1;
+		} else 
+			ptod(CO,vv,(P)BDY(t),&b);
 		if ( homogen )
 			homogen = dp_homogeneous(b);
 		_dp_mod(b,m,0,&c);
@@ -527,7 +614,11 @@ void dp_f4_mod_main(LIST f,LIST v,int m,struct order_s
 		reduceall_mod(x,m,&xx); x = xx;
 	}
 	for ( r0 = 0; x; x = NEXT(x) ) {
-		NEXTNODE(r0,r); _dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
+		NEXTNODE(r0,r);
+		if ( input_is_dp )
+			_mdtodp(ps[(int)BDY(x)],(DP *)&BDY(r));
+		else
+			_dtop_mod(CO,vv,ps[(int)BDY(x)],(P *)&BDY(r));
 	}
 	if ( r0 ) NEXT(r) = 0;
 	MKLIST(*rp,r0);
@@ -1095,6 +1186,20 @@ void pltovl(LIST l,VL *vl)
 	*vl = r0;
 }
 
+void vltopl(VL vl,LIST *l)
+{
+	VL n;
+	NODE r,r0;
+	P p;
+
+	n = vl;
+	for ( r0 = 0; n; n = NEXT(n) ) {
+		NEXTNODE(r0,r); MKV(n->v,p); BDY(r) = (pointer)p;
+	}
+	if ( r0 ) NEXT(r) = 0;
+	MKLIST(*l,r0);
+}
+
 void makesubst(VL v,NODE *s)
 {
 	NODE r,r0;
@@ -1325,9 +1430,10 @@ void reduceall(NODE in,NODE *h)
 	w = (int *)ALLOCA(n*sizeof(int));
 	for ( i = 0, t = r; i < n; i++, t = NEXT(t) )
 		w[i] = (int)BDY(t);
+	/* w[i] < 0 : reduced to 0 */
 	for ( i = 0; i < n; i++ ) {
 		for ( top = 0, j = n-1; j >= 0; j-- )
-			if ( j != i ) {
+			if ( w[j] >= 0 && j != i ) {
 				MKNODE(t,(pointer)w[j],top); top = t;
 			}
 		get_eg(&tmp0);
@@ -1349,10 +1455,16 @@ void reduceall(NODE in,NODE *h)
 		if ( DP_Print || DP_PrintShort ) {
 			fprintf(asir_out,"."); fflush(asir_out);
 		}
-		w[i] = newps(g1,0,(NODE)0);
+		if ( g1 ) {
+			w[i] = newps(g1,0,(NODE)0);
+		} else {
+			w[i] = -1;
+		}
 	}
 	for ( top = 0, j = n-1; j >= 0; j-- ) {
-		MKNODE(t,(pointer)w[j],top); top = t;
+		if ( w[j] >= 0 ) {
+			MKNODE(t,(pointer)w[j],top); top = t;
+		}
 	}
 	*h = top;
 	if ( DP_Print || DP_PrintShort )
@@ -1378,9 +1490,10 @@ void reduceall_mod(NODE in,int m,NODE *h)
 	w = (int *)ALLOCA(n*sizeof(int));
 	for ( i = 0, t = r; i < n; i++, t = NEXT(t) )
 		w[i] = (int)BDY(t);
+	/* w[i] < 0 : reduced to 0 */
 	for ( i = 0; i < n; i++ ) {
 		for ( top = 0, j = n-1; j >= 0; j-- )
-			if ( j != i ) {
+			if ( w[j] >= 0 && j != i ) {
 				MKNODE(t,(pointer)w[j],top); top = t;
 			}
 		get_eg(&tmp0);
@@ -1394,10 +1507,16 @@ void reduceall_mod(NODE in,int m,NODE *h)
 		if ( DP_Print || DP_PrintShort ) {
 			fprintf(asir_out,"."); fflush(asir_out);
 		}
-		w[i] = newps_mod(g,m);
+		if ( g ) {
+			w[i] = newps_mod(g,m);
+		} else {
+			w[i] = -1;
+		}
 	}
 	for ( top = 0, j = n-1; j >= 0; j-- ) {
-		MKNODE(t,(pointer)w[j],top); top = t;
+		if ( w[j] >= 0 ) {
+			MKNODE(t,(pointer)w[j],top); top = t;
+		}
 	}
 	*h = top;
 	if ( DP_Print || DP_PrintShort )
@@ -1628,6 +1747,7 @@ NODE gb(NODE f,int m,NODE subst)
 	Max_coef = 0;
 	prev = 1;
 	doing_f4 = 0;
+	init_denomlist();
 	if ( m ) {
 		psm = (DP *)MALLOC(pslen*sizeof(DP));
 		for ( i = 0; i < psn; i++ )
@@ -1688,6 +1808,7 @@ skip_nf:
 			get_eg(&tpz0);
 			prim_part(nf,0,&h);
 			get_eg(&tpz1); add_eg(&eg_pz,&tpz0,&tpz1);
+			add_denomlist(BDY(h)->c);
 			get_eg(&tnp0);
 			if ( Demand && skip_nf_flag )
 				nh = newps_nosave(h,m,subst);
@@ -1812,7 +1933,7 @@ DP_pairs updpairs( DP_pairs d, NODE /* of index */ g, 
 	if ( !NoCriB && d ) {
 		dl = DPPlength(d);
 		d = criterion_B( d, t );
-		dl -= DPPlength(d); NBP += dl;
+		dl -= DPPlength(d); N_BP += dl;
 	}
 	d1 = newpairs( g, t );
 	if ( NEXT(d1) ) {
@@ -1974,7 +2095,7 @@ DP_pairs criterion_F( DP_pairs d1 )
 	for ( head = last = 0, p = d1; NEXT(p); ) {
 		s = (r = w = collect_pairs_of_hdlcm( p, &rest ))->sugar;
 		while ( w = NEXT(w) )
-			if ( criterion_2( w->dp1, w->dp2 ) ) {
+			if ( !do_weyl && criterion_2( w->dp1, w->dp2 ) ) {
 				r = w;
 				break;
 			} else if ( w->sugar < s ) s = (r = w)->sugar;
@@ -2200,6 +2321,8 @@ void dp_set_flag(Obj name,Obj value)
 		GenTrace = v;
 	else if ( !strcmp(n,"OXCheck") )
 		OXCheck = v;
+	else if ( !strcmp(n,"GenSyz") )
+		GenSyz = v;
 }
 
 void dp_make_flaglist(LIST *list)
@@ -2226,6 +2349,7 @@ void dp_make_flaglist(LIST *list)
 	STOQ(DP_NFStat,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"NFStat"); MKNODE(n1,name,n); n = n1;
 	STOQ(OXCheck,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"OXCheck"); MKNODE(n1,name,n); n = n1;
 	STOQ(GenTrace,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"GenTrace"); MKNODE(n1,name,n); n = n1;
+	STOQ(GenSyz,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"GenSyz"); MKNODE(n1,name,n); n = n1;
 	STOQ(PtozpRA,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"PtozpRA"); MKNODE(n1,name,n); n = n1;
 	STOQ(ShowMag,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"ShowMag"); MKNODE(n1,name,n); n = n1;
 	STOQ(Top,v); MKNODE(n1,v,n); n = n1; MKSTR(name,"Top"); MKNODE(n1,name,n); n = n1;
@@ -2299,7 +2423,7 @@ void init_stat() {
 	init_eg(&eg_nf); init_eg(&eg_nfm); init_eg(&eg_znfm);
 	init_eg(&eg_pz); init_eg(&eg_np);
 	init_eg(&eg_ra); init_eg(&eg_mc); init_eg(&eg_gc);
-	ZR = NZR = TP = NMP = NBP = NFP = NDP = 0;
+	ZR = NZR = TP = NMP = N_BP = NFP = NDP = 0;
 }
 
 void print_stat() {
@@ -2308,7 +2432,7 @@ void print_stat() {
 	print_eg("NF",&eg_nf); print_eg("NFM",&eg_nfm); print_eg("ZNFM",&eg_znfm);
 	print_eg("PZ",&eg_pz); print_eg("NP",&eg_np);
 	print_eg("RA",&eg_ra); print_eg("MC",&eg_mc); print_eg("GC",&eg_gc);
-	fprintf(asir_out,"T=%d,B=%d M=%d F=%d D=%d ZR=%d NZR=%d\n",TP,NBP,NMP,NFP,NDP,ZR,NZR);
+	fprintf(asir_out,"T=%d,B=%d M=%d F=%d D=%d ZR=%d NZR=%d\n",TP,N_BP,NMP,NFP,NDP,ZR,NZR);
 }
 
 /*