=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/algnum.c,v retrieving revision 1.11 retrieving revision 1.13 diff -u -p -r1.11 -r1.13 --- OpenXM_contrib2/asir2000/builtin/algnum.c 2005/07/11 00:24:02 1.11 +++ OpenXM_contrib2/asir2000/builtin/algnum.c 2007/02/15 02:06:20 1.13 @@ -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/algnum.c,v 1.10 2005/01/23 14:03:47 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/algnum.c,v 1.12 2005/08/02 07:16:41 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -72,7 +72,7 @@ void Pdalgtodp(); void Pdptodalg(); struct ftab alg_tab[] = { - {"set_field",Pset_field,1}, + {"set_field",Pset_field,-3}, {"get_field_defpoly",Pget_field_defpoly,1}, {"get_field_generator",Pget_field_generator,1}, {"algtodalg",Palgtodalg,1}, @@ -99,7 +99,24 @@ static int UCN,ACNT; void Pset_field(NODE arg,Q *rp) { - setfield_dalg(BDY((LIST)ARG0(arg))); + int ac; + NODE a0,a1; + VL vl0,vl; + struct order_spec *spec; + + if ( (ac = argc(arg)) == 1 ) + setfield_dalg(BDY((LIST)ARG0(arg))); + else if ( ac == 3 ) { + a0 = BDY((LIST)ARG0(arg)); + a1 = BDY((LIST)ARG1(arg)); + for ( vl0 = 0; a1; a1 = NEXT(a1) ) { + NEXTVL(vl0,vl); + vl->v = VR((P)BDY(a1)); + } + if ( vl0 ) NEXT(vl) = 0; + create_order_spec(0,ARG2(arg),&spec); + setfield_gb(a0,vl0,spec); + } *rp = 0; } @@ -129,10 +146,28 @@ void Pdalgtodp(NODE arg,LIST *r) void Pdptodalg(NODE arg,DAlg *r) { - DP d; - + DP d,nm,nm1; + MP m; + Q c,a; + DAlg t; + d = (DP)ARG0(arg); - MKDAlg(d,ONE,*r); + if ( !d ) *r = 0; + else { + for ( m = BDY(d); m; m = NEXT(m) ) + if ( !INT((Q)m->c) ) break; + if ( !m ) { + MKDAlg(d,(Q)ONE,t); + } else { + dp_ptozp(d,&nm); + divq((Q)BDY(d)->c,(Q)BDY(nm)->c,&c); + NTOQ(NM(c),SGN(c),a); + muldc(CO,nm,(P)a,&nm1); + NTOQ(DN(c),1,a); + MKDAlg(nm1,a,t); + } + simpdalg(t,r); + } } void Pdalgtoup(NODE arg,LIST *r)