=================================================================== RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/gr.c,v retrieving revision 1.37 retrieving revision 1.41 diff -u -p -r1.37 -r1.41 --- OpenXM_contrib2/asir2000/builtin/gr.c 2001/10/09 01:36:06 1.37 +++ OpenXM_contrib2/asir2000/builtin/gr.c 2002/01/28 00:54:41 1.41 @@ -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/gr.c,v 1.36 2001/10/01 01:58:02 noro Exp $ + * $OpenXM: OpenXM_contrib2/asir2000/builtin/gr.c,v 1.40 2001/11/19 01:40:04 noro Exp $ */ #include "ca.h" #include "parse.h" @@ -1779,7 +1779,7 @@ DP_pairs newpairs( NODE /* of index */ g, int t ) p->lcm = lcm_of_DL(CNVars, dl = psh[dp], tdl, (DL)0 ); #if 0 if ( do_weyl ) - p->sugar = dl_weight(p->lcm); + p->sugar = dl_weyl_weight(p->lcm); else #endif p->sugar = (ts > (s = pss[dp] - dl->td) ? ts : s) + p->lcm->td; @@ -1946,7 +1946,8 @@ int dl_redble(DL dl1,DL dl2) return 1; } -int dl_weight(DL dl) +#if 0 +int dl_weyl_weight(DL dl) { int n,w,i; @@ -1955,6 +1956,7 @@ int dl_weight(DL dl) w += (-dl->d[i]+dl->d[n+i]); return w; } +#endif int gbcheck(NODE f) { @@ -1992,6 +1994,40 @@ int gbcheck(NODE f) if ( DP_Print || DP_PrintShort ) fprintf(asir_out,"\n"); return 1; +} + +void gbcheck_list(NODE f,int n,VECT *gp,LIST *pp) +{ + int i; + NODE r,g,gall,u,u0,t; + VECT vect; + LIST pair; + DP_pairs d,l; + Q q1,q2; + + /* we need the following settings */ + NVars = CNVars = n; + setup_arrays(f,0,&r); + for ( gall = g = 0, d = 0; r; r = NEXT(r) ) { + i = (int)BDY(r); + d = updpairs(d,g,i); + g = updbase(g,i); + gall = append_one(gall,i); + } + NEWVECT(vect); vect->len = psn; vect->body = (pointer)ps; + *gp = vect; + + for ( u0 = 0, l = d; l; l = NEXT(l) ) { + NEXTNODE(u0,u); + STOQ(l->dp1,q1); + STOQ(l->dp2,q2); + t = mknode(2,q1,q2); + MKLIST(pair,t); + BDY(u) = (pointer)pair; + } + if ( u0 ) + NEXT(u) = 0; + MKLIST(*pp,u0); } int membercheck(NODE f,NODE x)