===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2018/builtin/dp.c,v
retrieving revision 1.22
retrieving revision 1.25
diff -u -p -r1.22 -r1.25
--- OpenXM_contrib2/asir2018/builtin/dp.c	2020/01/09 01:47:40	1.22
+++ OpenXM_contrib2/asir2018/builtin/dp.c	2020/06/30 01:52:17	1.25
@@ -45,7 +45,7 @@
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *
- * $OpenXM: OpenXM_contrib2/asir2018/builtin/dp.c,v 1.21 2019/12/27 08:13:59 noro Exp $
+ * $OpenXM: OpenXM_contrib2/asir2018/builtin/dp.c,v 1.24 2020/06/19 10:18:13 noro Exp $
 */
 #include "ca.h"
 #include "base.h"
@@ -113,6 +113,7 @@ void Pdp_nf_f(),Pdp_weyl_nf_f();
 void Pdpm_nf_f(),Pdpm_weyl_nf_f();
 void Pdp_lnf_f();
 void Pnd_gr(),Pnd_gr_trace(),Pnd_f4(),Pnd_f4_trace();
+void Pnd_sba(),Pnd_sba_f4();
 void Pnd_gr_postproc(), Pnd_weyl_gr_postproc();
 void Pnd_gr_recompute_trace(), Pnd_btog();
 void Pnd_weyl_gr(),Pnd_weyl_gr_trace();
@@ -194,6 +195,8 @@ struct ftab dp_tab[] = {
   {"dp_gr_checklist",Pdp_gr_checklist,2},
   {"nd_f4",Pnd_f4,-4},
   {"nd_gr",Pnd_gr,-4},
+  {"nd_sba",Pnd_sba,-4},
+  {"nd_sba_f4",Pnd_sba_f4,-4},
   {"nd_gr_trace",Pnd_gr_trace,-5},
   {"nd_f4_trace",Pnd_f4_trace,-5},
   {"nd_gr_postproc",Pnd_gr_postproc,5},
@@ -3008,6 +3011,94 @@ void Pnd_gr(NODE arg,LIST *rp)
   nd_gr(f,v,m,homo,retdp,0,ord,rp);
 }
 
+void nd_sba(LIST f,LIST v,int m,int homo,int retdp,int f4,struct order_spec *ord,LIST *rp);
+
+void Pnd_sba(NODE arg,LIST *rp)
+{
+  LIST f,v;
+  int m,homo,retdp,ac;
+  Obj val;
+  Z mq,z;
+  Num nhomo;
+  NODE node;
+  struct order_spec *ord;
+
+  do_weyl = 0;
+  retdp = 0;
+  if ( (ac=argc(arg)) == 4 ) {
+    asir_assert(ARG0(arg),O_LIST,"nd_sba");
+    asir_assert(ARG1(arg),O_LIST,"nd_sba");
+    asir_assert(ARG2(arg),O_N,"nd_sba");
+    f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+    f = remove_zero_from_list(f);
+    if ( !BDY(f) ) {
+      *rp = f; return;
+    }
+      mq = (Z)ARG2(arg);
+      STOZ(0x40000000,z);
+      if ( cmpz(mq,z) >= 0 ) {
+        node = mknode(1,mq);
+        Psetmod_ff(node,&val);
+        m = -2;
+      } else
+        m = ZTOS(mq);
+    create_order_spec(0,ARG3(arg),&ord);
+    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 = ZTOS((Q)nhomo);
+    if ( get_opt("dp",&val) && val ) retdp = 1;
+  } else
+    error("nd_gr : invalid argument");
+  nd_sba(f,v,m,homo,retdp,0,ord,rp);
+}
+
+void Pnd_sba_f4(NODE arg,LIST *rp)
+{
+  LIST f,v;
+  int m,homo,retdp,ac;
+  Obj val;
+  Z mq,z;
+  Num nhomo;
+  NODE node;
+  struct order_spec *ord;
+
+  do_weyl = 0;
+  retdp = 0;
+  if ( (ac=argc(arg)) == 4 ) {
+    asir_assert(ARG0(arg),O_LIST,"nd_sba");
+    asir_assert(ARG1(arg),O_LIST,"nd_sba");
+    asir_assert(ARG2(arg),O_N,"nd_sba");
+    f = (LIST)ARG0(arg); v = (LIST)ARG1(arg);
+    f = remove_zero_from_list(f);
+    if ( !BDY(f) ) {
+      *rp = f; return;
+    }
+      mq = (Z)ARG2(arg);
+      STOZ(0x40000000,z);
+      if ( cmpz(mq,z) >= 0 ) {
+        node = mknode(1,mq);
+        Psetmod_ff(node,&val);
+        m = -2;
+      } else
+        m = ZTOS(mq);
+    create_order_spec(0,ARG3(arg),&ord);
+    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 = ZTOS((Q)nhomo);
+    if ( get_opt("dp",&val) && val ) retdp = 1;
+  } else
+    error("nd_gr : invalid argument");
+  nd_sba(f,v,m,homo,retdp,1,ord,rp);
+}
+
 void Pnd_gr_postproc(NODE arg,LIST *rp)
 {
   LIST f,v;
@@ -4084,7 +4175,7 @@ void Pdpm_set_schreyer(NODE arg,LIST *rp)
 }
 
 DMMstack_array Schreyer_Frame;
-DMMstack_array dpm_schreyer_frame(NODE n);
+DMMstack_array dpm_schreyer_frame(NODE n,int lex);
 void set_schreyer_level(DMMstack_array array,int level);
 
 void Pdpm_set_schreyer_level(NODE arg,Q *rp)
@@ -4093,10 +4184,6 @@ void Pdpm_set_schreyer_level(NODE arg,Q *rp)
   *rp = (Q)ARG0(arg);
 }
 
-DPM dmmtodpm(DMM d)
-{
-}
-
 void Pdpm_schreyer_frame(NODE arg,LIST *rp)
 {
   DMMstack_array a;
@@ -4107,9 +4194,25 @@ void Pdpm_schreyer_frame(NODE arg,LIST *rp)
   LIST l;
   VECT v;
   Z lev,deg,ind;
-  int len,i,nv,rank,j;
+  int len,i,nv,rank,j,lex;
+  NODE tt,p;
+  char *key;
+  Obj value;
 
-  Schreyer_Frame = a = dpm_schreyer_frame(BDY((LIST)ARG0(arg)));
+  lex = 0;
+  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,"lex") )
+        lex = value!=0?1:0;
+      else {
+        error("dpm_schreyer_frame: unknown option.");
+      }
+    }
+  }
+  Schreyer_Frame = a = dpm_schreyer_frame(BDY((LIST)ARG0(arg)),lex);
   len = a->len;
   body = a->body;
   /* XXX */