===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/dp.c,v
retrieving revision 1.30
retrieving revision 1.45
diff -u -p -r1.30 -r1.45
--- OpenXM_contrib2/asir2000/builtin/dp.c	2003/04/25 01:31:11	1.30
+++ OpenXM_contrib2/asir2000/builtin/dp.c	2003/12/25 08:46:19	1.45
@@ -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/dp.c,v 1.29 2003/04/21 02:49:40 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.44 2003/11/27 07:53:53 noro Exp $ 
 */
 #include "ca.h"
 #include "base.h"
@@ -58,6 +58,8 @@ extern struct order_spec dp_current_spec;
 
 int do_weyl;
 
+void Pdp_sort();
+void Pdp_mul_trunc(),Pdp_quo();
 void Pdp_ord(), Pdp_ptod(), Pdp_dtop();
 void Pdp_ptozp(), Pdp_ptozp2(), Pdp_red(), Pdp_red2(), Pdp_lcm(), Pdp_redble();
 void Pdp_sp(), Pdp_hm(), Pdp_ht(), Pdp_hc(), Pdp_rest(), Pdp_td(), Pdp_sugar();
@@ -88,6 +90,9 @@ void Pdp_weyl_set_weight();
 void Pdp_set_weight();
 void Pdp_nf_f(),Pdp_weyl_nf_f();
 void Pdp_lnf_f();
+void Pnd_gr(),Pnd_gr_trace(),Pnd_f4();
+void Pnd_weyl_gr(),Pnd_weyl_gr_trace();
+void Pnd_nf();
 
 LIST remove_zero_from_list(LIST);
 
@@ -100,6 +105,10 @@ struct ftab dp_tab[] = {
 	{"dp_cont",Pdp_cont,1},
 
 /* polynomial ring */
+	/* special operations */
+	{"dp_mul_trunc",Pdp_mul_trunc,3},
+	{"dp_quo",Pdp_quo,2},
+
 	/* s-poly */
 	{"dp_sp",Pdp_sp,2},
 	{"dp_sp_mod",Pdp_sp_mod,3},
@@ -124,6 +133,12 @@ struct ftab dp_tab[] = {
 	{"dp_gr_mod_main",Pdp_gr_mod_main,5},
 	{"dp_gr_f_main",Pdp_gr_f_main,4},
 	{"dp_gr_checklist",Pdp_gr_checklist,2},
+	{"nd_f4",Pnd_f4,4},
+	{"nd_gr",Pnd_gr,4},
+	{"nd_gr_trace",Pnd_gr_trace,5},
+	{"nd_weyl_gr",Pnd_weyl_gr,4},
+	{"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5},
+	{"nd_nf",Pnd_nf,5},
 
 	/* F4 algorithm */
 	{"dp_f4_main",Pdp_f4_main,3},
@@ -162,6 +177,7 @@ struct ftab dp_tab[] = {
 
 struct ftab dp_supp_tab[] = {
 	/* setting flags */
+	{"dp_sort",Pdp_sort,1},
 	{"dp_ord",Pdp_ord,-1},
 	{"dp_set_kara",Pdp_set_kara,-1},
 	{"dp_nelim",Pdp_nelim,-1},
@@ -210,6 +226,13 @@ struct ftab dp_supp_tab[] = {
 	{0,0,0}
 };
 
+void Pdp_sort(arg,rp)
+NODE arg;
+DP *rp;
+{
+	dp_sort((DP)ARG0(arg),rp);
+}
+
 void Pdp_mdtod(arg,rp)
 NODE arg;
 DP *rp;
@@ -824,6 +847,31 @@ DP *rp;
 	dp_subd(p1,p2,rp);
 }
 
+void Pdp_mul_trunc(arg,rp)
+NODE arg;
+DP *rp;
+{
+	DP p1,p2,p;
+
+	p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); p = (DP)ARG2(arg);
+	asir_assert(p1,O_DP,"dp_mul_trunc");
+	asir_assert(p2,O_DP,"dp_mul_trunc");
+	asir_assert(p,O_DP,"dp_mul_trunc");
+	comm_muld_trunc(CO,p1,p2,BDY(p)->dl,rp);
+}
+
+void Pdp_quo(arg,rp)
+NODE arg;
+DP *rp;
+{
+	DP p1,p2;
+
+	p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
+	asir_assert(p1,O_DP,"dp_quo");
+	asir_assert(p2,O_DP,"dp_quo");
+	comm_quod(CO,p1,p2,rp);
+}
+
 void Pdp_weyl_mul(arg,rp)
 NODE arg;
 DP *rp;
@@ -831,7 +879,7 @@ DP *rp;
 	DP p1,p2;
 
 	p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
-	asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_mul");
+	asir_assert(p1,O_DP,"dp_weyl_mul"); asir_assert(p2,O_DP,"dp_weyl_mul");
 	do_weyl = 1;
 	muld(CO,p1,p2,rp);
 	do_weyl = 0;
@@ -1268,9 +1316,12 @@ Q *rp;
 			case 1:
 				DP_Print = 1;
 				break;
-			case 2: default:
+			case 2:
 				DP_Print = 0; DP_PrintShort = 1;
 				break;
+			default:
+				DP_Print = s; DP_PrintShort = 0;
+				break;
 		}
 	} else {
 		if ( DP_Print )	{
@@ -1448,6 +1499,143 @@ LIST *rp;
 	dp_gr_mod_main(f,v,homo,m,&ord,rp);
 }
 
+void Pnd_f4(arg,rp)
+NODE arg;
+LIST *rp;
+{
+	LIST f,v;
+	int m,homo;
+	struct order_spec ord;
+
+	do_weyl = 0;
+	asir_assert(ARG0(arg),O_LIST,"nd_gr");
+	asir_assert(ARG1(arg),O_LIST,"nd_gr");
+	asir_assert(ARG2(arg),O_N,"nd_gr");
+	f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+	f = remove_zero_from_list(f);
+	if ( !BDY(f) ) {
+		*rp = f; return;
+	}
+	m = QTOS((Q)ARG2(arg));
+	create_order_spec(ARG3(arg),&ord);
+	nd_gr(f,v,m,1,&ord,rp);
+}
+
+void Pnd_gr(arg,rp)
+NODE arg;
+LIST *rp;
+{
+	LIST f,v;
+	int m,homo;
+	struct order_spec ord;
+
+	do_weyl = 0;
+	asir_assert(ARG0(arg),O_LIST,"nd_gr");
+	asir_assert(ARG1(arg),O_LIST,"nd_gr");
+	asir_assert(ARG2(arg),O_N,"nd_gr");
+	f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+	f = remove_zero_from_list(f);
+	if ( !BDY(f) ) {
+		*rp = f; return;
+	}
+	m = QTOS((Q)ARG2(arg));
+	create_order_spec(ARG3(arg),&ord);
+	nd_gr(f,v,m,0,&ord,rp);
+}
+
+void Pnd_gr_trace(arg,rp)
+NODE arg;
+LIST *rp;
+{
+	LIST f,v;
+	int m,homo;
+	struct order_spec ord;
+
+	do_weyl = 0;
+	asir_assert(ARG0(arg),O_LIST,"nd_gr_trace");
+	asir_assert(ARG1(arg),O_LIST,"nd_gr_trace");
+	asir_assert(ARG2(arg),O_N,"nd_gr_trace");
+	asir_assert(ARG3(arg),O_N,"nd_gr_trace");
+	f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+	f = remove_zero_from_list(f);
+	if ( !BDY(f) ) {
+		*rp = f; return;
+	}
+	homo = QTOS((Q)ARG2(arg));
+	m = QTOS((Q)ARG3(arg));
+	create_order_spec(ARG4(arg),&ord);
+	nd_gr_trace(f,v,m,homo,&ord,rp);
+}
+
+void Pnd_weyl_gr(arg,rp)
+NODE arg;
+LIST *rp;
+{
+	LIST f,v;
+	int m,homo;
+	struct order_spec ord;
+
+	do_weyl = 1;
+	asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr");
+	asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr");
+	asir_assert(ARG2(arg),O_N,"nd_weyl_gr");
+	f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+	f = remove_zero_from_list(f);
+	if ( !BDY(f) ) {
+		*rp = f; return;
+	}
+	m = QTOS((Q)ARG2(arg));
+	create_order_spec(ARG3(arg),&ord);
+	nd_gr(f,v,m,0,&ord,rp);
+}
+
+void Pnd_weyl_gr_trace(arg,rp)
+NODE arg;
+LIST *rp;
+{
+	LIST f,v;
+	int m,homo;
+	struct order_spec ord;
+
+	do_weyl = 1;
+	asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr_trace");
+	asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr_trace");
+	asir_assert(ARG2(arg),O_N,"nd_weyl_gr_trace");
+	asir_assert(ARG3(arg),O_N,"nd_weyl_gr_trace");
+	f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+	f = remove_zero_from_list(f);
+	if ( !BDY(f) ) {
+		*rp = f; return;
+	}
+	homo = QTOS((Q)ARG2(arg));
+	m = QTOS((Q)ARG3(arg));
+	create_order_spec(ARG4(arg),&ord);
+	nd_gr_trace(f,v,m,homo,&ord,rp);
+}
+
+void Pnd_nf(arg,rp)
+NODE arg;
+P *rp;
+{
+	P f;
+	LIST g,v;
+	struct order_spec ord;
+
+	do_weyl = 0;
+	asir_assert(ARG0(arg),O_P,"nd_nf");
+	asir_assert(ARG1(arg),O_LIST,"nd_nf");
+	asir_assert(ARG2(arg),O_LIST,"nd_nf");
+	asir_assert(ARG4(arg),O_N,"nd_nf");
+	f = (P)ARG0(arg);
+	g = (LIST)ARG1(arg); g = remove_zero_from_list(g);
+	if ( !BDY(g) ) {
+		*rp = f; return;
+	}
+	v = (LIST)ARG2(arg);
+	create_order_spec(ARG3(arg),&ord);
+	nd_nf_p(f,g,v,QTOS((Q)ARG4(arg)),&ord,rp);
+}
+
 /* for Weyl algebra */
 
 void Pdp_weyl_gr_main(arg,rp)
@@ -1587,6 +1775,7 @@ VECT *rp;
 {
 	VECT v;
 	int i,n;
+	NODE node;
 
 	if ( !arg )
 		*rp = current_dl_weight_vector_obj;
@@ -1595,8 +1784,17 @@ VECT *rp;
 		current_dl_weight_vector = 0;
 		*rp = 0;
 	} else {
-		asir_assert(ARG0(arg),O_VECT,"dp_set_weight");
-		v = (VECT)ARG0(arg);
+		if ( OID(ARG0(arg)) != O_VECT && OID(ARG0(arg)) != O_LIST )
+			error("dp_set_weight : invalid argument");
+		if ( OID(ARG0(arg)) == O_VECT )
+			v = (VECT)ARG0(arg);
+		else {
+			node = (NODE)BDY((LIST)ARG0(arg));
+			n = length(node);
+			MKVECT(v,n);
+			for ( i = 0; i < n; i++, node = NEXT(node) )
+				BDY(v)[i] = BDY(node);
+		}
 		current_dl_weight_vector_obj = v;
 		n = v->len;
 		current_dl_weight_vector = (int *)CALLOC(n,sizeof(int));