=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/dp.c,v retrieving revision 1.57 retrieving revision 1.60 diff -u -p -r1.57 -r1.60 --- OpenXM_contrib2/asir2000/builtin/dp.c 2004/12/09 08:56:43 1.57 +++ 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.56 2004/12/06 09:29:34 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}, @@ -439,7 +441,7 @@ Obj *rp; int modular; f.id = O_LIST; f.body = 0; - if ( !arg ) + if ( !arg && !current_option ) *rp = dp_current_spec->obj; else { if ( current_option ) @@ -566,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) @@ -1796,6 +1830,29 @@ LIST *rp; m = QTOS((Q)ARG2(arg)); create_order_spec(0,ARG3(arg),&ord); 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)