=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/dp.c,v retrieving revision 1.79 retrieving revision 1.81 diff -u -p -r1.79 -r1.81 --- OpenXM_contrib2/asir2000/builtin/dp.c 2009/10/09 04:02:11 1.79 +++ OpenXM_contrib2/asir2000/builtin/dp.c 2010/04/16 07:13:42 1.81 @@ -44,7 +44,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.78 2009/09/09 08:13:24 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.80 2010/01/19 06:17:22 noro Exp $ */ #include "ca.h" #include "base.h" @@ -105,6 +105,7 @@ void Pdp_compute_last_t(); void Pdp_compute_last_w(); void Pdp_compute_essential_df(); void Pdp_get_denomlist(); +void Pdp_symb_add(); LIST dp_initial_term(); LIST dp_order(); @@ -246,6 +247,7 @@ struct ftab dp_supp_tab[] = { {"dp_rest",Pdp_rest,1}, {"dp_initial_term",Pdp_initial_term,1}, {"dp_order",Pdp_order,1}, + {"dp_symb_add",Pdp_symb_add,2}, /* degree and size */ {"dp_td",Pdp_td,1}, @@ -1259,6 +1261,30 @@ DP *rp; dp_subd(p1,p2,rp); } +void Pdp_symb_add(arg,rp) +NODE arg; +DP *rp; +{ + DP p1,p2,r; + NODE s0; + MP mp0,mp; + int nv; + + p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg); + asir_assert(p1,O_DP,"dp_symb_add"); + asir_assert(p2,O_DP,"dp_symb_add"); + if ( p1->nv != p2->nv ) + error("dp_sumb_add : invalid input"); + nv = p1->nv; + s0 = symb_merge(dp_dllist(p1),dp_dllist(p2),nv); + for ( mp0 = 0; s0; s0 = NEXT(s0) ) { + NEXTMP(mp0,mp); mp->dl = (DL)BDY(s0); mp->c = (P)ONE; + } + NEXT(mp) = 0; + MKDP(nv,mp0,r); r->sugar = MAX(p1->sugar,p2->sugar); + *rp = r; +} + void Pdp_mul_trunc(arg,rp) NODE arg; DP *rp; @@ -2104,7 +2130,8 @@ NODE arg; LIST *rp; { LIST f,v; - int m,homo; + int m,find; + Obj homo; struct order_spec *ord; do_weyl = 0; @@ -2118,7 +2145,8 @@ LIST *rp; } m = QTOS((Q)ARG2(arg)); create_order_spec(0,ARG3(arg),&ord); - nd_gr(f,v,m,1,ord,rp); + find = get_opt("homo",&homo); + nd_gr(f,v,m,find&&homo,1,ord,rp); } void Pnd_gr(arg,rp) @@ -2126,7 +2154,8 @@ NODE arg; LIST *rp; { LIST f,v; - int m,homo; + int m,find; + Obj homo; struct order_spec *ord; do_weyl = 0; @@ -2140,7 +2169,8 @@ LIST *rp; } m = QTOS((Q)ARG2(arg)); create_order_spec(0,ARG3(arg),&ord); - nd_gr(f,v,m,0,ord,rp); + find = get_opt("homo",&homo); + nd_gr(f,v,m,find&&homo,0,ord,rp); } void Pnd_gr_postproc(arg,rp) @@ -2181,12 +2211,13 @@ LIST *rp; f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); f = remove_zero_from_list(f); if ( !BDY(f) ) { - *rp = f; return; + *rp = f; do_weyl = 0; 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); + do_weyl = 0; } void Pnd_gr_trace(arg,rp) @@ -2242,7 +2273,8 @@ NODE arg; LIST *rp; { LIST f,v; - int m,homo; + int m,find; + Obj homo; struct order_spec *ord; do_weyl = 1; @@ -2252,11 +2284,13 @@ LIST *rp; f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); f = remove_zero_from_list(f); if ( !BDY(f) ) { - *rp = f; return; + *rp = f; do_weyl = 0; return; } m = QTOS((Q)ARG2(arg)); create_order_spec(0,ARG3(arg),&ord); - nd_gr(f,v,m,0,ord,rp); + find = get_opt("homo",&homo); + nd_gr(f,v,m,find&&homo,0,ord,rp); + do_weyl = 0; } void Pnd_weyl_gr_trace(arg,rp) @@ -2275,12 +2309,13 @@ LIST *rp; f = (LIST)ARG0(arg); v = (LIST)ARG1(arg); f = remove_zero_from_list(f); if ( !BDY(f) ) { - *rp = f; return; + *rp = f; do_weyl = 0; return; } homo = QTOS((Q)ARG2(arg)); m = QTOS((Q)ARG3(arg)); create_order_spec(0,ARG4(arg),&ord); nd_gr_trace(f,v,m,homo,0,ord,rp); + do_weyl = 0; } void Pnd_nf(arg,rp) @@ -2761,3 +2796,22 @@ int dpv_hp(DPV p) break; } } + +int get_opt(char *key0,Obj *r) { + NODE tt,p; + char *key; + + 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,key0) ) { + *r = (Obj)BDY(NEXT(p)); + return 1; + } + } + } + return 0; +} +