[BACK]Return to dp.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Diff for /OpenXM_contrib2/asir2000/builtin/dp.c between version 1.102 and 1.107

version 1.102, 2017/02/28 07:06:28 version 1.107, 2017/09/14 01:34:53
Line 6 
Line 6 
  * non-exclusive and royalty-free license to use, copy, modify and   * non-exclusive and royalty-free license to use, copy, modify and
  * redistribute, solely for non-commercial and non-profit purposes, the   * redistribute, solely for non-commercial and non-profit purposes, the
  * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and   * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
  * conditions of this Agreement. For the avoidance of doubt, you acquire * only a limited right to use the SOFTWARE hereunder, and FLL or any   * conditions of this Agreement. For the avoidance of doubt, you acquire
    * only a limited right to use the SOFTWARE hereunder, and FLL or any
  * third party developer retains all rights, including but not limited to   * third party developer retains all rights, including but not limited to
  * copyrights, in and to the SOFTWARE.   * copyrights, in and to the SOFTWARE.
  *   *
Line 44 
Line 45 
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,   * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.   * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *   *
  * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.101 2017/02/27 05:21:19 noro Exp $   * $OpenXM: OpenXM_contrib2/asir2000/builtin/dp.c,v 1.106 2017/09/06 06:25:26 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "base.h"  #include "base.h"
Line 87  void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), P
Line 88  void Pdp_vtoe(), Pdp_etov(), Pdp_dtov(), Pdp_idiv(), P
 void Pdp_cont();  void Pdp_cont();
 void Pdp_gr_checklist();  void Pdp_gr_checklist();
 void Pdp_ltod(),Pdpv_ord(),Pdpv_ht(),Pdpv_hm(),Pdpv_hc();  void Pdp_ltod(),Pdpv_ord(),Pdpv_ht(),Pdpv_hm(),Pdpv_hc();
   void Pdpm_ltod(),Pdpm_dtol(),Pdpm_ord(),Pdpm_nf(),Pdpm_weyl_nf(),Pdpm_sp(),Pdpm_weyl_sp();
   void Pdpm_hm(),Pdpm_ht(),Pdpm_hc();
   
 void Pdp_weyl_red();  void Pdp_weyl_red();
 void Pdp_weyl_sp();  void Pdp_weyl_sp();
Line 101  void Pdp_weyl_mul(),Pdp_weyl_mul_mod(),Pdp_weyl_act();
Line 104  void Pdp_weyl_mul(),Pdp_weyl_mul_mod(),Pdp_weyl_act();
 void Pdp_weyl_set_weight();  void Pdp_weyl_set_weight();
 void Pdp_set_weight(),Pdp_set_top_weight(),Pdp_set_module_weight();  void Pdp_set_weight(),Pdp_set_top_weight(),Pdp_set_module_weight();
 void Pdp_nf_f(),Pdp_weyl_nf_f();  void Pdp_nf_f(),Pdp_weyl_nf_f();
   void Pdpm_nf_f(),Pdpm_weyl_nf_f();
 void Pdp_lnf_f();  void Pdp_lnf_f();
 void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace();  void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace();
 void Pnd_gr_postproc(), Pnd_weyl_gr_postproc();  void Pnd_gr_postproc(), Pnd_weyl_gr_postproc();
Line 152  struct ftab dp_tab[] = {
Line 156  struct ftab dp_tab[] = {
         {"dp_nf",Pdp_nf,4},          {"dp_nf",Pdp_nf,4},
         {"dp_nf_mod",Pdp_nf_mod,5},          {"dp_nf_mod",Pdp_nf_mod,5},
         {"dp_nf_f",Pdp_nf_f,4},          {"dp_nf_f",Pdp_nf_f,4},
           {"dpm_nf_f",Pdpm_nf_f,4},
           {"dpm_weyl_nf_f",Pdpm_weyl_nf_f,4},
           {"dpm_nf",Pdpm_nf,4},
           {"dpm_sp",Pdpm_sp,2},
           {"dpm_weyl_sp",Pdpm_weyl_sp,2},
   
         {"dp_true_nf",Pdp_true_nf,4},          {"dp_true_nf",Pdp_true_nf,4},
         {"dp_true_nf_mod",Pdp_true_nf_mod,5},          {"dp_true_nf_mod",Pdp_true_nf_mod,5},
Line 174  struct ftab dp_tab[] = {
Line 183  struct ftab dp_tab[] = {
         {"dp_gr_mod_main",Pdp_gr_mod_main,5},          {"dp_gr_mod_main",Pdp_gr_mod_main,5},
         {"dp_gr_f_main",Pdp_gr_f_main,4},          {"dp_gr_f_main",Pdp_gr_f_main,4},
         {"dp_gr_checklist",Pdp_gr_checklist,2},          {"dp_gr_checklist",Pdp_gr_checklist,2},
         {"nd_f4",Pnd_f4,4},          {"nd_f4",Pnd_f4,-4},
         {"nd_gr",Pnd_gr,4},          {"nd_gr",Pnd_gr,-4},
         {"nd_gr_trace",Pnd_gr_trace,5},          {"nd_gr_trace",Pnd_gr_trace,-5},
         {"nd_f4_trace",Pnd_f4_trace,5},          {"nd_f4_trace",Pnd_f4_trace,-5},
         {"nd_gr_postproc",Pnd_gr_postproc,5},          {"nd_gr_postproc",Pnd_gr_postproc,5},
         {"nd_gr_recompute_trace",Pnd_gr_recompute_trace,5},          {"nd_gr_recompute_trace",Pnd_gr_recompute_trace,5},
         {"nd_btog",Pnd_btog,-6},          {"nd_btog",Pnd_btog,-6},
         {"nd_weyl_gr_postproc",Pnd_weyl_gr_postproc,5},          {"nd_weyl_gr_postproc",Pnd_weyl_gr_postproc,5},
         {"nd_weyl_gr",Pnd_weyl_gr,4},          {"nd_weyl_gr",Pnd_weyl_gr,-4},
         {"nd_weyl_gr_trace",Pnd_weyl_gr_trace,5},          {"nd_weyl_gr_trace",Pnd_weyl_gr_trace,-5},
         {"nd_nf",Pnd_nf,5},          {"nd_nf",Pnd_nf,5},
         {"nd_weyl_nf",Pnd_weyl_nf,5},          {"nd_weyl_nf",Pnd_weyl_nf,5},
   
Line 205  struct ftab dp_tab[] = {
Line 214  struct ftab dp_tab[] = {
   
         /* normal form */          /* normal form */
         {"dp_weyl_nf",Pdp_weyl_nf,4},          {"dp_weyl_nf",Pdp_weyl_nf,4},
           {"dpm_weyl_nf",Pdpm_weyl_nf,4},
         {"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5},          {"dp_weyl_nf_mod",Pdp_weyl_nf_mod,5},
         {"dp_weyl_nf_f",Pdp_weyl_nf_f,4},          {"dp_weyl_nf_f",Pdp_weyl_nf_f,4},
   
Line 238  struct ftab dp_supp_tab[] = {
Line 248  struct ftab dp_supp_tab[] = {
         /* setting flags */          /* setting flags */
         {"dp_sort",Pdp_sort,1},          {"dp_sort",Pdp_sort,1},
         {"dp_ord",Pdp_ord,-1},          {"dp_ord",Pdp_ord,-1},
           {"dpm_ord",Pdpm_ord,-1},
         {"dpv_ord",Pdpv_ord,-2},          {"dpv_ord",Pdpv_ord,-2},
         {"dp_set_kara",Pdp_set_kara,-1},          {"dp_set_kara",Pdp_set_kara,-1},
         {"dp_nelim",Pdp_nelim,-1},          {"dp_nelim",Pdp_nelim,-1},
Line 258  struct ftab dp_supp_tab[] = {
Line 269  struct ftab dp_supp_tab[] = {
         {"dp_rat",Pdp_rat,1},          {"dp_rat",Pdp_rat,1},
         {"dp_ltod",Pdp_ltod,-2},          {"dp_ltod",Pdp_ltod,-2},
   
           {"dpm_ltod",Pdpm_ltod,2},
           {"dpm_dtol",Pdpm_dtol,3},
   
         /* criteria */          /* criteria */
         {"dp_cri1",Pdp_cri1,2},          {"dp_cri1",Pdp_cri1,2},
         {"dp_cri2",Pdp_cri2,2},          {"dp_cri2",Pdp_cri2,2},
Line 272  struct ftab dp_supp_tab[] = {
Line 286  struct ftab dp_supp_tab[] = {
         {"dpv_hm",Pdpv_hm,1},          {"dpv_hm",Pdpv_hm,1},
         {"dpv_ht",Pdpv_ht,1},          {"dpv_ht",Pdpv_ht,1},
         {"dpv_hc",Pdpv_hc,1},          {"dpv_hc",Pdpv_hc,1},
           {"dpm_hm",Pdpm_hm,1},
           {"dpm_ht",Pdpm_ht,1},
           {"dpm_hc",Pdpm_hc,1},
         {"dp_rest",Pdp_rest,1},          {"dp_rest",Pdp_rest,1},
         {"dp_initial_term",Pdp_initial_term,1},          {"dp_initial_term",Pdp_initial_term,1},
         {"dp_order",Pdp_order,1},          {"dp_order",Pdp_order,1},
Line 419  void Pdp_mdtod(NODE arg,DP *rp)
Line 436  void Pdp_mdtod(NODE arg,DP *rp)
                 *rp = 0;                  *rp = 0;
         else {          else {
                 for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {                  for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                         mptop(m->c,&t); NEXTMP(mr0,mr); mr->c = t; mr->dl = m->dl;                          mptop((P)m->c,&t); NEXTMP(mr0,mr); mr->c = (Obj)t; mr->dl = m->dl;
                 }                  }
                 NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;                  NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
         }          }
Line 511  void Pdp_vtoe(NODE arg,DP *rp)
Line 528  void Pdp_vtoe(NODE arg,DP *rp)
                 d[i] = QTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i);                  d[i] = QTOS((Q)(v->body[i])); td += MUL_WEIGHT(d[i],i);
         }          }
         dl->td = td;          dl->td = td;
         NEWMP(m); m->dl = dl; m->c = (P)ONE; NEXT(m) = 0;          NEWMP(m); m->dl = dl; m->c = (Obj)ONE; NEXT(m) = 0;
         MKDP(n,m,dp); dp->sugar = td;          MKDP(n,m,dp); dp->sugar = td;
         *rp = dp;          *rp = dp;
 }  }
Line 622  void Pdp_ptod(NODE arg,DP *rp)
Line 639  void Pdp_ptod(NODE arg,DP *rp)
         ptod(CO,vl,p,rp);          ptod(CO,vl,p,rp);
 }  }
   
 void Phomogenize(NODE arg,P *rp)  void Phomogenize(NODE arg,Obj *rp)
 {  {
         P p;          P p;
         DP d,h;          DP d,h;
Line 704  void Pdp_ltod(NODE arg,DPV *rp)
Line 721  void Pdp_ltod(NODE arg,DPV *rp)
         MKDPV(len,e,*rp);          MKDPV(len,e,*rp);
 }  }
   
 void Pdp_dtop(NODE arg,P *rp)  void Pdpm_ltod(NODE arg,DPM *rp)
 {  {
         NODE n;          NODE n;
         VL vl,tvl;          VL vl,tvl;
           LIST f,v;
           int i,len;
           NODE nd;
     NODE t;
     DP d;
     DPM s,u,w;
   
     f = (LIST)ARG0(arg);
     v = (LIST)ARG1(arg);
           for ( vl = 0, n = BDY(v); n; n = NEXT(n) ) {
                   if ( !vl ) {
                           NEWVL(vl); tvl = vl;
                   } else {
                           NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
                   }
                   VR(tvl) = VR((P)BDY(n));
           }
           if ( vl )
                   NEXT(tvl) = 0;
   
           nd = BDY(f);
           len = length(nd);
           for ( i = 0, t = nd, s = 0; i < len; i++, t = NEXT(t) ) {
                   ptod(CO,vl,(P)BDY(t),&d);
       dtodpm(d,i,&u);
       adddpm(CO,s,u,&w); s = w;
           }
     *rp = s;
   }
   
   void Pdpm_dtol(NODE arg,LIST *rp)
   {
     DPM a;
     NODE nd,nd1;
     VL vl,tvl;
     int n,len,i,pos,nv;
     MP *w;
     DMM t;
     DMM *wa;
     MP m;
     DP u;
     Obj s;
   
     a = (DPM)ARG0(arg);
     for ( vl = 0, nd = BDY((LIST)ARG1(arg)), nv = 0; nd; nd = NEXT(nd), nv++ ) {
       if ( !vl ) {
         NEWVL(vl); tvl = vl;
       } else {
         NEWVL(NEXT(tvl)); tvl = NEXT(tvl);
       }
       VR(tvl) = VR((P)BDY(nd));
     }
           if ( vl )
                   NEXT(tvl) = 0;
      n = QTOS((Q)ARG2(arg));
      w = (MP *)CALLOC(n,sizeof(MP));
      for ( t = BDY(a), len = 0; t; t = NEXT(t) ) len++;
      wa = (DMM *)MALLOC(len*sizeof(DMM));
      for ( t = BDY(a), i = 0; t; t = NEXT(t), i++ ) wa[i] = t;
      for ( i = len-1; i >= 0; i-- ) {
        NEWMP(m); m->dl = wa[i]->dl; C(m) = C(wa[i]);
        pos = wa[i]->pos;
        NEXT(m) = w[pos];
        w[pos] = m;
      }
     nd = 0;
     for ( i = n-1; i >= 0; i-- ) {
                   MKDP(nv,w[i],u); u->sugar = a->sugar; /* XXX */
             dtop(CO,vl,u,&s);
             MKNODE(nd1,s,nd); nd = nd1;
     }
     MKLIST(*rp,nd);
   }
   
   void Pdp_dtop(NODE arg,Obj *rp)
   {
           NODE n;
           VL vl,tvl;
   
         asir_assert(ARG0(arg),O_DP,"dp_dtop");          asir_assert(ARG0(arg),O_DP,"dp_dtop");
         asir_assert(ARG1(arg),O_LIST,"dp_dtop");          asir_assert(ARG1(arg),O_LIST,"dp_dtop");
         for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {          for ( vl = 0, n = BDY((LIST)ARG1(arg)); n; n = NEXT(n) ) {
Line 850  void Pdp_weyl_nf(NODE arg,DP *rp)
Line 945  void Pdp_weyl_nf(NODE arg,DP *rp)
         do_weyl = 0;          do_weyl = 0;
 }  }
   
   void Pdpm_nf(NODE arg,DP *rp)
   {
           NODE b;
           DPM *ps;
           DPM g;
           int full;
   
           if ( !(g = (DPM)ARG1(arg)) ) {
                   *rp = 0; return;
           }
           do_weyl = 0; dp_fcoeffs = 0;
           asir_assert(ARG0(arg),O_LIST,"dpm_nf");
           asir_assert(ARG1(arg),O_DPM,"dpm_nf");
           asir_assert(ARG2(arg),O_VECT,"dpm_nf");
           asir_assert(ARG3(arg),O_N,"dpm_nf");
           b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg));
           full = (Q)ARG3(arg) ? 1 : 0;
           dpm_nf_z(b,g,ps,full,DP_Multiple,rp);
   }
   
   void Pdpm_weyl_nf(NODE arg,DPM *rp)
   {
           NODE b;
           DPM *ps;
           DPM g;
           int full;
   
           if ( !(g = (DPM)ARG1(arg)) ) {
                   *rp = 0; return;
           }
           asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf");
           asir_assert(ARG1(arg),O_DPM,"dpm_weyl_nf");
           asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf");
           asir_assert(ARG3(arg),O_N,"dpm_weyl_nf");
           b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg));
           full = (Q)ARG3(arg) ? 1 : 0;
           do_weyl = 1;
           dpm_nf_z(b,g,ps,full,DP_Multiple,rp);
           do_weyl = 0;
   }
   
 /* nf computation using field operations */  /* nf computation using field operations */
   
 void Pdp_nf_f(NODE arg,DP *rp)  void Pdp_nf_f(NODE arg,DP *rp)
Line 893  void Pdp_weyl_nf_f(NODE arg,DP *rp)
Line 1029  void Pdp_weyl_nf_f(NODE arg,DP *rp)
         do_weyl = 0;          do_weyl = 0;
 }  }
   
   void Pdpm_nf_f(NODE arg,DPM *rp)
   {
           NODE b;
           DPM *ps;
           DPM g;
           int full;
   
           if ( !(g = (DPM)ARG1(arg)) ) {
                   *rp = 0; return;
           }
           asir_assert(ARG0(arg),O_LIST,"dpm_nf_f");
           asir_assert(ARG1(arg),O_DPM,"dpm_nf_f");
           asir_assert(ARG2(arg),O_VECT,"dpm_nf_f");
           asir_assert(ARG3(arg),O_N,"dpm_nf_f");
           b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg));
           full = (Q)ARG3(arg) ? 1 : 0;
           dpm_nf_f(b,g,ps,full,rp);
   }
   
   void Pdpm_weyl_nf_f(NODE arg,DPM *rp)
   {
           NODE b;
           DPM *ps;
           DPM g;
           int full;
   
           if ( !(g = (DPM)ARG1(arg)) ) {
                   *rp = 0; return;
           }
           asir_assert(ARG0(arg),O_LIST,"dpm_weyl_nf_f");
           asir_assert(ARG1(arg),O_DP,"dpm_weyl_nf_f");
           asir_assert(ARG2(arg),O_VECT,"dpm_weyl_nf_f");
           asir_assert(ARG3(arg),O_N,"dpm_weyl_nf_f");
           b = BDY((LIST)ARG0(arg)); ps = (DPM *)BDY((VECT)ARG2(arg));
           full = (Q)ARG3(arg) ? 1 : 0;
           do_weyl = 1;
           dpm_nf_f(b,g,ps,full,rp);
           do_weyl = 0;
   }
   
   
 void Pdp_nf_mod(NODE arg,DP *rp)  void Pdp_nf_mod(NODE arg,DP *rp)
 {  {
         NODE b;          NODE b;
Line 1044  void Pdp_true_nf_marked(NODE arg,LIST *rp)
Line 1221  void Pdp_true_nf_marked(NODE arg,LIST *rp)
                 b = BDY((LIST)ARG0(arg));                  b = BDY((LIST)ARG0(arg));
                 ps = (DP *)BDY((VECT)ARG2(arg));                  ps = (DP *)BDY((VECT)ARG2(arg));
                 hps = (DP *)BDY((VECT)ARG3(arg));                  hps = (DP *)BDY((VECT)ARG3(arg));
                 dp_true_nf_marked(b,g,ps,hps,&nm,&cont,&dn);                  dp_true_nf_marked(b,g,ps,hps,&nm,(P *)&cont,(P *)&dn);
         }          }
         n = mknode(3,nm,cont,dn);          n = mknode(3,nm,cont,dn);
         MKLIST(*rp,n);          MKLIST(*rp,n);
Line 1227  void Pdp_tdiv(NODE arg,DP *rp)
Line 1404  void Pdp_tdiv(NODE arg,DP *rp)
                                 *rp = 0; return;                                  *rp = 0; return;
                         } else {                          } else {
                                 NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c);                                  NEXTMP(mr0,mr); NTOQ(q,SGN((Q)m->c)*sgn,c);
                                 mr->c = (P)c; mr->dl = m->dl;                                  mr->c = (Obj)c; mr->dl = m->dl;
                         }                          }
                 }                  }
                 NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;                  NEXT(mr) = 0; MKDP(p->nv,mr0,*rp); (*rp)->sugar = p->sugar;
Line 1248  void Pdp_red_coef(NODE arg,DP *rp)
Line 1425  void Pdp_red_coef(NODE arg,DP *rp)
                 *rp = 0;                  *rp = 0;
         else {          else {
                 for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {                  for ( mr0 = 0, m = BDY(p); m; m = NEXT(m) ) {
                         divsrp(CO,m->c,mod,&q,&r);                          divsrp(CO,(P)m->c,mod,&q,&r);
                         if ( r ) {                          if ( r ) {
                                 NEXTMP(mr0,mr); mr->c = r; mr->dl = m->dl;                                  NEXTMP(mr0,mr); mr->c = (Obj)r; mr->dl = m->dl;
                         }                          }
                 }                  }
                 if ( mr0 ) {                  if ( mr0 ) {
Line 1315  void Pdp_symb_add(NODE arg,DP *rp)
Line 1492  void Pdp_symb_add(NODE arg,DP *rp)
         nv = p1->nv;          nv = p1->nv;
         s0 = symb_merge(dp_dllist(p1),dp_dllist(p2),nv);          s0 = symb_merge(dp_dllist(p1),dp_dllist(p2),nv);
         for ( mp0 = 0; s0; s0 = NEXT(s0) ) {          for ( mp0 = 0; s0; s0 = NEXT(s0) ) {
                 NEXTMP(mp0,mp); mp->dl = (DL)BDY(s0); mp->c = (P)ONE;                  NEXTMP(mp0,mp); mp->dl = (DL)BDY(s0); mp->c = (Obj)ONE;
         }          }
         NEXT(mp) = 0;          NEXT(mp) = 0;
         MKDP(nv,mp0,r); r->sugar = MAX(p1->sugar,p2->sugar);          MKDP(nv,mp0,r); r->sugar = MAX(p1->sugar,p2->sugar);
Line 1426  void Pdp_weyl_sp(NODE arg,DP *rp)
Line 1603  void Pdp_weyl_sp(NODE arg,DP *rp)
         DP p1,p2;          DP p1,p2;
   
         p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);          p1 = (DP)ARG0(arg); p2 = (DP)ARG1(arg);
         asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_sp");          asir_assert(p1,O_DP,"dp_weyl_sp"); asir_assert(p2,O_DP,"dp_weyl_sp");
         do_weyl = 1;          do_weyl = 1;
         dp_sp(p1,p2,rp);          dp_sp(p1,p2,rp);
         do_weyl = 0;          do_weyl = 0;
 }  }
   
   void Pdpm_sp(NODE arg,DPM *rp)
   {
           DPM  p1,p2;
   
           do_weyl = 0;
           p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg);
           asir_assert(p1,O_DPM,"dpm_sp"); asir_assert(p2,O_DPM,"dpm_sp");
           dpm_sp(p1,p2,rp);
   }
   
   void Pdpm_weyl_sp(NODE arg,DPM *rp)
   {
           DPM p1,p2;
   
           p1 = (DPM)ARG0(arg); p2 = (DPM)ARG1(arg);
           asir_assert(p1,O_DPM,"dpm_weyl_sp"); asir_assert(p2,O_DPM,"dpm_weyl_sp");
           do_weyl = 1;
           dpm_sp(p1,p2,rp);
           do_weyl = 0;
   }
   
 void Pdp_sp_mod(NODE arg,DP *rp)  void Pdp_sp_mod(NODE arg,DP *rp)
 {  {
         DP p1,p2;          DP p1,p2;
Line 1460  void Pdp_lcm(NODE arg,DP *rp)
Line 1658  void Pdp_lcm(NODE arg,DP *rp)
                 d->d[i] = MAX(d1->d[i],d2->d[i]); td += MUL_WEIGHT(d->d[i],i);                  d->d[i] = MAX(d1->d[i],d2->d[i]); td += MUL_WEIGHT(d->d[i],i);
         }          }
         d->td = td;          d->td = td;
         NEWMP(m); m->dl = d; m->c = (P)ONE; NEXT(m) = 0;          NEWMP(m); m->dl = d; m->c = (Obj)ONE; NEXT(m) = 0;
         MKDP(n,m,*rp); (*rp)->sugar = td;       /* XXX */          MKDP(n,m,*rp); (*rp)->sugar = td;       /* XXX */
 }  }
   
Line 1481  void Pdp_ht(NODE arg,DP *rp)
Line 1679  void Pdp_ht(NODE arg,DP *rp)
         dp_ht(p,rp);          dp_ht(p,rp);
 }  }
   
 void Pdp_hc(NODE arg,P *rp)  void Pdp_hc(NODE arg,Obj *rp)
 {  {
         asir_assert(ARG0(arg),O_DP,"dp_hc");          asir_assert(ARG0(arg),O_DP,"dp_hc");
         if ( !ARG0(arg) )          if ( !ARG0(arg) )
Line 1726  void Pdp_mag(NODE arg,Q *rp)
Line 1924  void Pdp_mag(NODE arg,Q *rp)
                 *rp = 0;                  *rp = 0;
         else {          else {
                 for ( s = 0, m = BDY(p); m; m = NEXT(m) )                  for ( s = 0, m = BDY(p); m; m = NEXT(m) )
                         s += p_mag(m->c);                          s += p_mag((P)m->c);
                 STOQ(s,*rp);                  STOQ(s,*rp);
         }          }
 }  }
Line 1906  void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo
Line 2104  void parse_gr_option(LIST f,NODE opt,LIST *v,Num *homo
                         else                          else
                                 *modular = QTOS(m);                                  *modular = QTOS(m);
                         modular_is_set = 1;                          modular_is_set = 1;
                   } else if ( !strcmp(key,"dp") ) {
         /* XXX : ignore */
                 } else                  } else
                         error("parse_gr_option : not implemented");                          error("parse_gr_option : not implemented");
         }          }
Line 2101  void Pdp_gr_mod_main(NODE arg,LIST *rp)
Line 2301  void Pdp_gr_mod_main(NODE arg,LIST *rp)
 void Pnd_f4(NODE arg,LIST *rp)  void Pnd_f4(NODE arg,LIST *rp)
 {  {
         LIST f,v;          LIST f,v;
         int m,homo,retdp;          int m,homo,retdp,ac;
         Obj val;          Obj val;
     Q mq;    Q mq;
     NODE node;    Num nhomo;
     NODE node;
         struct order_spec *ord;          struct order_spec *ord;
   
         do_weyl = 0;          do_weyl = 0;
         nd_rref2 = 0;          nd_rref2 = 0;
         asir_assert(ARG0(arg),O_LIST,"nd_f4");    retdp = 0;
         asir_assert(ARG1(arg),O_LIST,"nd_f4");    if ( (ac = argc(arg)) == 4 ) {
         asir_assert(ARG2(arg),O_N,"nd_f4");            asir_assert(ARG0(arg),O_LIST,"nd_f4");
         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);            asir_assert(ARG1(arg),O_LIST,"nd_f4");
         f = remove_zero_from_list(f);            asir_assert(ARG2(arg),O_N,"nd_f4");
         if ( !BDY(f) ) {            f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                 *rp = f; return;            f = remove_zero_from_list(f);
         }            if ( !BDY(f) ) {
     mq = (Q)ARG2(arg);                    *rp = f; return;
     if ( mq && (PL(NM(mq)) > 1 || BD(NM(mq))[0] >= (1<<30)) ) {            }
       node = mknode(1,mq);        mq = (Q)ARG2(arg);
       Psetmod_ff(node,&val);        if ( mq && (PL(NM(mq)) > 1 || BD(NM(mq))[0] >= (1<<31)) ) {
       m = -2;          node = mknode(1,mq);
           Psetmod_ff(node,&val);
           m = -2;
     } else      } else
       m = QTOS(mq);        m = QTOS(mq);
         create_order_spec(0,ARG3(arg),&ord);            create_order_spec(0,ARG3(arg),&ord);
         homo = retdp = 0;            homo = 0;
         if ( get_opt("homo",&val) && val ) homo = 1;            if ( get_opt("homo",&val) && val ) homo = 1;
         if ( get_opt("dp",&val) && val ) retdp = 1;            if ( get_opt("dp",&val) && val ) retdp = 1;
         if ( get_opt("rref2",&val) && val ) nd_rref2 = 1;            if ( get_opt("rref2",&val) && val ) nd_rref2 = 1;
     } else if ( ac == 1 ) {
             f = (LIST)ARG0(arg);
                   parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
       homo = QTOS((Q)nhomo);
             if ( get_opt("dp",&val) && val ) retdp = 1;
             if ( get_opt("rref2",&val) && val ) nd_rref2 = 1;
     } else
       error("nd_f4 : invalid argument");
         nd_gr(f,v,m,homo,retdp,1,ord,rp);          nd_gr(f,v,m,homo,retdp,1,ord,rp);
 }  }
   
 void Pnd_gr(NODE arg,LIST *rp)  void Pnd_gr(NODE arg,LIST *rp)
 {  {
         LIST f,v;          LIST f,v;
         int m,homo,retdp;          int m,homo,retdp,ac;
         Obj val;          Obj val;
     Q mq;    Q mq;
     NODE node;    Num nhomo;
     NODE node;
         struct order_spec *ord;          struct order_spec *ord;
   
         do_weyl = 0;          do_weyl = 0;
         asir_assert(ARG0(arg),O_LIST,"nd_gr");    retdp = 0;
         asir_assert(ARG1(arg),O_LIST,"nd_gr");    if ( (ac=argc(arg)) == 4 ) {
         asir_assert(ARG2(arg),O_N,"nd_gr");            asir_assert(ARG0(arg),O_LIST,"nd_gr");
         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);            asir_assert(ARG1(arg),O_LIST,"nd_gr");
         f = remove_zero_from_list(f);            asir_assert(ARG2(arg),O_N,"nd_gr");
         if ( !BDY(f) ) {            f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                 *rp = f; return;            f = remove_zero_from_list(f);
         }            if ( !BDY(f) ) {
     mq = (Q)ARG2(arg);                    *rp = f; return;
     if ( mq && (PL(NM(mq)) > 1 || BD(NM(mq))[0] >= (1<<30)) ) {            }
       node = mknode(1,mq);        mq = (Q)ARG2(arg);
       Psetmod_ff(node,&val);        if ( mq && (PL(NM(mq)) > 1 || BD(NM(mq))[0] >= (1<<30)) ) {
       m = -2;          node = mknode(1,mq);
     } else          Psetmod_ff(node,&val);
       m = QTOS(mq);          m = -2;
         create_order_spec(0,ARG3(arg),&ord);        } else
         homo = retdp = 0;          m = QTOS(mq);
         if ( get_opt("homo",&val) && val ) homo = 1;            create_order_spec(0,ARG3(arg),&ord);
         if ( get_opt("dp",&val) && val ) retdp = 1;            homo = 0;
             if ( get_opt("homo",&val) && val ) homo = 1;
             if ( get_opt("dp",&val) && val ) retdp = 1;
           } else if ( ac == 1 ) {
             f = (LIST)ARG0(arg);
                   parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
       homo = QTOS((Q)nhomo);
             if ( get_opt("dp",&val) && val ) retdp = 1;
     } else
       error("nd_gr : invalid argument");
         nd_gr(f,v,m,homo,retdp,0,ord,rp);          nd_gr(f,v,m,homo,retdp,0,ord,rp);
 }  }
   
Line 2263  void Pnd_weyl_gr_postproc(NODE arg,LIST *rp)
Line 2484  void Pnd_weyl_gr_postproc(NODE arg,LIST *rp)
 void Pnd_gr_trace(NODE arg,LIST *rp)  void Pnd_gr_trace(NODE arg,LIST *rp)
 {  {
         LIST f,v;          LIST f,v;
         int m,homo;          int m,homo,ac;
     Num nhomo;
         struct order_spec *ord;          struct order_spec *ord;
   
         do_weyl = 0;          do_weyl = 0;
         asir_assert(ARG0(arg),O_LIST,"nd_gr_trace");    if ( (ac = argc(arg)) == 5 ) {
         asir_assert(ARG1(arg),O_LIST,"nd_gr_trace");            asir_assert(ARG0(arg),O_LIST,"nd_gr_trace");
         asir_assert(ARG2(arg),O_N,"nd_gr_trace");            asir_assert(ARG1(arg),O_LIST,"nd_gr_trace");
         asir_assert(ARG3(arg),O_N,"nd_gr_trace");            asir_assert(ARG2(arg),O_N,"nd_gr_trace");
         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);            asir_assert(ARG3(arg),O_N,"nd_gr_trace");
         f = remove_zero_from_list(f);            f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
         if ( !BDY(f) ) {            f = remove_zero_from_list(f);
                 *rp = f; return;            if ( !BDY(f) ) {
         }                    *rp = f; return;
         homo = QTOS((Q)ARG2(arg));            }
         m = QTOS((Q)ARG3(arg));            homo = QTOS((Q)ARG2(arg));
         create_order_spec(0,ARG4(arg),&ord);            m = QTOS((Q)ARG3(arg));
             create_order_spec(0,ARG4(arg),&ord);
     } else if ( ac == 1 ) {
             f = (LIST)ARG0(arg);
                   parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
       homo = QTOS((Q)nhomo);
     } else
       error("nd_gr_trace : invalid argument");
         nd_gr_trace(f,v,m,homo,0,ord,rp);          nd_gr_trace(f,v,m,homo,0,ord,rp);
 }  }
   
 void Pnd_f4_trace(NODE arg,LIST *rp)  void Pnd_f4_trace(NODE arg,LIST *rp)
 {  {
         LIST f,v;          LIST f,v;
         int m,homo;          int m,homo,ac;
     Num nhomo;
         struct order_spec *ord;          struct order_spec *ord;
   
         do_weyl = 0;          do_weyl = 0;
         asir_assert(ARG0(arg),O_LIST,"nd_gr_trace");    if ( (ac = argc(arg))==5 ) {
         asir_assert(ARG1(arg),O_LIST,"nd_gr_trace");            asir_assert(ARG0(arg),O_LIST,"nd_f4_trace");
         asir_assert(ARG2(arg),O_N,"nd_gr_trace");            asir_assert(ARG1(arg),O_LIST,"nd_f4_trace");
         asir_assert(ARG3(arg),O_N,"nd_gr_trace");            asir_assert(ARG2(arg),O_N,"nd_f4_trace");
         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);            asir_assert(ARG3(arg),O_N,"nd_f4_trace");
         f = remove_zero_from_list(f);            f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
         if ( !BDY(f) ) {            f = remove_zero_from_list(f);
                 *rp = f; return;            if ( !BDY(f) ) {
         }                    *rp = f; return;
         homo = QTOS((Q)ARG2(arg));            }
         m = QTOS((Q)ARG3(arg));            homo = QTOS((Q)ARG2(arg));
         create_order_spec(0,ARG4(arg),&ord);            m = QTOS((Q)ARG3(arg));
             create_order_spec(0,ARG4(arg),&ord);
     } else if ( ac == 1 ) {
             f = (LIST)ARG0(arg);
                   parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
       homo = QTOS((Q)nhomo);
     } else
       error("nd_gr_trace : invalid argument");
         nd_gr_trace(f,v,m,homo,1,ord,rp);          nd_gr_trace(f,v,m,homo,1,ord,rp);
 }  }
   
 void Pnd_weyl_gr(NODE arg,LIST *rp)  void Pnd_weyl_gr(NODE arg,LIST *rp)
 {  {
         LIST f,v;          LIST f,v;
         int m,homo,retdp;          int m,homo,retdp,ac;
         Obj val;          Obj val;
     Num nhomo;
         struct order_spec *ord;          struct order_spec *ord;
   
         do_weyl = 1;          do_weyl = 1;
         asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr");    retdp = 0;
         asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr");    if ( (ac = argc(arg)) == 4 ) {
         asir_assert(ARG2(arg),O_N,"nd_weyl_gr");            asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr");
         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);            asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr");
         f = remove_zero_from_list(f);            asir_assert(ARG2(arg),O_N,"nd_weyl_gr");
         if ( !BDY(f) ) {            f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
                 *rp = f; do_weyl = 0; return;            f = remove_zero_from_list(f);
         }            if ( !BDY(f) ) {
         m = QTOS((Q)ARG2(arg));                    *rp = f; do_weyl = 0; return;
         create_order_spec(0,ARG3(arg),&ord);            }
         homo = retdp = 0;            m = QTOS((Q)ARG2(arg));
         if ( get_opt("homo",&val) && val ) homo = 1;            create_order_spec(0,ARG3(arg),&ord);
         if ( get_opt("dp",&val) && val ) retdp = 1;            homo = 0;
             if ( get_opt("homo",&val) && val ) homo = 1;
             if ( get_opt("dp",&val) && val ) retdp = 1;
     } else if ( ac == 1 ) {
             f = (LIST)ARG0(arg);
                   parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
       homo = QTOS((Q)nhomo);
             if ( get_opt("dp",&val) && val ) retdp = 1;
     } else
       error("nd_weyl_gr : invalid argument");
         nd_gr(f,v,m,homo,retdp,0,ord,rp);          nd_gr(f,v,m,homo,retdp,0,ord,rp);
         do_weyl = 0;          do_weyl = 0;
 }  }
Line 2332  void Pnd_weyl_gr(NODE arg,LIST *rp)
Line 2579  void Pnd_weyl_gr(NODE arg,LIST *rp)
 void Pnd_weyl_gr_trace(NODE arg,LIST *rp)  void Pnd_weyl_gr_trace(NODE arg,LIST *rp)
 {  {
         LIST f,v;          LIST f,v;
         int m,homo;          int m,homo,ac;
     Num nhomo;
         struct order_spec *ord;          struct order_spec *ord;
   
         do_weyl = 1;          do_weyl = 1;
         asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr_trace");    if ( (ac = argc(arg)) == 5 ) {
         asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr_trace");            asir_assert(ARG0(arg),O_LIST,"nd_weyl_gr_trace");
         asir_assert(ARG2(arg),O_N,"nd_weyl_gr_trace");            asir_assert(ARG1(arg),O_LIST,"nd_weyl_gr_trace");
         asir_assert(ARG3(arg),O_N,"nd_weyl_gr_trace");            asir_assert(ARG2(arg),O_N,"nd_weyl_gr_trace");
         f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);            asir_assert(ARG3(arg),O_N,"nd_weyl_gr_trace");
         f = remove_zero_from_list(f);            f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
         if ( !BDY(f) ) {            f = remove_zero_from_list(f);
                 *rp = f; do_weyl = 0; return;            if ( !BDY(f) ) {
         }                    *rp = f; do_weyl = 0; return;
         homo = QTOS((Q)ARG2(arg));            }
         m = QTOS((Q)ARG3(arg));            homo = QTOS((Q)ARG2(arg));
         create_order_spec(0,ARG4(arg),&ord);            m = QTOS((Q)ARG3(arg));
             create_order_spec(0,ARG4(arg),&ord);
     } else if ( ac == 1 ) {
             f = (LIST)ARG0(arg);
                   parse_gr_option(f,current_option,&v,&nhomo,&m,&ord);
       homo = QTOS((Q)nhomo);
     } else
       error("nd_weyl_gr_trace : invalid argument");
         nd_gr_trace(f,v,m,homo,0,ord,rp);          nd_gr_trace(f,v,m,homo,0,ord,rp);
         do_weyl = 0;          do_weyl = 0;
 }  }
Line 2851  void Pdp_rref2(NODE arg,VECT *rp)
Line 3106  void Pdp_rref2(NODE arg,VECT *rp)
           if ( v[j/BLEN] & (1L<<(j%BLEN)) ) {            if ( v[j/BLEN] & (1L<<(j%BLEN)) ) {
             NEXTMP(m0,m);              NEXTMP(m0,m);
                 m->dl = t[j];                  m->dl = t[j];
                 m->c = (P)ONE;                  m->c = (Obj)ONE;
             td = MAX(td,m->dl->td);              td = MAX(td,m->dl->td);
           }            }
         }          }
Line 2922  NODE sumi_criFMD(int nv,DP *f,int m)
Line 3177  NODE sumi_criFMD(int nv,DP *f,int m)
        for ( k2 = 0; k2 < nv; k2++ )         for ( k2 = 0; k2 < nv; k2++ )
          if ( dl1->d[k2] && dl2->d[k2] ) break;           if ( dl1->d[k2] && dl2->d[k2] ) break;
        if ( k2 < nv ) {         if ( k2 < nv ) {
          NEWMP(mp); mp->dl = l1; C(mp) = (P)ONE;           NEWMP(mp); mp->dl = l1; C(mp) = (Obj)ONE;
          NEXT(mp) = 0; MKDP(nv,mp,u); u->sugar = l1->td;           NEXT(mp) = 0; MKDP(nv,mp,u); u->sugar = l1->td;
              STOQ(i,iq); STOQ(m,mq);               STOQ(i,iq); STOQ(m,mq);
              nd = mknode(3,iq,mq,u);               nd = mknode(3,iq,mq,u);
Line 2985  DP dltodp(int nv,DL d)
Line 3240  DP dltodp(int nv,DL d)
   MP mp;    MP mp;
   DP dp;    DP dp;
   
   NEWMP(mp); mp->dl = d; C(mp) = (P)ONE;    NEWMP(mp); mp->dl = d; C(mp) = (Obj)ONE;
   NEXT(mp) = 0; MKDP(nv,mp,dp); dp->sugar = d->td;    NEXT(mp) = 0; MKDP(nv,mp,dp); dp->sugar = d->td;
   return dp;    return dp;
 }  }
Line 3166  void Pdpv_ord(NODE arg,Obj *rp)
Line 3421  void Pdpv_ord(NODE arg,Obj *rp)
         *rp = dp_current_modspec->obj;          *rp = dp_current_modspec->obj;
 }  }
   
   extern int dpm_ispot;
   
   void Pdpm_ord(NODE arg,LIST *rp)
   {
     Q q;
     NODE nd;
           struct order_spec *spec;
   
           if ( arg ) {
       nd = BDY((LIST)ARG0(arg));
                   if ( !create_order_spec(0,(Obj)ARG1(nd),&spec) )
                           error("dpm_ord : invalid order specification");
                   initdpm(spec,QTOS((Q)ARG0(nd)));
           }
     STOQ(dpm_ispot,q);
     nd = mknode(2,q,dp_current_spec->obj);
     MKLIST(*rp,nd);
   }
   
   void Pdpm_hm(NODE arg,DPM *rp)
   {
           DPM p;
   
           p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dpm_hm");
           dpm_hm(p,rp);
   }
   
   void Pdpm_ht(NODE arg,DPM *rp)
   {
           DPM p;
   
           p = (DPM)ARG0(arg); asir_assert(p,O_DPM,"dp_ht");
           dpm_ht(p,rp);
   }
   
   void Pdpm_hc(NODE arg,Obj *rp)
   {
           asir_assert(ARG0(arg),O_DPM,"dpm_hc");
           if ( !ARG0(arg) )
                   *rp = 0;
           else
                   *rp = BDY((DPM)ARG0(arg))->c;
   }
   
   
 void Pdpv_ht(NODE arg,LIST *rp)  void Pdpv_ht(NODE arg,LIST *rp)
 {  {
         NODE n;          NODE n;
Line 3220  void Pdpv_hc(NODE arg,LIST *rp)
Line 3520  void Pdpv_hc(NODE arg,LIST *rp)
         if ( pos < 0 )          if ( pos < 0 )
                 hc = 0;                  hc = 0;
         else          else
                 hc = BDY(BDY(p)[pos])->c;                  hc = (P)BDY(BDY(p)[pos])->c;
         STOQ(pos,q);          STOQ(pos,q);
         n = mknode(2,q,hc);          n = mknode(2,q,hc);
         MKLIST(*rp,n);          MKLIST(*rp,n);

Legend:
Removed from v.1.102  
changed lines
  Added in v.1.107

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>