===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/dp.c,v
retrieving revision 1.52
retrieving revision 1.60
diff -u -p -r1.52 -r1.60
--- OpenXM_contrib2/asir2000/builtin/dp.c	2004/05/14 06:02:54	1.52
+++ OpenXM_contrib2/asir2000/builtin/dp.c	2005/08/25 18:59:11	1.60
@@ -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.51 2004/04/30 08:25:38 noro Exp $ 
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.59 2005/08/24 06:28:39 noro Exp $ 
 */
 #include "ca.h"
 #include "base.h"
@@ -93,6 +93,7 @@ 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_gr_postproc();
 void Pnd_weyl_gr(),Pnd_weyl_gr_trace();
 void Pnd_nf();
 void Pdp_initial_term();
@@ -145,6 +146,7 @@ struct ftab dp_tab[] = {
 	{"nd_f4",Pnd_f4,4},
 	{"nd_gr",Pnd_gr,4},
 	{"nd_gr_trace",Pnd_gr_trace,5},
+	{"nd_gr_postproc",Pnd_gr_postproc,5},
 	{"nd_weyl_gr",Pnd_weyl_gr,4},
 	{"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5},
 	{"nd_nf",Pnd_nf,5},
@@ -195,7 +197,7 @@ struct ftab dp_supp_tab[] = {
 	{"dp_gr_print",Pdp_gr_print,-1},
 
 	/* converters */
-	{"dp_ptod",Pdp_ptod,2},
+	{"dp_ptod",Pdp_ptod,-2},
 	{"dp_dtop",Pdp_dtop,2},
 	{"dp_homo",Pdp_homo,1},
 	{"dp_dehomo",Pdp_dehomo,1},
@@ -205,7 +207,7 @@ struct ftab dp_supp_tab[] = {
 	{"dp_mdtod",Pdp_mdtod,1},
 	{"dp_mod",Pdp_mod,3},
 	{"dp_rat",Pdp_rat,1},
-	{"dp_ltod",Pdp_ltod,2},
+	{"dp_ltod",Pdp_ltod,-2},
 
 	/* criteria */
 	{"dp_cri1",Pdp_cri1,2},
@@ -439,11 +441,11 @@ Obj *rp;
 	int modular;
 	
 	f.id = O_LIST; f.body = 0;
-	if ( !arg )
+	if ( !arg && !current_option )
 		*rp = dp_current_spec->obj;
 	else {
-		if ( ARG0(arg) && OID(ARG0(arg)) == O_OPTLIST )
-			parse_gr_option(&f,BDY((OPTLIST)ARG0(arg)),&v,&homo,&modular,&spec);
+		if ( current_option )
+			parse_gr_option(&f,current_option,&v,&homo,&modular,&spec);
 		else if ( !create_order_spec(0,(Obj)ARG0(arg),&spec) )
 			error("dp_ord : invalid order specification");
 		initd(spec); *rp = spec->obj;
@@ -454,12 +456,31 @@ void Pdp_ptod(arg,rp)
 NODE arg;
 DP *rp;
 {
+	P p;
 	NODE n;
 	VL vl,tvl;
+	struct oLIST f;
+	int ac;
+	LIST v;
+	Num homo;
+	int modular;
+	struct order_spec *ord;
 
 	asir_assert(ARG0(arg),O_P,"dp_ptod");
-	asir_assert(ARG1(arg),O_LIST,"dp_ptod");
-	for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
+	p = (P)ARG0(arg);
+	ac = argc(arg);
+	if ( ac == 1 ) {
+		if ( current_option ) {
+			f.id = O_LIST; f.body = mknode(1,p);
+			parse_gr_option(&f,current_option,&v,&homo,&modular,&ord);
+			initd(ord);
+		} else
+			error("dp_ptod : invalid argument");
+	} else {
+		asir_assert(ARG1(arg),O_LIST,"dp_ptod");
+		v = (LIST)ARG1(arg);
+	}
+	for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
 		if ( !vl ) {
 			NEWVL(vl); tvl = vl;
 		} else {
@@ -469,7 +490,7 @@ DP *rp;
 	}
 	if ( vl )
 		NEXT(tvl) = 0;
-	ptod(CO,vl,(P)ARG0(arg),rp);
+	ptod(CO,vl,p,rp);
 }
 
 void Pdp_ltod(arg,rp)
@@ -478,14 +499,27 @@ DPV *rp;
 {
 	NODE n;
 	VL vl,tvl;
-	int sugar,i,len;
+	LIST f,v;
+	int sugar,i,len,ac,modular;
+	Num homo;
+	struct order_spec *ord;
 	DP *e;
 	NODE nd,t;
 
+	ac = argc(arg);
 	asir_assert(ARG0(arg),O_LIST,"dp_ptod");
-	nd = BDY((LIST)ARG0(arg));
-	asir_assert(ARG1(arg),O_LIST,"dp_ptod");
-	for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
+	f = (LIST)ARG0(arg);
+	if ( ac == 1 ) {
+		if ( current_option ) {
+			parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
+			initd(ord);
+		} else
+			error("dp_ltod : invalid argument");
+	} else {
+		asir_assert(ARG1(arg),O_LIST,"dp_ptod");
+		v = (LIST)ARG1(arg);
+	}
+	for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
 		if ( !vl ) {
 			NEWVL(vl); tvl = vl;
 		} else {
@@ -495,6 +529,8 @@ DPV *rp;
 	}
 	if ( vl )
 		NEXT(tvl) = 0;
+
+	nd = BDY(f);
 	len = length(nd);
 	e = (DP *)MALLOC(len*sizeof(DP));
 	sugar = 0;
@@ -532,10 +568,42 @@ extern LIST Dist;
 
 void Pdp_ptozp(arg,rp)
 NODE arg;
-DP *rp;
+Obj *rp;
 {
+	Q t;
+    NODE tt,p;
+    NODE n,n0;
+    char *key;
+	DP pp;
+	LIST list;
+    int get_factor=0;
+
 	asir_assert(ARG0(arg),O_DP,"dp_ptozp");
-	dp_ptozp((DP)ARG0(arg),rp);
+
+    /* analyze the option */
+    if ( current_option ) {
+      for ( tt = current_option; tt; tt = NEXT(tt) ) {
+        p = BDY((LIST)BDY(tt));
+        key = BDY((STRING)BDY(p));
+        /*  value = (Obj)BDY(NEXT(p)); */
+        if ( !strcmp(key,"factor") )  get_factor=1;
+        else {
+          error("ptozp: unknown option.");
+        }
+      }
+    }
+
+	dp_ptozp3((DP)ARG0(arg),&t,&pp);
+
+    /* printexpr(NULL,t); */
+	/* if the option factor is given, then it returns the answer
+       in the format [zpoly, num] where num*zpoly is equal to the argument.*/
+    if (get_factor) {
+	  n0 = mknode(2,pp,t);
+      MKLIST(list,n0);
+	  *rp = (Obj)list;
+    } else
+      *rp = (Obj)pp;
 }
 	
 void Pdp_ptozp2(arg,rp)
@@ -1142,9 +1210,10 @@ Obj *rp;
 		n = mknode(1,f); MKLIST(l,n); f = l;
 		is_list = 0;
 	}
-	if ( argc(arg) == 2 && OID(ARG1(arg)) == O_OPTLIST )
-		parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&ord);
-	else
+	if ( current_option ) {
+		parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
+		initd(ord);
+	} else
 		ord = dp_current_spec;
 	initiallist = dp_initial_term(f,ord);		
 	if ( !is_list )
@@ -1170,9 +1239,10 @@ Obj *rp;
 		n = mknode(1,f); MKLIST(l,n); f = l;
 		is_list = 0;
 	}
-	if ( argc(arg) == 2 && OID(ARG1(arg)) == O_OPTLIST )
-		parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&ord);
-	else
+	if ( current_option ) {
+		parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
+		initd(ord);
+	} else
 		ord = dp_current_spec;
 	ordlist = dp_order(f,ord);		
 	if ( !is_list )
@@ -1562,7 +1632,7 @@ LIST *rp;
 	if ( !BDY(f) ) {
 		*rp = f; return;
 	}
-	if ( argc(arg) == 5 ) {
+	if ( (ac = argc(arg)) == 5 ) {
 		asir_assert(ARG1(arg),O_LIST,"dp_gr_main");
 		asir_assert(ARG2(arg),O_N,"dp_gr_main");
 		asir_assert(ARG3(arg),O_N,"dp_gr_main");
@@ -1576,8 +1646,8 @@ LIST *rp;
 		else
 			modular = QTOS(m);
 		create_order_spec(0,ARG4(arg),&ord);
-	} else if ( (ac=argc(arg)) == 2 && OID(ARG1(arg)) == O_OPTLIST )
-		parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&ord);
+	} else if ( current_option )
+		parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
 	else if ( ac == 1 )
 		parse_gr_option(f,0,&v,&homo,&modular,&ord);
 	else
@@ -1762,6 +1832,29 @@ LIST *rp;
 	nd_gr(f,v,m,0,ord,rp);
 }
 
+void Pnd_gr_postproc(arg,rp)
+NODE arg;
+LIST *rp;
+{
+	LIST f,v;
+	int m,do_check;
+	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(0,ARG3(arg),&ord);
+	do_check = ARG4(arg) ? 1 : 0;
+	nd_gr_postproc(f,v,m,ord,do_check,rp);
+}
+
 void Pnd_gr_trace(arg,rp)
 NODE arg;
 LIST *rp;
@@ -1874,7 +1967,7 @@ LIST *rp;
 	if ( !BDY(f) ) {
 		*rp = f; return;
 	}
-	if ( argc(arg) == 5 ) {	
+	if ( (ac = argc(arg)) == 5 ) {	
 		asir_assert(ARG1(arg),O_LIST,"dp_weyl_gr_main");
 		asir_assert(ARG2(arg),O_N,"dp_weyl_gr_main");
 		asir_assert(ARG3(arg),O_N,"dp_weyl_gr_main");
@@ -1888,8 +1981,8 @@ LIST *rp;
 		else
 			modular = QTOS(m);
 		create_order_spec(0,ARG4(arg),&ord);
-	} else if (  (ac=argc(arg)) == 2 && OID(ARG1(arg)) == O_OPTLIST )
-		parse_gr_option(f,BDY((OPTLIST)ARG1(arg)),&v,&homo,&modular,&ord);
+	} else if ( current_option )
+		parse_gr_option(f,current_option,&v,&homo,&modular,&ord);
 	else if ( ac == 1 )
 		parse_gr_option(f,0,&v,&homo,&modular,&ord);
 	else
@@ -1994,7 +2087,7 @@ LIST *rp;
 	do_weyl = 0;
 }
 
-static VECT current_dl_weight_vector_obj;
+VECT current_dl_weight_vector_obj;
 int *current_dl_weight_vector;
 
 void Pdp_set_weight(arg,rp)