source: git/kernel/ring.cc @ 611871

spielwiese
Last change on this file since 611871 was 611871, checked in by Hans Schoenemann <hannes@…>, 13 years ago
rename memcpy4 -> memcpy git-svn-id: file:///usr/local/Singular/svn/trunk@14072 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 142.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id$ */
5
6/*
7* ABSTRACT - the interpreter related ring operations
8*/
9
10/* includes */
11#include <math.h>
12#include <kernel/mod2.h>
13
14#include <kernel/options.h>
15#include <omalloc/omalloc.h>
16#include <kernel/polys.h>
17#include <kernel/numbers.h>
18#include <kernel/febase.h>
19#include <kernel/intvec.h>
20#include <kernel/longtrans.h>
21#include <kernel/ffields.h>
22#include <kernel/ideals.h>
23#include <kernel/ring.h>
24#include <kernel/prCopy.h>
25#include <Singular/ipshell.h>
26#include <kernel/p_Procs.h>
27#ifdef HAVE_PLURAL
28#include <kernel/gring.h>
29#include <kernel/sca.h>
30#endif
31#include <kernel/maps.h>
32#include <kernel/matpol.h>
33#ifdef HAVE_FACTORY
34#define SI_DONT_HAVE_GLOBAL_VARS
35#  include <factory/factory.h>
36#endif
37
38#define BITS_PER_LONG 8*SIZEOF_LONG
39
40omBin sip_sring_bin = omGetSpecBin(sizeof(sip_sring));
41
42static const char * const ringorder_name[] =
43{
44  " ?", ///< ringorder_no = 0,
45  "a", ///< ringorder_a,
46  "A", ///< ringorder_a64,
47  "c", ///< ringorder_c,
48  "C", ///< ringorder_C,
49  "M", ///< ringorder_M,
50  "S", ///< ringorder_S,
51  "s", ///< ringorder_s,
52  "lp", ///< ringorder_lp,
53  "dp", ///< ringorder_dp,
54  "rp", ///< ringorder_rp,
55  "Dp", ///< ringorder_Dp,
56  "wp", ///< ringorder_wp,
57  "Wp", ///< ringorder_Wp,
58  "ls", ///< ringorder_ls,
59  "ds", ///< ringorder_ds,
60  "Ds", ///< ringorder_Ds,
61  "ws", ///< ringorder_ws,
62  "Ws", ///< ringorder_Ws,
63  "L", ///< ringorder_L,
64  "aa", ///< ringorder_aa
65  "rs", ///< ringorder_rs,
66  "IS", ///<  ringorder_IS
67  " _" ///< ringorder_unspec
68};
69
70const char * rSimpleOrdStr(int ord)
71{
72  return ringorder_name[ord];
73}
74
75/// unconditionally deletes fields in r
76void rDelete(ring r);
77/// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
78static void rSetVarL(ring r);
79/// get r->divmask depending on bits per exponent
80static unsigned long rGetDivMask(int bits);
81/// right-adjust r->VarOffset
82static void rRightAdjustVarOffset(ring r);
83static void rOptimizeLDeg(ring r);
84
85/*0 implementation*/
86//BOOLEAN rField_is_R(ring r=currRing)
87//{
88//  if (r->ch== -1)
89//  {
90//    if (r->float_len==(short)0) return TRUE;
91//  }
92//  return FALSE;
93//}
94
95/// internally changes the gloabl ring and resets the relevant
96/// global variables:
97void rChangeCurrRing(ring r)
98{
99 // if ((currRing!=NULL) && (currRing->minpoly!=NULL))
100 // {
101 //   omCheckAddr(currRing->minpoly);
102 // }
103  /*------------ set global ring vars --------------------------------*/
104  currRing = r;
105  currQuotient=NULL;
106  if (r != NULL)
107  {
108    rTest(r);
109    /*------------ set global ring vars --------------------------------*/
110    currQuotient=r->qideal;
111
112    /*------------ global variables related to coefficients ------------*/
113    nSetChar(r);
114
115    /*------------ global variables related to polys -------------------*/
116    pSetGlobals(r);
117    /*------------ global variables related to factory -------------------*/
118#ifdef HAVE_FACTORY
119    //int c=ABS(nGetChar());
120    //if (c==1) c=0;
121    //setCharacteristic( c );
122#endif
123  }
124}
125
126ring rDefault(int ch, int N, char **n,int ord_size, int *ord, int *block0, int *block1)
127{
128  ring r=(ring) omAlloc0Bin(sip_sring_bin);
129  r->ch    = ch;
130  r->N     = N;
131  /*r->P     = 0; Alloc0 */
132  /*names*/
133  r->names = (char **) omAlloc0(N * sizeof(char_ptr));
134  int i;
135  for(i=0;i<N;i++)
136  {
137    r->names[i]  = omStrDup(n[i]);
138  }
139  /*weights: entries for 2 blocks: NULL*/
140  r->wvhdl = (int **)omAlloc0((ord_size+1) * sizeof(int_ptr));
141  r->order = ord;
142  r->block0 = block0;
143  r->block1 = block1;
144  /*polynomial ring*/
145  r->OrdSgn    = 1;
146
147  /* complete ring intializations */
148  rComplete(r);
149  return r;
150}
151
152ring rDefault(int ch, int N, char **n)
153{
154  /*order: lp,0*/
155  int *order = (int *) omAlloc(2* sizeof(int));
156  int *block0 = (int *)omAlloc0(2 * sizeof(int));
157  int *block1 = (int *)omAlloc0(2 * sizeof(int));
158  /* ringorder dp for the first block: var 1..N */
159  order[0]  = ringorder_lp;
160  block0[0] = 1;
161  block1[0] = N;
162  /* the last block: everything is 0 */
163  order[1]  = 0;
164
165  return rDefault(ch,N,n,2,order,block0,block1);
166}
167
168///////////////////////////////////////////////////////////////////////////
169//
170// rInit: define a new ring from sleftv's
171//
172//-> ipshell.cc
173
174/////////////////////////////
175// Auxillary functions
176//
177
178// check intvec, describing the ordering
179BOOLEAN rCheckIV(intvec *iv)
180{
181  if ((iv->length()!=2)&&(iv->length()!=3))
182  {
183    WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
184    return TRUE;
185  }
186  return FALSE;
187}
188
189int rTypeOfMatrixOrder(intvec * order)
190{
191  int i=0,j,typ=1;
192  int sz = (int)sqrt((double)(order->length()-2));
193  if ((sz*sz)!=(order->length()-2))
194  {
195    WerrorS("Matrix order is not a square matrix");
196    typ=0;
197  }
198  while ((i<sz) && (typ==1))
199  {
200    j=0;
201    while ((j<sz) && ((*order)[j*sz+i+2]==0)) j++;
202    if (j>=sz)
203    {
204      typ = 0;
205      WerrorS("Matrix order not complete");
206    }
207    else if ((*order)[j*sz+i+2]<0)
208      typ = -1;
209    else
210      i++;
211  }
212  return typ;
213}
214
215// set R->order, R->block, R->wvhdl, r->OrdSgn from sleftv
216BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R);
217
218// get array of strings from list of sleftv's
219BOOLEAN rSleftvList2StringArray(sleftv* sl, char** p);
220
221
222/*2
223 * set a new ring from the data:
224 s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
225 */
226
227int r_IsRingVar(const char *n, ring r)
228{
229  if ((r!=NULL) && (r->names!=NULL))
230  {
231    for (int i=0; i<r->N; i++)
232    {
233      if (r->names[i]==NULL) return -1;
234      if (strcmp(n,r->names[i]) == 0) return (int)i;
235    }
236  }
237  return -1;
238}
239
240
241void rWrite(ring r)
242{
243  if ((r==NULL)||(r->order==NULL))
244    return; /*to avoid printing after errors....*/
245
246  int nblocks=rBlocks(r);
247
248  // omCheckAddrSize(r,sizeof(ip_sring));
249  omCheckAddrSize(r->order,nblocks*sizeof(int));
250  omCheckAddrSize(r->block0,nblocks*sizeof(int));
251  omCheckAddrSize(r->block1,nblocks*sizeof(int));
252  omCheckAddrSize(r->wvhdl,nblocks*sizeof(int_ptr));
253  omCheckAddrSize(r->names,r->N*sizeof(char_ptr));
254
255  nblocks--;
256
257
258  if (rField_is_GF(r))
259  {
260    Print("//   # ground field : %d\n",rInternalChar(r));
261    Print("//   primitive element : %s\n", r->parameter[0]);
262    if (r==currRing)
263    {
264      StringSetS("//   minpoly        : ");
265      nfShowMipo();PrintS(StringAppendS("\n"));
266    }
267  }
268#ifdef HAVE_RINGS
269  else if (rField_is_Ring(r))
270  {
271    PrintS("//   coeff. ring is : ");
272    if (rField_is_Ring_Z(r)) PrintS("Integers\n");
273    long l = (long)mpz_sizeinbase(r->ringflaga, 10) + 2;
274    char* s = (char*) omAlloc(l);
275    mpz_get_str(s,10,r->ringflaga);
276    if (rField_is_Ring_ModN(r)) Print("Z/%s\n", s);
277    if (rField_is_Ring_2toM(r)) Print("Z/2^%lu\n", r->ringflagb);
278    if (rField_is_Ring_PtoM(r)) Print("Z/%s^%lu\n", s, r->ringflagb);
279    omFreeSize((ADDRESS)s, l);
280  }
281#endif
282  else
283  {
284    PrintS("//   characteristic : ");
285    if ( rField_is_R(r) )             PrintS("0 (real)\n");  /* R */
286    else if ( rField_is_long_R(r) )
287      Print("0 (real:%d digits, additional %d digits)\n",
288             r->float_len,r->float_len2);  /* long R */
289    else if ( rField_is_long_C(r) )
290      Print("0 (complex:%d digits, additional %d digits)\n",
291             r->float_len, r->float_len2);  /* long C */
292    else
293      Print ("%d\n",rChar(r)); /* Fp(a) */
294    if (r->parameter!=NULL)
295    {
296      Print ("//   %d parameter    : ",rPar(r));
297      char **sp=r->parameter;
298      int nop=0;
299      while (nop<rPar(r))
300      {
301        PrintS(*sp);
302        PrintS(" ");
303        sp++; nop++;
304      }
305      PrintS("\n//   minpoly        : ");
306      if ( rField_is_long_C(r) )
307      {
308        // i^2+1:
309        Print("(%s^2+1)\n",r->parameter[0]);
310      }
311      else if (r->minpoly==NULL)
312      {
313        PrintS("0\n");
314      }
315      else if (r==currRing)
316      {
317        StringSetS(""); nWrite(r->minpoly); PrintS(StringAppendS("\n"));
318      }
319      else
320      {
321        PrintS("...\n");
322      }
323      if (r->minideal!=NULL)
324      {
325        if (r==currRing) iiWriteMatrix((matrix)r->minideal,"//   minpolys",1,0);
326        else PrintS("//   minpolys=...");
327        PrintLn();
328      }
329    }
330  }
331  Print("//   number of vars : %d",r->N);
332
333  //for (nblocks=0; r->order[nblocks]; nblocks++);
334  nblocks=rBlocks(r)-1;
335
336  for (int l=0, nlen=0 ; l<nblocks; l++)
337  {
338    int i;
339    Print("\n//        block %3d : ",l+1);
340
341    Print("ordering %s", rSimpleOrdStr(r->order[l]));
342
343
344    if (r->order[l] == ringorder_s)
345    {
346      assume( l == 0 );
347#ifndef NDEBUG
348      Print("  syzcomp at %d",r->typ[l].data.syz.limit);
349#endif
350      continue;
351    }
352    else if (r->order[l] == ringorder_IS)
353    {
354      assume( r->block0[l] == r->block1[l] );
355      const int s = r->block0[l];
356      assume( (-2 < s) && (s < 2) );
357      Print("(%d)", s); // 0 => prefix! +/-1 => suffix!
358      continue;
359    }
360    else if (
361    (  (r->order[l] >= ringorder_lp)
362    ||(r->order[l] == ringorder_M)
363    ||(r->order[l] == ringorder_a)
364    ||(r->order[l] == ringorder_a64)
365    ||(r->order[l] == ringorder_aa) ) && (r->order[l] < ringorder_IS) )
366    {
367      PrintS("\n//                  : names   ");
368      for (i = r->block0[l]-1; i<r->block1[l]; i++)
369      {
370        nlen = strlen(r->names[i]);
371        Print(" %s",r->names[i]);
372      }
373    }
374
375    if (r->wvhdl[l]!=NULL)
376    {
377      for (int j= 0;
378           j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
379           j+=i)
380      {
381        PrintS("\n//                  : weights ");
382        for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
383        {
384          if (r->order[l] == ringorder_a64)
385          {
386            int64 *w=(int64 *)r->wvhdl[l];
387            #if SIZEOF_LONG == 4
388                  Print("%*lld " ,nlen,w[i+j],i+j);
389            #else
390            Print(" %*ld"  ,nlen,w[i+j],i+j);
391            #endif
392          }
393          else
394            Print(" %*d" ,nlen,r->wvhdl[l][i+j],i+j);
395        }
396        if (r->order[l]!=ringorder_M) break;
397      }
398    }
399  }
400#ifdef HAVE_PLURAL
401  if(rIsPluralRing(r))
402  {
403    PrintS("\n//   noncommutative relations:");
404    if (r==currRing)
405    {
406      poly pl=NULL;
407      int nl;
408      int i,j;
409      for (i = 1; i<r->N; i++)
410      {
411        for (j = i+1; j<=r->N; j++)
412        {
413          nl = nIsOne(p_GetCoeff(MATELEM(r->GetNC()->C,i,j),r->GetNC()->basering));
414          if ( (MATELEM(r->GetNC()->D,i,j)!=NULL) || (!nl) )
415          {
416            Print("\n//    %s%s=",r->names[j-1],r->names[i-1]);
417            pl = MATELEM(r->GetNC()->MT[UPMATELEM(i,j,r->N)],1,1);
418            p_Write0(pl, r, r);
419          }
420        }
421      }
422    }
423    else PrintS(" ...");
424#if 0  /*Singularg should not differ from Singular except in error case*/
425    Print("\n//   noncommutative type:%d", (int)ncRingType(r));
426    Print("\n//      is skew constant:%d",r->GetNC()->IsSkewConstant);
427    if( rIsSCA(r) )
428    {
429      Print("\n//   alternating variables: [%d, %d]", scaFirstAltVar(r), scaLastAltVar(r));
430      const ideal Q = SCAQuotient(r); // resides within r!
431      PrintS("\n//   quotient of sca by ideal");
432
433      if (Q!=NULL)
434      {
435        if (r==currRing)
436        {
437          PrintLn();
438          iiWriteMatrix((matrix)Q,"scaQ",1);
439        }
440        else PrintS(" ...");
441      }
442      else
443        PrintS(" (NULL)");
444    }
445#endif
446  }
447#endif
448  if (r->qideal!=NULL)
449  {
450    PrintS("\n// quotient ring from ideal");
451    if (r==currRing)
452    {
453      PrintLn();
454      iiWriteMatrix((matrix)r->qideal,"_",1);
455    }
456    else PrintS(" ...");
457  }
458}
459
460void rDelete(ring r)
461{
462  int i, j;
463
464  if (r == NULL) return;
465
466#ifdef HAVE_PLURAL
467  if (rIsPluralRing(r))
468    nc_rKill(r);
469#endif
470
471  nKillChar(r);
472  rUnComplete(r);
473  // delete order stuff
474  if (r->order != NULL)
475  {
476    i=rBlocks(r);
477    assume(r->block0 != NULL && r->block1 != NULL && r->wvhdl != NULL);
478    // delete order
479    omFreeSize((ADDRESS)r->order,i*sizeof(int));
480    omFreeSize((ADDRESS)r->block0,i*sizeof(int));
481    omFreeSize((ADDRESS)r->block1,i*sizeof(int));
482    // delete weights
483    for (j=0; j<i; j++)
484    {
485      if (r->wvhdl[j]!=NULL)
486        omFree(r->wvhdl[j]);
487    }
488    omFreeSize((ADDRESS)r->wvhdl,i*sizeof(int *));
489  }
490  else
491  {
492    assume(r->block0 == NULL && r->block1 == NULL && r->wvhdl == NULL);
493  }
494
495  // delete varnames
496  if(r->names!=NULL)
497  {
498    for (i=0; i<r->N; i++)
499    {
500      if (r->names[i] != NULL) omFree((ADDRESS)r->names[i]);
501    }
502    omFreeSize((ADDRESS)r->names,r->N*sizeof(char_ptr));
503  }
504
505  // delete parameter
506  if (r->parameter!=NULL)
507  {
508    char **s=r->parameter;
509    j = 0;
510    while (j < rPar(r))
511    {
512      if (*s != NULL) omFree((ADDRESS)*s);
513      s++;
514      j++;
515    }
516    omFreeSize((ADDRESS)r->parameter,rPar(r)*sizeof(char_ptr));
517  }
518#ifdef HAVE_RINGS
519  if (r->ringflaga != NULL)
520  {
521    mpz_clear(r->ringflaga);
522    omFree((ADDRESS)r->ringflaga);
523  }
524  if (r->nrnModul != NULL)
525  {
526    mpz_clear(r->nrnModul);
527    omFree((ADDRESS)r->nrnModul);
528  }
529#endif
530  omFreeBin(r, sip_sring_bin);
531}
532
533int rOrderName(char * ordername)
534{
535  int order=ringorder_unspec;
536  while (order!= 0)
537  {
538    if (strcmp(ordername,rSimpleOrdStr(order))==0)
539      break;
540    order--;
541  }
542  if (order==0) Werror("wrong ring order `%s`",ordername);
543  omFree((ADDRESS)ordername);
544  return order;
545}
546
547char * rOrdStr(ring r)
548{
549  if ((r==NULL)||(r->order==NULL)) return omStrDup("");
550  int nblocks,l,i;
551
552  for (nblocks=0; r->order[nblocks]; nblocks++);
553  nblocks--;
554
555  StringSetS("");
556  for (l=0; ; l++)
557  {
558    StringAppendS((char *)rSimpleOrdStr(r->order[l]));
559    if (
560           (r->order[l] != ringorder_c)
561        && (r->order[l] != ringorder_C)
562        && (r->order[l] != ringorder_s)
563        && (r->order[l] != ringorder_S)
564        && (r->order[l] != ringorder_IS)
565       )
566    {
567      if (r->wvhdl[l]!=NULL)
568      {
569        StringAppendS("(");
570        for (int j= 0;
571             j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
572             j+=i+1)
573        {
574          char c=',';
575          if(r->order[l]==ringorder_a64)
576          {
577            int64 * w=(int64 *)r->wvhdl[l];
578            for (i = 0; i<r->block1[l]-r->block0[l]; i++)
579            {
580              StringAppend("%lld," ,w[i]);
581            }
582            StringAppend("%lld)" ,w[i]);
583            break;
584          }
585          else
586          {
587            for (i = 0; i<r->block1[l]-r->block0[l]; i++)
588            {
589              StringAppend("%d," ,r->wvhdl[l][i+j]);
590            }
591          }
592          if (r->order[l]!=ringorder_M)
593          {
594            StringAppend("%d)" ,r->wvhdl[l][i+j]);
595            break;
596          }
597          if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
598            c=')';
599          StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
600        }
601      }
602      else
603        StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
604    }
605    else if (r->order[l] == ringorder_IS)
606    {
607      assume( r->block0[l] == r->block1[l] );
608      const int s = r->block0[l];
609      assume( (-2 < s) && (s < 2) );
610
611      StringAppend("(%d)", s);
612    }
613
614    if (l==nblocks) return omStrDup(StringAppendS(""));
615    StringAppendS(",");
616  }
617}
618
619char * rVarStr(ring r)
620{
621  if ((r==NULL)||(r->names==NULL)) return omStrDup("");
622  int i;
623  int l=2;
624  char *s;
625
626  for (i=0; i<r->N; i++)
627  {
628    l+=strlen(r->names[i])+1;
629  }
630  s=(char *)omAlloc((long)l);
631  s[0]='\0';
632  for (i=0; i<r->N-1; i++)
633  {
634    strcat(s,r->names[i]);
635    strcat(s,",");
636  }
637  strcat(s,r->names[i]);
638  return s;
639}
640
641char * rCharStr(ring r)
642{
643  char *s;
644  int i;
645
646#ifdef HAVE_RINGS
647  if (rField_is_Ring_Z(r))
648  {
649    s=omStrDup("integer");                   /* Z */
650    return s;
651  }
652  if(rField_is_Ring_2toM(r))
653  {
654    char* s = (char*) omAlloc(7+10+2);
655    sprintf(s,"integer,%lu",r->ringflagb);
656    return s;
657  }
658  if(rField_is_Ring_ModN(r))
659  {
660    long l = (long)mpz_sizeinbase(r->ringflaga, 10) + 2+7;
661    char* s = (char*) omAlloc(l);
662    gmp_sprintf(s,"integer,%Zd",r->ringflaga);
663    return s;
664  }
665  if(rField_is_Ring_PtoM(r))
666  {
667    long l = (long)mpz_sizeinbase(r->ringflaga, 10) + 2+7+10;
668    char* s = (char*) omAlloc(l);
669    gmp_sprintf(s,"integer,%Zd^%lu",r->ringflaga,r->ringflagb);
670    return s;
671  }
672#endif
673  if (r->parameter==NULL)
674  {
675    i=r->ch;
676    if(i==-1)
677      s=omStrDup("real");                    /* R */
678    else
679    {
680      s=(char *)omAlloc(MAX_INT_LEN+1);
681      sprintf(s,"%d",i);                   /* Q, Z/p */
682    }
683    return s;
684  }
685  if (rField_is_long_C(r))
686  {
687    s=(char *)omAlloc(21+strlen(r->parameter[0]));
688    sprintf(s,"complex,%d,%s",r->float_len,r->parameter[0]);   /* C */
689    return s;
690  }
691  int l=0;
692  for(i=0; i<rPar(r);i++)
693  {
694    l+=(strlen(r->parameter[i])+1);
695  }
696  s=(char *)omAlloc((long)(l+MAX_INT_LEN+1));
697  s[0]='\0';
698  if (r->ch<0)       sprintf(s,"%d",-r->ch); /* Fp(a) */
699  else if (r->ch==1) sprintf(s,"0");         /* Q(a)  */
700  else
701  {
702    sprintf(s,"%d,%s",r->ch,r->parameter[0]); /* GF(q)  */
703    return s;
704  }
705  char tt[2];
706  tt[0]=',';
707  tt[1]='\0';
708  for(i=0; i<rPar(r);i++)
709  {
710    strcat(s,tt);
711    strcat(s,r->parameter[i]);
712  }
713  return s;
714}
715
716char * rParStr(ring r)
717{
718  if ((r==NULL)||(r->parameter==NULL)) return omStrDup("");
719
720  int i;
721  int l=2;
722
723  for (i=0; i<rPar(r); i++)
724  {
725    l+=strlen(r->parameter[i])+1;
726  }
727  char *s=(char *)omAlloc((long)l);
728  s[0]='\0';
729  for (i=0; i<rPar(r)-1; i++)
730  {
731    strcat(s,r->parameter[i]);
732    strcat(s,",");
733  }
734  strcat(s,r->parameter[i]);
735  return s;
736}
737
738char * rString(ring r)
739{
740  char *ch=rCharStr(r);
741  char *var=rVarStr(r);
742  char *ord=rOrdStr(r);
743  char *res=(char *)omAlloc(strlen(ch)+strlen(var)+strlen(ord)+9);
744  sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
745  omFree((ADDRESS)ch);
746  omFree((ADDRESS)var);
747  omFree((ADDRESS)ord);
748  return res;
749}
750
751int  rIsExtension(const ring r)
752{
753  return (r->parameter!=NULL); /* R, Q, Fp: FALSE */
754}
755
756static int binaryPower (const int a, const int b)
757{
758  /* computes a^b according to the binary representation of b,
759     i.e., a^7 = a^4 * a^2 * a^1. This saves some multiplications. */
760  int result = 1;
761  int factor = a;
762  int bb = b;
763  while (bb != 0)
764  {
765    if (bb % 2 != 0) result = result * factor;
766    bb = bb / 2;
767    factor = factor * factor;
768  }
769  return result;
770}
771
772int rChar(ring r)
773{
774#ifdef HAVE_RINGS
775  if (rField_is_Ring_2toM(r))
776    return binaryPower(2, (int)(unsigned long)r->ringflagb);
777  if (rField_is_Ring_ModN(r))
778    return (int)mpz_get_ui(r->ringflaga);
779  if (rField_is_Ring_PtoM(r))
780    return binaryPower((int)mpz_get_ui(r->ringflaga),
781                       (int)(unsigned long)r->ringflagb);
782#endif
783  if (rField_is_numeric(r))
784    return 0;
785  if (!rIsExtension(r)) /* Q, Fp */
786    return r->ch;
787  if (rField_is_Zp_a(r))  /* Fp(a)  */
788    return -r->ch;
789  if (rField_is_Q_a(r))   /* Q(a)  */
790    return 0;
791  /*else*/               /* GF(p,n) */
792  {
793    if ((r->ch & 1)==0) return 2;
794    int i=3;
795    while ((r->ch % i)!=0) i+=2;
796    return i;
797  }
798}
799
800/*2
801 *returns -1 for not compatible, (sum is undefined)
802 *         1 for compatible (and sum)
803 */
804/* vartest: test for variable/paramter names
805* dp_dp: for comm. rings: use block order dp + dp/ds/wp
806*/
807int rSumInternal(ring r1, ring r2, ring &sum, BOOLEAN vartest, BOOLEAN dp_dp)
808{
809  ring save=currRing;
810  ip_sring tmpR;
811  memset(&tmpR,0,sizeof(tmpR));
812  /* check coeff. field =====================================================*/
813  if ((rFieldType(r1)==rFieldType(r2))
814  && (rInternalChar(r1)==rInternalChar(r2)))
815  {
816    tmpR.ch=rInternalChar(r1);
817    if (rField_is_Q(r1)||rField_is_Zp(r1)||rField_is_GF(r1)) /*Q, Z/p, GF(p,n)*/
818    {
819      if (r1->parameter!=NULL)
820      {
821        if (!vartest || (strcmp(r1->parameter[0],r2->parameter[0])==0)) /* 1 par */
822        {
823          tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
824          tmpR.parameter[0]=omStrDup(r1->parameter[0]);
825          tmpR.P=1;
826        }
827        else
828        {
829          WerrorS("GF(p,n)+GF(p,n)");
830          return -1;
831        }
832      }
833    }
834    else if (rField_is_Extension(r1)) /* Q(a),Z/p(a) */
835    {
836      if (r1->minpoly!=NULL)
837      {
838        if (r2->minpoly!=NULL)
839        {
840          // HANNES: TODO: delete nSetChar
841          rChangeCurrRing(r1);
842          if ((!vartest || (strcmp(r1->parameter[0],r2->parameter[0])==0)) /* 1 par */
843              && n_Equal(r1->minpoly,r2->minpoly, r1))
844          {
845            tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
846            tmpR.parameter[0]=omStrDup(r1->parameter[0]);
847            tmpR.minpoly=n_Copy(r1->minpoly, r1);
848            tmpR.P=1;
849            // HANNES: TODO: delete nSetChar
850            rChangeCurrRing(save);
851          }
852          else
853          {
854            // HANNES: TODO: delete nSetChar
855            rChangeCurrRing(save);
856            WerrorS("different minpolys");
857            return -1;
858          }
859        }
860        else
861        {
862          if ((!vartest || (strcmp(r1->parameter[0],r2->parameter[0])==0)) /* 1 par */
863              && (rPar(r2)==1))
864          {
865            tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
866            tmpR.parameter[0]=omStrDup(r1->parameter[0]);
867            tmpR.P=1;
868            tmpR.minpoly=n_Copy(r1->minpoly, r1);
869          }
870          else
871          {
872            WerrorS("different parameters and minpoly!=0");
873            return -1;
874          }
875        }
876      }
877      else /* r1->minpoly==NULL */
878      {
879        if (r2->minpoly!=NULL)
880        {
881          if ((!vartest || (strcmp(r1->parameter[0],r2->parameter[0])==0)) /* 1 par */
882              && (rPar(r1)==1))
883          {
884            tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
885            tmpR.parameter[0]=omStrDup(r1->parameter[0]);
886            tmpR.P=1;
887            tmpR.minpoly=n_Copy(r2->minpoly, r2);
888          }
889          else
890          {
891            WerrorS("different parameters and minpoly!=0");
892            return -1;
893          }
894        }
895        else
896        {
897          int len=rPar(r1)+rPar(r2);
898          tmpR.parameter=(char **)omAlloc0(len*sizeof(char_ptr));
899          int i;
900          for (i=0;i<rPar(r1);i++)
901          {
902            tmpR.parameter[i]=omStrDup(r1->parameter[i]);
903          }
904          int j,l;
905          for(j=0;j<rPar(r2);j++)
906          {
907            if (vartest)
908            {
909              for(l=0;l<i;l++)
910              {
911                if(strcmp(tmpR.parameter[l],r2->parameter[j])==0)
912                  break;
913              }
914            }
915            else
916              l=i;
917            if (l==i)
918            {
919              tmpR.parameter[i]=omStrDup(r2->parameter[j]);
920              i++;
921            }
922          }
923          if (i!=len)
924          {
925            tmpR.parameter=(char**)omReallocSize(tmpR.parameter,len*sizeof(char_ptr),i*sizeof(char_ptr));
926          }
927          tmpR.P=i;
928        }
929      }
930    }
931    #ifdef HAVE_RINGS
932    else if (rField_is_Ring(r1)||rField_is_Ring(r2))
933    {
934      Werror("rSumInternal for rings coeffs");
935      return -1;
936    }
937    #endif
938  }
939  else /* r1->ch!=r2->ch */
940  {
941    if (r1->ch<-1) /* Z/p(a) */
942    {
943      if ((r2->ch==0) /* Q */
944          || (r2->ch==-r1->ch)) /* Z/p */
945      {
946        tmpR.ch=rInternalChar(r1);
947        tmpR.P=rPar(r1);
948        tmpR.parameter=(char **)omAlloc(rPar(r1)*sizeof(char_ptr));
949        int i;
950        for (i=0;i<rPar(r1);i++)
951        {
952          tmpR.parameter[i]=omStrDup(r1->parameter[i]);
953        }
954        if (r1->minpoly!=NULL)
955        {
956          tmpR.minpoly=n_Copy(r1->minpoly, r1);
957        }
958      }
959      else  /* R, Q(a),Z/q,Z/p(a),GF(p,n) */
960      {
961        WerrorS("Z/p(a)+(R,Q(a),Z/q(a),GF(q,n))");
962        return -1;
963      }
964    }
965    else if (r1->ch==-1) /* R */
966    {
967      WerrorS("R+..");
968      return -1;
969    }
970    else if (r1->ch==0) /* Q */
971    {
972      if ((r2->ch<-1)||(r2->ch==1)) /* Z/p(a),Q(a) */
973      {
974        tmpR.ch=rInternalChar(r2);
975        tmpR.P=rPar(r2);
976        tmpR.parameter=(char **)omAlloc(rPar(r2)*sizeof(char_ptr));
977        int i;
978        for (i=0;i<rPar(r2);i++)
979        {
980          tmpR.parameter[i]=omStrDup(r2->parameter[i]);
981        }
982        if (r2->minpoly!=NULL)
983        {
984          tmpR.minpoly=n_Copy(r2->minpoly, r2);
985        }
986      }
987      else if (r2->ch>1) /* Z/p,GF(p,n) */
988      {
989        tmpR.ch=r2->ch;
990        if (r2->parameter!=NULL)
991        {
992          tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
993          tmpR.P=1;
994          tmpR.parameter[0]=omStrDup(r2->parameter[0]);
995        }
996      }
997      else
998      {
999        WerrorS("Q+R");
1000        return -1; /* R */
1001      }
1002    }
1003    else if (r1->ch==1) /* Q(a) */
1004    {
1005      if (r2->ch==0) /* Q */
1006      {
1007        tmpR.ch=rInternalChar(r1);
1008        tmpR.P=rPar(r1);
1009        tmpR.parameter=(char **)omAlloc(rPar(r1)*sizeof(char_ptr));
1010        int i;
1011        for(i=0;i<rPar(r1);i++)
1012        {
1013          tmpR.parameter[i]=omStrDup(r1->parameter[i]);
1014        }
1015        if (r1->minpoly!=NULL)
1016        {
1017          tmpR.minpoly=n_Copy(r1->minpoly, r1);
1018        }
1019      }
1020      else  /* R, Z/p,GF(p,n) */
1021      {
1022        WerrorS("Q(a)+(R,Z/p,GF(p,n))");
1023        return -1;
1024      }
1025    }
1026    else /* r1->ch >=2 , Z/p */
1027    {
1028      if (r2->ch==0) /* Q */
1029      {
1030        tmpR.ch=r1->ch;
1031      }
1032      else if (r2->ch==-r1->ch) /* Z/p(a) */
1033      {
1034        tmpR.ch=rInternalChar(r2);
1035        tmpR.P=rPar(r2);
1036        tmpR.parameter=(char **)omAlloc(rPar(r2)*sizeof(char_ptr));
1037        int i;
1038        for(i=0;i<rPar(r2);i++)
1039        {
1040          tmpR.parameter[i]=omStrDup(r2->parameter[i]);
1041        }
1042        if (r2->minpoly!=NULL)
1043        {
1044          tmpR.minpoly=n_Copy(r2->minpoly, r2);
1045        }
1046      }
1047      else
1048      {
1049        WerrorS("Z/p+(GF(q,n),Z/q(a),R,Q(a))");
1050        return -1; /* GF(p,n),Z/q(a),R,Q(a) */
1051      }
1052    }
1053  }
1054  /* variable names ========================================================*/
1055  int i,j,k;
1056  int l=r1->N+r2->N;
1057  char **names=(char **)omAlloc0(l*sizeof(char_ptr));
1058  k=0;
1059
1060  // collect all varnames from r1, except those which are parameters
1061  // of r2, or those which are the empty string
1062  for (i=0;i<r1->N;i++)
1063  {
1064    BOOLEAN b=TRUE;
1065
1066    if (*(r1->names[i]) == '\0')
1067      b = FALSE;
1068    else if ((r2->parameter!=NULL) && (strlen(r1->names[i])==1))
1069    {
1070      if (vartest)
1071      {
1072        for(j=0;j<rPar(r2);j++)
1073        {
1074          if (strcmp(r1->names[i],r2->parameter[j])==0)
1075          {
1076            b=FALSE;
1077            break;
1078          }
1079        }
1080      }
1081    }
1082
1083    if (b)
1084    {
1085      //Print("name : %d: %s\n",k,r1->names[i]);
1086      names[k]=omStrDup(r1->names[i]);
1087      k++;
1088    }
1089    //else
1090    //  Print("no name (par1) %s\n",r1->names[i]);
1091  }
1092  // Add variables from r2, except those which are parameters of r1
1093  // those which are empty strings, and those which equal a var of r1
1094  for(i=0;i<r2->N;i++)
1095  {
1096    BOOLEAN b=TRUE;
1097
1098    if (*(r2->names[i]) == '\0')
1099      b = FALSE;
1100    else if ((r1->parameter!=NULL) && (strlen(r2->names[i])==1))
1101    {
1102      if (vartest)
1103      {
1104        for(j=0;j<rPar(r1);j++)
1105        {
1106          if (strcmp(r2->names[i],r1->parameter[j])==0)
1107          {
1108            b=FALSE;
1109            break;
1110          }
1111        }
1112      }
1113    }
1114
1115    if (b)
1116    {
1117      if (vartest)
1118      {
1119        for(j=0;j<r1->N;j++)
1120        {
1121          if (strcmp(r1->names[j],r2->names[i])==0)
1122          {
1123            b=FALSE;
1124            break;
1125          }
1126        }
1127      }
1128      if (b)
1129      {
1130        //Print("name : %d : %s\n",k,r2->names[i]);
1131        names[k]=omStrDup(r2->names[i]);
1132        k++;
1133      }
1134      //else
1135      //  Print("no name (var): %s\n",r2->names[i]);
1136    }
1137    //else
1138    //  Print("no name (par): %s\n",r2->names[i]);
1139  }
1140  // check whether we found any vars at all
1141  if (k == 0)
1142  {
1143    names[k]=omStrDup("");
1144    k=1;
1145  }
1146  tmpR.N=k;
1147  tmpR.names=names;
1148  /* ordering *======================================================== */
1149  tmpR.OrdSgn=1;
1150  if (dp_dp
1151#ifdef HAVE_PLURAL
1152      && !rIsPluralRing(r1) && !rIsPluralRing(r2)
1153#endif
1154     )
1155  {
1156    tmpR.order=(int*)omAlloc(4*sizeof(int));
1157    tmpR.block0=(int*)omAlloc0(4*sizeof(int));
1158    tmpR.block1=(int*)omAlloc0(4*sizeof(int));
1159    tmpR.wvhdl=(int**)omAlloc0(4*sizeof(int_ptr));
1160    tmpR.order[0]=ringorder_dp;
1161    tmpR.block0[0]=1;
1162    tmpR.block1[0]=rVar(r1);
1163    if (r2->OrdSgn==1)
1164    {
1165      if ((r2->block0[0]==1)
1166      && (r2->block1[0]==rVar(r2))
1167      && ((r2->order[0]==ringorder_wp)
1168        || (r2->order[0]==ringorder_Wp)
1169        || (r2->order[0]==ringorder_Dp))
1170     )
1171     {
1172       tmpR.order[1]=r2->order[0];
1173       if (r2->wvhdl[0]!=NULL)
1174         tmpR.wvhdl[1]=(int *)omMemDup(r2->wvhdl[0]);
1175     }
1176     else
1177        tmpR.order[1]=ringorder_dp;
1178    }
1179    else
1180    {
1181      tmpR.order[1]=ringorder_ds;
1182      tmpR.OrdSgn=-1;
1183    }
1184    tmpR.block0[1]=rVar(r1)+1;
1185    tmpR.block1[1]=rVar(r1)+rVar(r2);
1186    tmpR.order[2]=ringorder_C;
1187    tmpR.order[3]=0;
1188  }
1189  else
1190  {
1191    if ((r1->order[0]==ringorder_unspec)
1192        && (r2->order[0]==ringorder_unspec))
1193    {
1194      tmpR.order=(int*)omAlloc(3*sizeof(int));
1195      tmpR.block0=(int*)omAlloc(3*sizeof(int));
1196      tmpR.block1=(int*)omAlloc(3*sizeof(int));
1197      tmpR.wvhdl=(int**)omAlloc0(3*sizeof(int_ptr));
1198      tmpR.order[0]=ringorder_unspec;
1199      tmpR.order[1]=ringorder_C;
1200      tmpR.order[2]=0;
1201      tmpR.block0[0]=1;
1202      tmpR.block1[0]=tmpR.N;
1203    }
1204    else if (l==k) /* r3=r1+r2 */
1205    {
1206      int b;
1207      ring rb;
1208      if (r1->order[0]==ringorder_unspec)
1209      {
1210        /* extend order of r2 to r3 */
1211        b=rBlocks(r2);
1212        rb=r2;
1213        tmpR.OrdSgn=r2->OrdSgn;
1214      }
1215      else if (r2->order[0]==ringorder_unspec)
1216      {
1217        /* extend order of r1 to r3 */
1218        b=rBlocks(r1);
1219        rb=r1;
1220        tmpR.OrdSgn=r1->OrdSgn;
1221      }
1222      else
1223      {
1224        b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
1225        rb=NULL;
1226      }
1227      tmpR.order=(int*)omAlloc0(b*sizeof(int));
1228      tmpR.block0=(int*)omAlloc0(b*sizeof(int));
1229      tmpR.block1=(int*)omAlloc0(b*sizeof(int));
1230      tmpR.wvhdl=(int**)omAlloc0(b*sizeof(int_ptr));
1231      /* weights not implemented yet ...*/
1232      if (rb!=NULL)
1233      {
1234        for (i=0;i<b;i++)
1235        {
1236          tmpR.order[i]=rb->order[i];
1237          tmpR.block0[i]=rb->block0[i];
1238          tmpR.block1[i]=rb->block1[i];
1239          if (rb->wvhdl[i]!=NULL)
1240            WarnS("rSum: weights not implemented");
1241        }
1242        tmpR.block0[0]=1;
1243      }
1244      else /* ring sum for complete rings */
1245      {
1246        for (i=0;r1->order[i]!=0;i++)
1247        {
1248          tmpR.order[i]=r1->order[i];
1249          tmpR.block0[i]=r1->block0[i];
1250          tmpR.block1[i]=r1->block1[i];
1251          if (r1->wvhdl[i]!=NULL)
1252            tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1253        }
1254        j=i;
1255        i--;
1256        if ((r1->order[i]==ringorder_c)
1257            ||(r1->order[i]==ringorder_C))
1258        {
1259          j--;
1260          tmpR.order[b-2]=r1->order[i];
1261        }
1262        for (i=0;r2->order[i]!=0;i++)
1263        {
1264          if ((r2->order[i]!=ringorder_c)
1265              &&(r2->order[i]!=ringorder_C))
1266          {
1267            tmpR.order[j]=r2->order[i];
1268            tmpR.block0[j]=r2->block0[i]+rVar(r1);
1269            tmpR.block1[j]=r2->block1[i]+rVar(r1);
1270            if (r2->wvhdl[i]!=NULL)
1271            {
1272              tmpR.wvhdl[j] = (int*) omMemDup(r2->wvhdl[i]);
1273            }
1274            j++;
1275          }
1276        }
1277        if((r1->OrdSgn==-1)||(r2->OrdSgn==-1))
1278          tmpR.OrdSgn=-1;
1279      }
1280    }
1281    else if ((k==rVar(r1)) && (k==rVar(r2))) /* r1 and r2 are "quite" the same ring */
1282      /* copy r1, because we have the variables from r1 */
1283    {
1284      int b=rBlocks(r1);
1285
1286      tmpR.order=(int*)omAlloc0(b*sizeof(int));
1287      tmpR.block0=(int*)omAlloc0(b*sizeof(int));
1288      tmpR.block1=(int*)omAlloc0(b*sizeof(int));
1289      tmpR.wvhdl=(int**)omAlloc0(b*sizeof(int_ptr));
1290      /* weights not implemented yet ...*/
1291      for (i=0;i<b;i++)
1292      {
1293        tmpR.order[i]=r1->order[i];
1294        tmpR.block0[i]=r1->block0[i];
1295        tmpR.block1[i]=r1->block1[i];
1296        if (r1->wvhdl[i]!=NULL)
1297        {
1298          tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1299        }
1300      }
1301      tmpR.OrdSgn=r1->OrdSgn;
1302    }
1303    else
1304    {
1305      for(i=0;i<k;i++) omFree((ADDRESS)tmpR.names[i]);
1306      omFreeSize((ADDRESS)names,tmpR.N*sizeof(char_ptr));
1307      Werror("difficulties with variables: %d,%d -> %d",rVar(r1),rVar(r2),k);
1308      return -1;
1309    }
1310  }
1311  sum=(ring)omAllocBin(sip_sring_bin);
1312  memcpy(sum,&tmpR,sizeof(ip_sring));
1313  rComplete(sum);
1314
1315//#ifdef RDEBUG
1316//  rDebugPrint(sum);
1317//#endif
1318
1319#ifdef HAVE_PLURAL
1320  if(1)
1321  {
1322    ring old_ring = currRing;
1323
1324    BOOLEAN R1_is_nc = rIsPluralRing(r1);
1325    BOOLEAN R2_is_nc = rIsPluralRing(r2);
1326
1327    if ( (R1_is_nc) || (R2_is_nc))
1328    {
1329      rChangeCurrRing(r1); /* since rCopy works well only in currRing */
1330      ring R1 = rCopy(r1);
1331      if ( !R1_is_nc ) nc_rCreateNCcomm(R1);
1332
1333#if 0
1334#ifdef RDEBUG
1335      rWrite(R1);
1336      rDebugPrint(R1);
1337#endif
1338#endif
1339      rChangeCurrRing(r2);
1340      ring R2 = rCopy(r2);
1341      if ( !R2_is_nc ) nc_rCreateNCcomm(R2);
1342
1343#if 0
1344#ifdef RDEBUG
1345      rWrite(R2);
1346      rDebugPrint(R2);
1347#endif
1348#endif
1349
1350      rChangeCurrRing(sum); // ?
1351
1352      // Projections from R_i into Sum:
1353      /* multiplication matrices business: */
1354      /* find permutations of vars and pars */
1355      int *perm1 = (int *)omAlloc0((rVar(R1)+1)*sizeof(int));
1356      int *par_perm1 = NULL;
1357      if (rPar(R1)!=0) par_perm1=(int *)omAlloc0((rPar(R1)+1)*sizeof(int));
1358
1359      int *perm2 = (int *)omAlloc0((rVar(R2)+1)*sizeof(int));
1360      int *par_perm2 = NULL;
1361      if (rPar(R2)!=0) par_perm2=(int *)omAlloc0((rPar(R2)+1)*sizeof(int));
1362
1363      maFindPerm(R1->names,  rVar(R1),  R1->parameter,  rPar(R1),
1364                 sum->names, rVar(sum), sum->parameter, rPar(sum),
1365                 perm1, par_perm1, sum->ch);
1366
1367      maFindPerm(R2->names,  rVar(R2),  R2->parameter,  rPar(R2),
1368                 sum->names, rVar(sum), sum->parameter, rPar(sum),
1369                 perm2, par_perm2, sum->ch);
1370
1371
1372      matrix C1 = R1->GetNC()->C, C2 = R2->GetNC()->C;
1373      matrix D1 = R1->GetNC()->D, D2 = R2->GetNC()->D;
1374
1375      // !!!! BUG? C1 and C2 might live in different baserings!!!
1376      // it cannot be both the currRing! :)
1377      // the currRing is sum!
1378
1379      int l = rVar(R1) + rVar(R2);
1380
1381      matrix C  = mpNew(l,l);
1382      matrix D  = mpNew(l,l);
1383
1384      int param_shift = 0;
1385
1386      for (i = 1; i <= rVar(R1); i++)
1387        for (j= rVar(R1)+1; j <= l; j++)
1388          MATELEM(C,i,j) = p_One( sum); // in 'sum'
1389
1390      idTest((ideal)C);
1391
1392      nMapFunc nMap1 = nSetMap(R1); // can change something global: not usable after the next nSetMap call :(
1393      // Create blocked C and D matrices:
1394      for (i=1; i<= rVar(R1); i++)
1395        for (j=i+1; j<=rVar(R1); j++)
1396        {
1397          assume(MATELEM(C1,i,j) != NULL);
1398          MATELEM(C,i,j) = pPermPoly(MATELEM(C1,i,j), perm1, R1, nMap1, par_perm1, rPar(R1)); // need ADD + CMP ops.
1399
1400          if (MATELEM(D1,i,j) != NULL)
1401            MATELEM(D,i,j) = pPermPoly(MATELEM(D1,i,j),perm1,R1,nMap1,par_perm1,rPar(R1));
1402        }
1403
1404      idTest((ideal)C);
1405      idTest((ideal)D);
1406
1407
1408      nMapFunc nMap2 = nSetMap(R2); // can change something global: not usable after the next nSetMap call :(
1409      for (i=1; i<= rVar(R2); i++)
1410        for (j=i+1; j<=rVar(R2); j++)
1411        {
1412          assume(MATELEM(C2,i,j) != NULL);
1413          MATELEM(C,rVar(R1)+i,rVar(R1)+j) = pPermPoly(MATELEM(C2,i,j),perm2,R2,nMap2,par_perm2,rPar(R2));
1414
1415          if (MATELEM(D2,i,j) != NULL)
1416            MATELEM(D,rVar(R1)+i,rVar(R1)+j) = pPermPoly(MATELEM(D2,i,j),perm2,R2,nMap2,par_perm2,rPar(R2));
1417        }
1418
1419      idTest((ideal)C);
1420      idTest((ideal)D);
1421
1422      // Now sum is non-commutative with blocked structure constants!
1423      if (nc_CallPlural(C, D, NULL, NULL, sum, false, false, true, sum))
1424        WarnS("Error initializing non-commutative multiplication!");
1425
1426      /* delete R1, R2*/
1427
1428#if 0
1429#ifdef RDEBUG
1430      rWrite(sum);
1431      rDebugPrint(sum);
1432
1433      Print("\nRefs: R1: %d, R2: %d\n", R1->GetNC()->ref, R2->GetNC()->ref);
1434
1435#endif
1436#endif
1437
1438
1439      rDelete(R1);
1440      rDelete(R2);
1441
1442      /* delete perm arrays */
1443      if (perm1!=NULL) omFree((ADDRESS)perm1);
1444      if (perm2!=NULL) omFree((ADDRESS)perm2);
1445      if (par_perm1!=NULL) omFree((ADDRESS)par_perm1);
1446      if (par_perm2!=NULL) omFree((ADDRESS)par_perm2);
1447
1448      rChangeCurrRing(old_ring);
1449    }
1450
1451  }
1452#endif
1453
1454  ideal Q=NULL;
1455  ideal Q1=NULL, Q2=NULL;
1456  ring old_ring2 = currRing;
1457  if (r1->qideal!=NULL)
1458  {
1459    rChangeCurrRing(sum);
1460//     if (r2->qideal!=NULL)
1461//     {
1462//       WerrorS("todo: qring+qring");
1463//       return -1;
1464//     }
1465//     else
1466//     {}
1467    /* these were defined in the Plural Part above... */
1468    int *perm1 = (int *)omAlloc0((rVar(r1)+1)*sizeof(int));
1469    int *par_perm1 = NULL;
1470    if (rPar(r1)!=0) par_perm1=(int *)omAlloc0((rPar(r1)+1)*sizeof(int));
1471    maFindPerm(r1->names,  rVar(r1),  r1->parameter,  rPar(r1),
1472               sum->names, rVar(sum), sum->parameter, rPar(sum),
1473               perm1, par_perm1, sum->ch);
1474    nMapFunc nMap1 = nSetMap(r1);
1475    Q1 = idInit(IDELEMS(r1->qideal),1);
1476    for (int for_i=0;for_i<IDELEMS(r1->qideal);for_i++)
1477      Q1->m[for_i] = pPermPoly(r1->qideal->m[for_i],perm1,r1,nMap1,par_perm1,rPar(r1));
1478    omFree((ADDRESS)perm1);
1479  }
1480
1481  if (r2->qideal!=NULL)
1482  {
1483    if (currRing!=sum)
1484      rChangeCurrRing(sum);
1485    int *perm2 = (int *)omAlloc0((rVar(r2)+1)*sizeof(int));
1486    int *par_perm2 = NULL;
1487    if (rPar(r2)!=0) par_perm2=(int *)omAlloc0((rPar(r2)+1)*sizeof(int));
1488    maFindPerm(r2->names,  rVar(r2),  r2->parameter,  rPar(r2),
1489               sum->names, rVar(sum), sum->parameter, rPar(sum),
1490               perm2, par_perm2, sum->ch);
1491    nMapFunc nMap2 = nSetMap(r2);
1492    Q2 = idInit(IDELEMS(r2->qideal),1);
1493    for (int for_i=0;for_i<IDELEMS(r2->qideal);for_i++)
1494      Q2->m[for_i] = pPermPoly(r2->qideal->m[for_i],perm2,r2,nMap2,par_perm2,rPar(r2));
1495    omFree((ADDRESS)perm2);
1496  }
1497  if ( (Q1!=NULL) || ( Q2!=NULL))
1498  {
1499    Q = idSimpleAdd(Q1,Q2);
1500    rChangeCurrRing(old_ring2);
1501  }
1502  sum->qideal = Q;
1503
1504#ifdef HAVE_PLURAL
1505  if( rIsPluralRing(sum) )
1506    nc_SetupQuotient( sum );
1507#endif
1508  return 1;
1509}
1510
1511/*2
1512 *returns -1 for not compatible, (sum is undefined)
1513 *         0 for equal, (and sum)
1514 *         1 for compatible (and sum)
1515 */
1516int rSum(ring r1, ring r2, ring &sum)
1517{
1518  if (r1==r2)
1519  {
1520    sum=r1;
1521    r1->ref++;
1522    return 0;
1523  }
1524  return rSumInternal(r1,r2,sum,TRUE,FALSE);
1525}
1526
1527/*2
1528 * create a copy of the ring r, which must be equivalent to currRing
1529 * used for qring definition,..
1530 * (i.e.: normal rings: same nCopy as currRing;
1531 *        qring:        same nCopy, same idCopy as currRing)
1532 * DOES NOT CALL rComplete
1533 */
1534ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
1535{
1536  if (r == NULL) return NULL;
1537  int i,j;
1538  ring res=(ring)omAllocBin(sip_sring_bin);
1539  memset(res,0,sizeof(ip_sring));
1540  //memcpy(res,r,sizeof(ip_sring));
1541  //memset: res->idroot=NULL; /* local objects */
1542  //ideal      minideal;
1543  res->options=r->options; /* ring dependent options */
1544
1545  //memset: res->ordsgn=NULL;
1546  //memset: res->typ=NULL;
1547  //memset: res->VarOffset=NULL;
1548  //memset: res->firstwv=NULL;
1549
1550  //struct omBin   PolyBin; /* Bin from where monoms are allocated */
1551  //memset: res->PolyBin=NULL; // rComplete
1552  res->ch=r->ch;     /* characteristic */
1553#ifdef HAVE_RINGS
1554  res->ringtype=r->ringtype;  /* cring = 0 => coefficient field, cring = 1 => coeffs from Z/2^m */
1555  if (r->ringflaga!=NULL)
1556  {
1557    res->ringflaga = (int_number) omAlloc(sizeof(mpz_t));
1558    mpz_init_set(res->ringflaga,r->ringflaga);
1559  }
1560  res->ringflagb=r->ringflagb;
1561  if (r->nrnModul!=NULL)
1562  {
1563    res->nrnModul = (int_number) omAlloc(sizeof(mpz_t));
1564    mpz_init_set(res->nrnModul,r->nrnModul);
1565  }
1566#endif
1567  //memset: res->ref=0; /* reference counter to the ring */
1568
1569  res->float_len=r->float_len; /* additional char-flags */
1570  res->float_len2=r->float_len2; /* additional char-flags */
1571
1572  res->N=r->N;      /* number of vars */
1573  res->P=r->P;      /* number of pars */
1574  res->OrdSgn=r->OrdSgn; /* 1 for polynomial rings, -1 otherwise */
1575
1576  res->firstBlockEnds=r->firstBlockEnds;
1577#ifdef HAVE_PLURAL
1578  res->real_var_start=r->real_var_start;
1579  res->real_var_end=r->real_var_end;
1580#endif
1581
1582#ifdef HAVE_SHIFTBBA
1583  res->isLPring=r->isLPring; /* 0 for non-letterplace rings, otherwise the number of LP blocks, at least 1, known also as lV */
1584#endif
1585
1586  res->VectorOut=r->VectorOut;
1587  res->ShortOut=r->ShortOut;
1588  res->CanShortOut=r->CanShortOut;
1589  res->LexOrder=r->LexOrder; // TRUE if the monomial ordering has polynomial and power series blocks
1590  res->MixedOrder=r->MixedOrder; // ?? 1 for lex ordering (except ls), -1 otherwise
1591  res->ComponentOrder=r->ComponentOrder;
1592
1593  //memset: res->ExpL_Size=0;
1594  //memset: res->CmpL_Size=0;
1595  //memset: res->VarL_Size=0;
1596  //memset: res->pCompIndex=0;
1597  //memset: res->pOrdIndex=0;
1598  //memset: res->OrdSize=0;
1599  //memset: res->VarL_LowIndex=0;
1600  //memset: res->MinExpPerLong=0;
1601  //memset: res->NegWeightL_Size=0;
1602  //memset: res->NegWeightL_Offset=NULL;
1603  //memset: res->VarL_Offset=NULL;
1604
1605  // the following are set by rComplete unless predefined
1606  // therefore, we copy these values: maybe they are non-standard
1607  /* mask for getting single exponents */
1608  res->bitmask=r->bitmask;
1609  res->divmask=r->divmask;
1610  res->BitsPerExp = r->BitsPerExp;
1611  res->ExpPerLong =  r->ExpPerLong;
1612
1613  //memset: res->p_Procs=NULL;
1614  //memset: res->pFDeg=NULL;
1615  //memset: res->pLDeg=NULL;
1616  //memset: res->pFDegOrig=NULL;
1617  //memset: res->pLDegOrig=NULL;
1618  //memset: res->p_Setm=NULL;
1619  //memset: res->cf=NULL;
1620  res->options=r->options;
1621  #ifdef HAVE_RINGS
1622  res->ringtype=r->ringtype;
1623  #endif
1624  //
1625  if (r->algring!=NULL)
1626    r->algring->ref++;
1627  res->algring=r->algring;
1628  //memset: res->minideal=NULL;
1629  if (r->parameter!=NULL)
1630  {
1631    if (r->minpoly!=NULL) res->minpoly=nCopy(r->minpoly);
1632    int l=rPar(r);
1633    res->parameter=(char **)omAlloc(l*sizeof(char_ptr));
1634    int i;
1635    for(i=0;i<rPar(r);i++)
1636    {
1637      res->parameter[i]=omStrDup(r->parameter[i]);
1638    }
1639    if (r->minideal!=NULL)
1640    {
1641      res->minideal=id_Copy(r->minideal,r->algring);
1642    }
1643  }
1644  if (copy_ordering == TRUE)
1645  {
1646    i=rBlocks(r);
1647    res->wvhdl   = (int **)omAlloc(i * sizeof(int_ptr));
1648    res->order   = (int *) omAlloc(i * sizeof(int));
1649    res->block0  = (int *) omAlloc(i * sizeof(int));
1650    res->block1  = (int *) omAlloc(i * sizeof(int));
1651    for (j=0; j<i; j++)
1652    {
1653      if (r->wvhdl[j]!=NULL)
1654      {
1655        res->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
1656      }
1657      else
1658        res->wvhdl[j]=NULL;
1659    }
1660    memcpy(res->order,r->order,i * sizeof(int));
1661    memcpy(res->block0,r->block0,i * sizeof(int));
1662    memcpy(res->block1,r->block1,i * sizeof(int));
1663  }
1664  //memset: else
1665  //memset: {
1666  //memset:   res->wvhdl = NULL;
1667  //memset:   res->order = NULL;
1668  //memset:   res->block0 = NULL;
1669  //memset:   res->block1 = NULL;
1670  //memset: }
1671
1672  res->names   = (char **)omAlloc0(rVar(r) * sizeof(char_ptr));
1673  for (i=0; i<rVar(res); i++)
1674  {
1675    res->names[i] = omStrDup(r->names[i]);
1676  }
1677  if (r->qideal!=NULL)
1678  {
1679    if (copy_qideal)
1680    {
1681      #ifndef NDEBUG
1682      if (!copy_ordering)
1683        WerrorS("internal error: rCopy0(Q,TRUE,FALSE)");
1684      else
1685      #endif
1686      {
1687      #ifndef NDEBUG
1688        WarnS("internal bad stuff: rCopy0(Q,TRUE,TRUE)");
1689      #endif
1690        rComplete(res);
1691        res->qideal= idrCopyR_NoSort(r->qideal, r, res);
1692        rUnComplete(res);
1693      }
1694    }
1695    //memset: else res->qideal = NULL;
1696  }
1697  //memset: else res->qideal = NULL;
1698  //memset: res->GetNC() = NULL; // copy is purely commutative!!!
1699  return res;
1700}
1701
1702/*2
1703 * create a copy of the ring r, which must be equivalent to currRing
1704 * used for qring definition,..
1705 * (i.e.: normal rings: same nCopy as currRing;
1706 *        qring:        same nCopy, same idCopy as currRing)
1707 */
1708ring rCopy(ring r)
1709{
1710  if (r == NULL) return NULL;
1711  ring res=rCopy0(r,FALSE,TRUE);
1712  rComplete(res, 1); // res is purely commutative so far
1713  if (r->qideal!=NULL) res->qideal=idrCopyR_NoSort(r->qideal, r, res);
1714
1715#ifdef HAVE_PLURAL
1716  if (rIsPluralRing(r))
1717    if( nc_rCopy(res, r, true) );
1718#endif
1719
1720  return res;
1721}
1722
1723// returns TRUE, if r1 equals r2 FALSE, otherwise Equality is
1724// determined componentwise, if qr == 1, then qrideal equality is
1725// tested, as well
1726BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
1727{
1728  int i, j;
1729
1730  if (r1 == r2) return TRUE;
1731
1732  if (r1 == NULL || r2 == NULL) return FALSE;
1733
1734  if ((rInternalChar(r1) != rInternalChar(r2))
1735  || (r1->float_len != r2->float_len)
1736  || (r1->float_len2 != r2->float_len2)
1737  || (rVar(r1) != rVar(r2))
1738  || (r1->OrdSgn != r2->OrdSgn)
1739  || (rPar(r1) != rPar(r2)))
1740    return FALSE;
1741
1742  for (i=0; i<rVar(r1); i++)
1743  {
1744    if (r1->names[i] != NULL && r2->names[i] != NULL)
1745    {
1746      if (strcmp(r1->names[i], r2->names[i])) return FALSE;
1747    }
1748    else if ((r1->names[i] != NULL) ^ (r2->names[i] != NULL))
1749    {
1750      return FALSE;
1751    }
1752  }
1753
1754  i=0;
1755  while (r1->order[i] != 0)
1756  {
1757    if (r2->order[i] == 0) return FALSE;
1758    if ((r1->order[i] != r2->order[i])
1759    || (r1->block0[i] != r2->block0[i])
1760    || (r1->block1[i] != r2->block1[i]))
1761      return FALSE;
1762    if (r1->wvhdl[i] != NULL)
1763    {
1764      if (r2->wvhdl[i] == NULL)
1765        return FALSE;
1766      for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1767        if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1768          return FALSE;
1769    }
1770    else if (r2->wvhdl[i] != NULL) return FALSE;
1771    i++;
1772  }
1773  if (r2->order[i] != 0) return FALSE;
1774
1775  for (i=0; i<rPar(r1);i++)
1776  {
1777      if (strcmp(r1->parameter[i], r2->parameter[i])!=0)
1778        return FALSE;
1779  }
1780
1781  if (r1->minpoly != NULL)
1782  {
1783    if (r2->minpoly == NULL) return FALSE;
1784    if (currRing == r1 || currRing == r2)
1785    {
1786      if (! nEqual(r1->minpoly, r2->minpoly)) return FALSE;
1787    }
1788  }
1789  else if (r2->minpoly != NULL) return FALSE;
1790
1791  if (qr)
1792  {
1793    if (r1->qideal != NULL)
1794    {
1795      ideal id1 = r1->qideal, id2 = r2->qideal;
1796      int i, n;
1797      poly *m1, *m2;
1798
1799      if (id2 == NULL) return FALSE;
1800      if ((n = IDELEMS(id1)) != IDELEMS(id2)) return FALSE;
1801
1802      if (currRing == r1 || currRing == r2)
1803      {
1804        m1 = id1->m;
1805        m2 = id2->m;
1806        for (i=0; i<n; i++)
1807          if (! pEqualPolys(m1[i],m2[i])) return FALSE;
1808      }
1809    }
1810    else if (r2->qideal != NULL) return FALSE;
1811  }
1812
1813  return TRUE;
1814}
1815
1816// returns TRUE, if r1 and r2 represents the monomials in the same way
1817// FALSE, otherwise
1818// this is an analogue to rEqual but not so strict
1819BOOLEAN rSamePolyRep(ring r1, ring r2)
1820{
1821  int i, j;
1822
1823  if (r1 == r2) return TRUE;
1824
1825  if (r1 == NULL || r2 == NULL) return FALSE;
1826
1827  if ((rInternalChar(r1) != rInternalChar(r2))
1828  || (r1->float_len != r2->float_len)
1829  || (r1->float_len2 != r2->float_len2)
1830  || (rVar(r1) != rVar(r2))
1831  || (r1->OrdSgn != r2->OrdSgn)
1832  || (rPar(r1) != rPar(r2)))
1833    return FALSE;
1834
1835  if (rVar(r1)!=rVar(r2)) return FALSE;
1836  if (rPar(r1)!=rPar(r2)) return FALSE;
1837
1838  i=0;
1839  while (r1->order[i] != 0)
1840  {
1841    if (r2->order[i] == 0) return FALSE;
1842    if ((r1->order[i] != r2->order[i])
1843    || (r1->block0[i] != r2->block0[i])
1844    || (r1->block1[i] != r2->block1[i]))
1845      return FALSE;
1846    if (r1->wvhdl[i] != NULL)
1847    {
1848      if (r2->wvhdl[i] == NULL)
1849        return FALSE;
1850      for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1851        if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1852          return FALSE;
1853    }
1854    else if (r2->wvhdl[i] != NULL) return FALSE;
1855    i++;
1856  }
1857  if (r2->order[i] != 0) return FALSE;
1858
1859  // we do not check minpoly
1860  // we do not check qideal
1861
1862  return TRUE;
1863}
1864
1865rOrderType_t rGetOrderType(ring r)
1866{
1867  // check for simple ordering
1868  if (rHasSimpleOrder(r))
1869  {
1870    if ((r->order[1] == ringorder_c)
1871    || (r->order[1] == ringorder_C))
1872    {
1873      switch(r->order[0])
1874      {
1875          case ringorder_dp:
1876          case ringorder_wp:
1877          case ringorder_ds:
1878          case ringorder_ws:
1879          case ringorder_ls:
1880          case ringorder_unspec:
1881            if (r->order[1] == ringorder_C
1882            ||  r->order[0] == ringorder_unspec)
1883              return rOrderType_ExpComp;
1884            return rOrderType_Exp;
1885
1886          default:
1887            assume(r->order[0] == ringorder_lp ||
1888                   r->order[0] == ringorder_rs ||
1889                   r->order[0] == ringorder_Dp ||
1890                   r->order[0] == ringorder_Wp ||
1891                   r->order[0] == ringorder_Ds ||
1892                   r->order[0] == ringorder_Ws);
1893
1894            if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1895            return rOrderType_Exp;
1896      }
1897    }
1898    else
1899    {
1900      assume((r->order[0]==ringorder_c)||(r->order[0]==ringorder_C));
1901      return rOrderType_CompExp;
1902    }
1903  }
1904  else
1905    return rOrderType_General;
1906}
1907
1908BOOLEAN rHasSimpleOrder(const ring r)
1909{
1910  if (r->order[0] == ringorder_unspec) return TRUE;
1911  int blocks = rBlocks(r) - 1;
1912  assume(blocks >= 1);
1913  if (blocks == 1) return TRUE;
1914
1915  int s = 0; 
1916  while( (s < blocks) && (r->order[s] == ringorder_IS) && (r->order[blocks-1] == ringorder_IS) )
1917  {
1918    s++;
1919    blocks--;
1920  }
1921
1922  if ((blocks - s) > 2)  return FALSE;
1923
1924  assume( blocks == s + 2 );
1925 
1926  if (
1927     (r->order[s] != ringorder_c)
1928  && (r->order[s] != ringorder_C)
1929  && (r->order[s+1] != ringorder_c)
1930  && (r->order[s+1] != ringorder_C)
1931     )
1932    return FALSE;
1933  if ((r->order[s+1] == ringorder_M)
1934  || (r->order[s] == ringorder_M))
1935    return FALSE;
1936  return TRUE;
1937}
1938
1939// returns TRUE, if simple lp or ls ordering
1940BOOLEAN rHasSimpleLexOrder(const ring r)
1941{
1942  return rHasSimpleOrder(r) &&
1943    (r->order[0] == ringorder_ls ||
1944     r->order[0] == ringorder_lp ||
1945     r->order[1] == ringorder_ls ||
1946     r->order[1] == ringorder_lp);
1947}
1948
1949BOOLEAN rOrder_is_DegOrdering(const rRingOrder_t order)
1950{
1951  switch(order)
1952  {
1953      case ringorder_dp:
1954      case ringorder_Dp:
1955      case ringorder_ds:
1956      case ringorder_Ds:
1957      case ringorder_Ws:
1958      case ringorder_Wp:
1959      case ringorder_ws:
1960      case ringorder_wp:
1961        return TRUE;
1962
1963      default:
1964        return FALSE;
1965  }
1966}
1967
1968BOOLEAN rOrder_is_WeightedOrdering(rRingOrder_t order)
1969{
1970  switch(order)
1971  {
1972      case ringorder_Ws:
1973      case ringorder_Wp:
1974      case ringorder_ws:
1975      case ringorder_wp:
1976        return TRUE;
1977
1978      default:
1979        return FALSE;
1980  }
1981}
1982
1983BOOLEAN rHasSimpleOrderAA(ring r)
1984{
1985  if (r->order[0] == ringorder_unspec) return TRUE;
1986  int blocks = rBlocks(r) - 1;
1987  assume(blocks >= 1);
1988  if (blocks == 1) return TRUE;
1989
1990  int s = 0; 
1991  while( (s < blocks) && (r->order[s] == ringorder_IS) && (r->order[blocks-1] == ringorder_IS) )
1992  {
1993    s++;
1994    blocks--;
1995  }
1996
1997  if ((blocks - s) > 3)  return FALSE;
1998 
1999//  if ((blocks > 3) || (blocks < 2)) return FALSE;
2000  if ((blocks - s) == 3)
2001  {
2002    return (((r->order[s] == ringorder_aa) && (r->order[s+1] != ringorder_M) &&
2003             ((r->order[s+2] == ringorder_c) || (r->order[s+2] == ringorder_C))) ||
2004            (((r->order[s] == ringorder_c) || (r->order[s] == ringorder_C)) &&
2005             (r->order[s+1] == ringorder_aa) && (r->order[s+2] != ringorder_M)));
2006  }
2007  else
2008  {
2009    return ((r->order[s] == ringorder_aa) && (r->order[s+1] != ringorder_M));
2010  }
2011}
2012
2013// return TRUE if p_SetComp requires p_Setm
2014BOOLEAN rOrd_SetCompRequiresSetm(ring r)
2015{
2016  if (r->typ != NULL)
2017  {
2018    int pos;
2019    for (pos=0;pos<r->OrdSize;pos++)
2020    {
2021      sro_ord* o=&(r->typ[pos]);
2022      if ((o->ord_typ == ro_syzcomp) || (o->ord_typ == ro_syz) || (o->ord_typ == ro_is) || (o->ord_typ == ro_isTemp)) return TRUE;
2023    }
2024  }
2025  return FALSE;
2026}
2027
2028// return TRUE if p->exp[r->pOrdIndex] holds total degree of p */
2029BOOLEAN rOrd_is_Totaldegree_Ordering(ring r)
2030{
2031  // Hmm.... what about Syz orderings?
2032  return (rVar(r) > 1 &&
2033          ((rHasSimpleOrder(r) &&
2034           (rOrder_is_DegOrdering((rRingOrder_t)r->order[0]) ||
2035            rOrder_is_DegOrdering(( rRingOrder_t)r->order[1]))) ||
2036           (rHasSimpleOrderAA(r) &&
2037            (rOrder_is_DegOrdering((rRingOrder_t)r->order[1]) ||
2038             rOrder_is_DegOrdering((rRingOrder_t)r->order[2])))));
2039}
2040
2041// return TRUE if p->exp[r->pOrdIndex] holds a weighted degree of p */
2042BOOLEAN rOrd_is_WeightedDegree_Ordering(ring r =currRing)
2043{
2044  // Hmm.... what about Syz orderings?
2045  return ((rVar(r) > 1) &&
2046          rHasSimpleOrder(r) &&
2047          (rOrder_is_WeightedOrdering((rRingOrder_t)r->order[0]) ||
2048           rOrder_is_WeightedOrdering(( rRingOrder_t)r->order[1])));
2049}
2050
2051BOOLEAN rIsPolyVar(int v, ring r)
2052{
2053  int  i=0;
2054  while(r->order[i]!=0)
2055  {
2056    if((r->block0[i]<=v)
2057    && (r->block1[i]>=v))
2058    {
2059      switch(r->order[i])
2060      {
2061        case ringorder_a:
2062          return (r->wvhdl[i][v-r->block0[i]]>0);
2063        case ringorder_M:
2064          return 2; /*don't know*/
2065        case ringorder_a64: /* assume: all weight are non-negative!*/
2066        case ringorder_lp:
2067        case ringorder_rs:
2068        case ringorder_dp:
2069        case ringorder_Dp:
2070        case ringorder_wp:
2071        case ringorder_Wp:
2072          return TRUE;
2073        case ringorder_ls:
2074        case ringorder_ds:
2075        case ringorder_Ds:
2076        case ringorder_ws:
2077        case ringorder_Ws:
2078          return FALSE;
2079        default:
2080          break;
2081      }
2082    }
2083    i++;
2084  }
2085  return 3; /* could not find var v*/
2086}
2087
2088#ifdef RDEBUG
2089// This should eventually become a full-fledge ring check, like pTest
2090BOOLEAN rDBTest(ring r, const char* fn, const int l)
2091{
2092  int i,j;
2093
2094  if (r == NULL)
2095  {
2096    dReportError("Null ring in %s:%d", fn, l);
2097    return FALSE;
2098  }
2099
2100
2101  if (r->N == 0) return TRUE;
2102
2103//  omCheckAddrSize(r,sizeof(ip_sring));
2104#if OM_CHECK > 0
2105  i=rBlocks(r);
2106  omCheckAddrSize(r->order,i*sizeof(int));
2107  omCheckAddrSize(r->block0,i*sizeof(int));
2108  omCheckAddrSize(r->block1,i*sizeof(int));
2109  if (r->wvhdl!=NULL)
2110  {
2111    omCheckAddrSize(r->wvhdl,i*sizeof(int *));
2112    for (j=0;j<i; j++)
2113    {
2114      if (r->wvhdl[j] != NULL) omCheckAddr(r->wvhdl[j]);
2115    }
2116  }
2117#endif
2118  if (r->VarOffset == NULL)
2119  {
2120    dReportError("Null ring VarOffset -- no rComplete (?) in n %s:%d", fn, l);
2121    return FALSE;
2122  }
2123  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(int));
2124
2125  if ((r->OrdSize==0)!=(r->typ==NULL))
2126  {
2127    dReportError("mismatch OrdSize and typ-pointer in %s:%d");
2128    return FALSE;
2129  }
2130  omcheckAddrSize(r->typ,r->OrdSize*sizeof(*(r->typ)));
2131  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(*(r->VarOffset)));
2132  // test assumptions:
2133  for(i=0;i<=r->N;i++) // for all variables (i = 0..N)
2134  {
2135    if(r->typ!=NULL)
2136    {
2137      for(j=0;j<r->OrdSize;j++) // for all ordering blocks (j =0..OrdSize-1)
2138      {
2139        if(r->typ[j].ord_typ == ro_isTemp)
2140        {
2141          const int p = r->typ[j].data.isTemp.suffixpos;
2142
2143          if(p <= j)
2144            dReportError("ordrec prefix %d is unmatched",j);
2145
2146          assume( p < r->OrdSize );
2147
2148          if(r->typ[p].ord_typ != ro_is)
2149            dReportError("ordrec prefix %d is unmatched (suffix: %d is wrong!!!)",j, p);
2150
2151          // Skip all intermediate blocks for undone variables:
2152          if(r->typ[j].data.isTemp.pVarOffset[i] != -1) // Check i^th variable
2153          {
2154            j = p - 1; // SKIP ALL INTERNAL BLOCKS...???
2155            continue; // To make for check OrdSize bound...
2156          }
2157        }
2158        else if (r->typ[j].ord_typ == ro_is)
2159        {
2160          // Skip all intermediate blocks for undone variables:
2161          if(r->typ[j].data.is.pVarOffset[i] != -1)
2162          {
2163            // ???
2164          }
2165
2166        }
2167        else
2168        {
2169          if (r->typ[j].ord_typ==ro_cp)
2170          {
2171            if(((short)r->VarOffset[i]) == r->typ[j].data.cp.place)
2172              dReportError("ordrec %d conflicts with var %d",j,i);
2173          }
2174          else
2175            if ((r->typ[j].ord_typ!=ro_syzcomp)
2176            && (r->VarOffset[i] == r->typ[j].data.dp.place))
2177              dReportError("ordrec %d conflicts with var %d",j,i);
2178        }
2179      }
2180    }
2181    int tmp;
2182      tmp=r->VarOffset[i] & 0xffffff;
2183      #if SIZEOF_LONG == 8
2184        if ((r->VarOffset[i] >> 24) >63)
2185      #else
2186        if ((r->VarOffset[i] >> 24) >31)
2187      #endif
2188          dReportError("bit_start out of range:%d",r->VarOffset[i] >> 24);
2189      if (i > 0 && ((tmp<0) ||(tmp>r->ExpL_Size-1)))
2190      {
2191        dReportError("varoffset out of range for var %d: %d",i,tmp);
2192      }
2193  }
2194  if(r->typ!=NULL)
2195  {
2196    for(j=0;j<r->OrdSize;j++)
2197    {
2198      if ((r->typ[j].ord_typ==ro_dp)
2199      || (r->typ[j].ord_typ==ro_wp)
2200      || (r->typ[j].ord_typ==ro_wp_neg))
2201      {
2202        if (r->typ[j].data.dp.start > r->typ[j].data.dp.end)
2203          dReportError("in ordrec %d: start(%d) > end(%d)",j,
2204            r->typ[j].data.dp.start, r->typ[j].data.dp.end);
2205        if ((r->typ[j].data.dp.start < 1)
2206        || (r->typ[j].data.dp.end > r->N))
2207          dReportError("in ordrec %d: start(%d)<1 or end(%d)>vars(%d)",j,
2208            r->typ[j].data.dp.start, r->typ[j].data.dp.end,r->N);
2209      }
2210    }
2211  }
2212  if (r->minpoly!=NULL)
2213  {
2214    omCheckAddr(r->minpoly);
2215  }
2216  //assume(r->cf!=NULL);
2217
2218  return TRUE;
2219}
2220#endif
2221
2222static void rO_Align(int &place, int &bitplace)
2223{
2224  // increment place to the next aligned one
2225  // (count as Exponent_t,align as longs)
2226  if (bitplace!=BITS_PER_LONG)
2227  {
2228    place++;
2229    bitplace=BITS_PER_LONG;
2230  }
2231}
2232
2233static void rO_TDegree(int &place, int &bitplace, int start, int end,
2234    long *o, sro_ord &ord_struct)
2235{
2236  // degree (aligned) of variables v_start..v_end, ordsgn 1
2237  rO_Align(place,bitplace);
2238  ord_struct.ord_typ=ro_dp;
2239  ord_struct.data.dp.start=start;
2240  ord_struct.data.dp.end=end;
2241  ord_struct.data.dp.place=place;
2242  o[place]=1;
2243  place++;
2244  rO_Align(place,bitplace);
2245}
2246
2247static void rO_TDegree_neg(int &place, int &bitplace, int start, int end,
2248    long *o, sro_ord &ord_struct)
2249{
2250  // degree (aligned) of variables v_start..v_end, ordsgn -1
2251  rO_Align(place,bitplace);
2252  ord_struct.ord_typ=ro_dp;
2253  ord_struct.data.dp.start=start;
2254  ord_struct.data.dp.end=end;
2255  ord_struct.data.dp.place=place;
2256  o[place]=-1;
2257  place++;
2258  rO_Align(place,bitplace);
2259}
2260
2261static void rO_WDegree(int &place, int &bitplace, int start, int end,
2262    long *o, sro_ord &ord_struct, int *weights)
2263{
2264  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2265  while((start<end) && (weights[0]==0)) { start++; weights++; }
2266  while((start<end) && (weights[end-start]==0)) { end--; }
2267  int i;
2268  int pure_tdeg=1;
2269  for(i=start;i<=end;i++)
2270  {
2271    if(weights[i-start]!=1)
2272    {
2273      pure_tdeg=0;
2274      break;
2275    }
2276  }
2277  if (pure_tdeg)
2278  {
2279    rO_TDegree(place,bitplace,start,end,o,ord_struct);
2280    return;
2281  }
2282  rO_Align(place,bitplace);
2283  ord_struct.ord_typ=ro_wp;
2284  ord_struct.data.wp.start=start;
2285  ord_struct.data.wp.end=end;
2286  ord_struct.data.wp.place=place;
2287  ord_struct.data.wp.weights=weights;
2288  o[place]=1;
2289  place++;
2290  rO_Align(place,bitplace);
2291  for(i=start;i<=end;i++)
2292  {
2293    if(weights[i-start]<0)
2294    {
2295      ord_struct.ord_typ=ro_wp_neg;
2296      break;
2297    }
2298  }
2299}
2300
2301static void rO_WDegree64(int &place, int &bitplace, int start, int end,
2302    long *o, sro_ord &ord_struct, int64 *weights)
2303{
2304  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1,
2305  // reserved 2 places
2306  rO_Align(place,bitplace);
2307  ord_struct.ord_typ=ro_wp64;
2308  ord_struct.data.wp64.start=start;
2309  ord_struct.data.wp64.end=end;
2310  ord_struct.data.wp64.place=place;
2311  ord_struct.data.wp64.weights64=weights;
2312  o[place]=1;
2313  place++;
2314  o[place]=1;
2315  place++;
2316  rO_Align(place,bitplace);
2317  int i;
2318}
2319
2320static void rO_WDegree_neg(int &place, int &bitplace, int start, int end,
2321    long *o, sro_ord &ord_struct, int *weights)
2322{
2323  // weighted degree (aligned) of variables v_start..v_end, ordsgn -1
2324  while((start<end) && (weights[0]==0)) { start++; weights++; }
2325  while((start<end) && (weights[end-start]==0)) { end--; }
2326  rO_Align(place,bitplace);
2327  ord_struct.ord_typ=ro_wp;
2328  ord_struct.data.wp.start=start;
2329  ord_struct.data.wp.end=end;
2330  ord_struct.data.wp.place=place;
2331  ord_struct.data.wp.weights=weights;
2332  o[place]=-1;
2333  place++;
2334  rO_Align(place,bitplace);
2335  int i;
2336  for(i=start;i<=end;i++)
2337  {
2338    if(weights[i-start]<0)
2339    {
2340      ord_struct.ord_typ=ro_wp_neg;
2341      break;
2342    }
2343  }
2344}
2345
2346static void rO_LexVars(int &place, int &bitplace, int start, int end,
2347  int &prev_ord, long *o,int *v, int bits, int opt_var)
2348{
2349  // a block of variables v_start..v_end with lex order, ordsgn 1
2350  int k;
2351  int incr=1;
2352  if(prev_ord==-1) rO_Align(place,bitplace);
2353
2354  if (start>end)
2355  {
2356    incr=-1;
2357  }
2358  for(k=start;;k+=incr)
2359  {
2360    bitplace-=bits;
2361    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2362    o[place]=1;
2363    v[k]= place | (bitplace << 24);
2364    if (k==end) break;
2365  }
2366  prev_ord=1;
2367  if (opt_var!= -1)
2368  {
2369    assume((opt_var == end+1) ||(opt_var == end-1));
2370    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-2");
2371    int save_bitplace=bitplace;
2372    bitplace-=bits;
2373    if (bitplace < 0)
2374    {
2375      bitplace=save_bitplace;
2376      return;
2377    }
2378    // there is enough space for the optional var
2379    v[opt_var]=place | (bitplace << 24);
2380  }
2381}
2382
2383static void rO_LexVars_neg(int &place, int &bitplace, int start, int end,
2384  int &prev_ord, long *o,int *v, int bits, int opt_var)
2385{
2386  // a block of variables v_start..v_end with lex order, ordsgn -1
2387  int k;
2388  int incr=1;
2389  if(prev_ord==1) rO_Align(place,bitplace);
2390
2391  if (start>end)
2392  {
2393    incr=-1;
2394  }
2395  for(k=start;;k+=incr)
2396  {
2397    bitplace-=bits;
2398    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2399    o[place]=-1;
2400    v[k]=place | (bitplace << 24);
2401    if (k==end) break;
2402  }
2403  prev_ord=-1;
2404//  #if 0
2405  if (opt_var!= -1)
2406  {
2407    assume((opt_var == end+1) ||(opt_var == end-1));
2408    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-1");
2409    int save_bitplace=bitplace;
2410    bitplace-=bits;
2411    if (bitplace < 0)
2412    {
2413      bitplace=save_bitplace;
2414      return;
2415    }
2416    // there is enough space for the optional var
2417    v[opt_var]=place | (bitplace << 24);
2418  }
2419//  #endif
2420}
2421
2422static void rO_Syzcomp(int &place, int &bitplace, int &prev_ord,
2423    long *o, sro_ord &ord_struct)
2424{
2425  // ordering is derived from component number
2426  rO_Align(place,bitplace);
2427  ord_struct.ord_typ=ro_syzcomp;
2428  ord_struct.data.syzcomp.place=place;
2429  ord_struct.data.syzcomp.Components=NULL;
2430  ord_struct.data.syzcomp.ShiftedComponents=NULL;
2431  o[place]=1;
2432  prev_ord=1;
2433  place++;
2434  rO_Align(place,bitplace);
2435}
2436
2437static void rO_Syz(int &place, int &bitplace, int &prev_ord,
2438    long *o, sro_ord &ord_struct)
2439{
2440  // ordering is derived from component number
2441  // let's reserve one Exponent_t for it
2442  if ((prev_ord== 1) || (bitplace!=BITS_PER_LONG))
2443    rO_Align(place,bitplace);
2444  ord_struct.ord_typ=ro_syz;
2445  ord_struct.data.syz.place=place;
2446  ord_struct.data.syz.limit=0;
2447  ord_struct.data.syz.syz_index = NULL;
2448  ord_struct.data.syz.curr_index = 1;
2449  o[place]= -1;
2450  prev_ord=-1;
2451  place++;
2452}
2453
2454#ifndef NDEBUG
2455# define MYTEST 0
2456#else /* ifndef NDEBUG */
2457# define MYTEST 0
2458#endif /* ifndef NDEBUG */
2459
2460static void rO_ISPrefix(int &place, int &bitplace, int &prev_ord,
2461    long *o, int N, int *v, sro_ord &ord_struct)
2462{
2463  if ((prev_ord== 1) || (bitplace!=BITS_PER_LONG))
2464    rO_Align(place,bitplace);
2465  // since we add something afterwards - it's better to start with anew!?
2466
2467  ord_struct.ord_typ = ro_isTemp;
2468  ord_struct.data.isTemp.start = place;
2469  ord_struct.data.isTemp.pVarOffset = (int *)omMemDup(v);
2470  ord_struct.data.isTemp.suffixpos = -1;
2471
2472  // We will act as rO_Syz on our own!!!
2473  // Here we allocate an exponent as a level placeholder
2474  o[place]= -1;
2475  prev_ord=-1;
2476  place++;
2477
2478#if MYTEST
2479  Print("rO_ISPrefix: place = %d, v: {", ord_struct.data.isTemp.start);
2480
2481  for( int i = 0; i <= N; i++ )
2482    Print("v[%d]: %09x", i, ord_struct.data.isTemp.pVarOffset[i]);
2483
2484  PrintS("}!\n");
2485#endif
2486}
2487static void rO_ISSuffix(int &place, int &bitplace, int &prev_ord, long *o,
2488  int N, int *v, sro_ord *tmp_typ, int &typ_i, int sgn)
2489{
2490#if MYTEST
2491  Print("rO_ISSuffix: place = %d\n", place);
2492#endif
2493
2494  // Let's find previous prefix:
2495  int typ_j = typ_i - 1;
2496  while(typ_j >= 0)
2497  {
2498    if( tmp_typ[typ_j].ord_typ == ro_isTemp)
2499      break;
2500    typ_j --;
2501  }
2502
2503  assume( typ_j >= 0 );
2504
2505  if( typ_j < 0 ) // Found NO prefix!!! :(
2506    return;
2507
2508  assume( tmp_typ[typ_j].ord_typ == ro_isTemp );
2509
2510  // Get saved state:
2511  const int start = tmp_typ[typ_j].data.isTemp.start;
2512  int *pVarOffset = tmp_typ[typ_j].data.isTemp.pVarOffset;
2513
2514/*
2515  // shift up all blocks
2516  while(typ_j < (typ_i-1))
2517  {
2518    tmp_typ[typ_j] = tmp_typ[typ_j+1];
2519    typ_j++;
2520  }
2521  typ_j = typ_i - 1; // No increment for typ_i
2522*/
2523  tmp_typ[typ_j].data.isTemp.suffixpos = typ_i;
2524
2525  // Let's keep that dummy for now...
2526  typ_j = typ_i; // the typ to change!
2527  typ_i++; // Just for now...
2528
2529
2530#if MYTEST
2531  PrintS("Changes in v: { ");
2532#endif
2533
2534  for( int i = 0; i <= N; i++ ) // Note [0] == component !!! No Skip?
2535  {
2536    // Was i-th variable allocated inbetween?
2537    if( v[i] != pVarOffset[i] )
2538    {
2539      pVarOffset[i] = v[i]; // Save for later...
2540      v[i] = -1; // Undo!
2541      assume( pVarOffset[i] != -1 );
2542#if MYTEST
2543      Print("v[%d]: %010x; ", i, pVarOffset[i]);
2544#endif
2545    }
2546    else
2547      pVarOffset[i] = -1; // No change here...
2548  }
2549
2550  if( pVarOffset[0] != -1 )
2551    pVarOffset[0] &= 0x0fff;
2552
2553#if MYTEST
2554  PrintS(" }!\n");
2555#endif
2556  sro_ord &ord_struct = tmp_typ[typ_j];
2557
2558
2559  ord_struct.ord_typ = ro_is;
2560  ord_struct.data.is.start = start;
2561  ord_struct.data.is.end   = place;
2562  ord_struct.data.is.pVarOffset = pVarOffset;
2563
2564
2565  // What about component???
2566//   if( v[0] != -1 ) // There is a component already...???
2567//     if( o[ v[0] & 0x0fff ] == sgn )
2568//     {
2569//       pVarOffset[0] = -1; // NEVER USED Afterwards...
2570//       return;
2571//     }
2572
2573
2574  // Moreover: we need to allocate the module component (v[0]) here!
2575  if( v[0] == -1) // It's possible that there was module component v0 at the begining (before prefix)!
2576  {
2577    // Start with a whole long exponent
2578    if( bitplace != BITS_PER_LONG )
2579      rO_Align(place, bitplace);
2580
2581    assume( bitplace == BITS_PER_LONG );
2582    bitplace -= BITS_PER_LONG;
2583    assume(bitplace == 0);
2584    v[0] = place | (bitplace << 24); // Never mind whether pVarOffset[0] > 0!!!
2585    o[place] = sgn; // Singnum for component ordering
2586    prev_ord = sgn;
2587  }
2588}
2589
2590
2591static unsigned long rGetExpSize(unsigned long bitmask, int & bits)
2592{
2593  if (bitmask == 0)
2594  {
2595    bits=16; bitmask=0xffff;
2596  }
2597  else if (bitmask <= 1L)
2598  {
2599    bits=1; bitmask = 1L;
2600  }
2601  else if (bitmask <= 3L)
2602  {
2603    bits=2; bitmask = 3L;
2604  }
2605  else if (bitmask <= 7L)
2606  {
2607    bits=3; bitmask=7L;
2608  }
2609  else if (bitmask <= 0xfL)
2610  {
2611    bits=4; bitmask=0xfL;
2612  }
2613  else if (bitmask <= 0x1fL)
2614  {
2615    bits=5; bitmask=0x1fL;
2616  }
2617  else if (bitmask <= 0x3fL)
2618  {
2619    bits=6; bitmask=0x3fL;
2620  }
2621#if SIZEOF_LONG == 8
2622  else if (bitmask <= 0x7fL)
2623  {
2624    bits=7; bitmask=0x7fL; /* 64 bit longs only */
2625  }
2626#endif
2627  else if (bitmask <= 0xffL)
2628  {
2629    bits=8; bitmask=0xffL;
2630  }
2631#if SIZEOF_LONG == 8
2632  else if (bitmask <= 0x1ffL)
2633  {
2634    bits=9; bitmask=0x1ffL; /* 64 bit longs only */
2635  }
2636#endif
2637  else if (bitmask <= 0x3ffL)
2638  {
2639    bits=10; bitmask=0x3ffL;
2640  }
2641#if SIZEOF_LONG == 8
2642  else if (bitmask <= 0xfffL)
2643  {
2644    bits=12; bitmask=0xfff; /* 64 bit longs only */
2645  }
2646#endif
2647  else if (bitmask <= 0xffffL)
2648  {
2649    bits=16; bitmask=0xffffL;
2650  }
2651#if SIZEOF_LONG == 8
2652  else if (bitmask <= 0xfffffL)
2653  {
2654    bits=20; bitmask=0xfffffL; /* 64 bit longs only */
2655  }
2656  else if (bitmask <= 0xffffffffL)
2657  {
2658    bits=32; bitmask=0xffffffffL;
2659  }
2660  else if (bitmask <= 0x7fffffffffffffffL)
2661  {
2662    bits=63; bitmask=0x7fffffffffffffffL; /* for overflow tests*/
2663  }
2664  else
2665  {
2666    bits=63; bitmask=0x7fffffffffffffffL; /* for overflow tests*/
2667  }
2668#else
2669  else if (bitmask <= 0x7fffffff)
2670  {
2671    bits=31; bitmask=0x7fffffff; /* for overflow tests*/
2672  }
2673  else
2674  {
2675    bits=31; bitmask=0x7fffffffL; /* for overflow tests*/
2676  }
2677#endif
2678  return bitmask;
2679}
2680
2681/*2
2682* optimize rGetExpSize for a block of N variables, exp <=bitmask
2683*/
2684static unsigned long rGetExpSize(unsigned long bitmask, int & bits, int N)
2685{
2686  bitmask =rGetExpSize(bitmask, bits);
2687  int vars_per_long=BIT_SIZEOF_LONG/bits;
2688  int bits1;
2689  loop
2690  {
2691    if (bits == BIT_SIZEOF_LONG-1)
2692    {
2693      bits =  BIT_SIZEOF_LONG - 1;
2694      return LONG_MAX;
2695    }
2696    unsigned long bitmask1 =rGetExpSize(bitmask+1, bits1);
2697    int vars_per_long1=BIT_SIZEOF_LONG/bits1;
2698    if ((((N+vars_per_long-1)/vars_per_long) ==
2699         ((N+vars_per_long1-1)/vars_per_long1)))
2700    {
2701      vars_per_long=vars_per_long1;
2702      bits=bits1;
2703      bitmask=bitmask1;
2704    }
2705    else
2706    {
2707      return bitmask; /* and bits */
2708    }
2709  }
2710}
2711
2712
2713bool rSetISReference(const ideal F, const int i, const int p, const intvec * componentWeights, const ring r);
2714
2715
2716/*2
2717 * create a copy of the ring r, which must be equivalent to currRing
2718 * used for std computations
2719 * may share data structures with currRing
2720 * DOES CALL rComplete
2721 */
2722ring rModifyRing(ring r, BOOLEAN omit_degree,
2723                         BOOLEAN omit_comp,
2724                         unsigned long exp_limit)
2725{
2726  assume (r != NULL );
2727  assume (exp_limit > 1);
2728  BOOLEAN need_other_ring;
2729  BOOLEAN omitted_degree = FALSE;
2730
2731  int iNeedInducedOrderingSetup = 0; ///< How many induced ordering block do we have?
2732  int bits;
2733
2734  exp_limit=rGetExpSize(exp_limit, bits, r->N);
2735  need_other_ring = (exp_limit != r->bitmask);
2736
2737  int nblocks=rBlocks(r);
2738  int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
2739  int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
2740  int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
2741  int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int_ptr));
2742
2743  int i=0;
2744  int j=0; /*  i index in r, j index in res */
2745
2746  for( int r_ord=r->order[i]; (r_ord != 0) && (i < nblocks); j++, r_ord=r->order[++i])
2747  {
2748    BOOLEAN copy_block_index=TRUE;
2749
2750    if (r->block0[i]==r->block1[i])
2751    {
2752      switch(r_ord)
2753      {
2754        case ringorder_wp:
2755        case ringorder_dp:
2756        case ringorder_Wp:
2757        case ringorder_Dp:
2758          r_ord=ringorder_lp;
2759          break;
2760        case ringorder_Ws:
2761        case ringorder_Ds:
2762        case ringorder_ws:
2763        case ringorder_ds:
2764          r_ord=ringorder_ls;
2765          break;
2766        default:
2767          break;
2768      }
2769    }
2770    switch(r_ord)
2771    {
2772      case ringorder_S:
2773      {
2774#ifndef NDEBUG
2775        dReportError("Error: unhandled ordering in rModifyRing: ringorder_S = [%d]", r_ord);
2776#endif
2777        order[j]=r_ord; /*r->order[i];*/
2778        break;
2779      }
2780      case ringorder_C:
2781      case ringorder_c:
2782        if (!omit_comp)
2783        {
2784          order[j]=r_ord; /*r->order[i]*/;
2785        }
2786        else
2787        {
2788          j--;
2789          need_other_ring=TRUE;
2790          omit_comp=FALSE;
2791          copy_block_index=FALSE;
2792        }
2793        break;
2794      case ringorder_wp:
2795      case ringorder_dp:
2796      case ringorder_ws:
2797      case ringorder_ds:
2798        if(!omit_degree)
2799        {
2800          order[j]=r_ord; /*r->order[i]*/;
2801        }
2802        else
2803        {
2804          order[j]=ringorder_rs;
2805          need_other_ring=TRUE;
2806          omit_degree=FALSE;
2807          omitted_degree = TRUE;
2808        }
2809        break;
2810      case ringorder_Wp:
2811      case ringorder_Dp:
2812      case ringorder_Ws:
2813      case ringorder_Ds:
2814        if(!omit_degree)
2815        {
2816          order[j]=r_ord; /*r->order[i];*/
2817        }
2818        else
2819        {
2820          order[j]=ringorder_lp;
2821          need_other_ring=TRUE;
2822          omit_degree=FALSE;
2823          omitted_degree = TRUE;
2824        }
2825        break;
2826      case ringorder_IS:
2827      {
2828        if (omit_comp)
2829        {
2830          dReportError("Error: WRONG USAGE of rModifyRing: cannot omit component due to the ordering block [%d]: %d (ringorder_IS)", i, r_ord);
2831          omit_comp = FALSE;
2832        }
2833        order[j]=r_ord; /*r->order[i];*/
2834        iNeedInducedOrderingSetup++;
2835        break;
2836      }
2837      case ringorder_s:
2838      {
2839        assume((i == 0) && (j == 0));
2840        if (omit_comp)
2841        {
2842#ifndef NDEBUG
2843          Warn("WRONG USAGE? of rModifyRing: omitting component due to the ordering block [%d]: %d (ringorder_s)", i, r_ord);
2844#endif
2845          omit_comp = FALSE;
2846        }
2847        order[j]=r_ord; /*r->order[i];*/
2848        break;
2849      }
2850      default:
2851        order[j]=r_ord; /*r->order[i];*/
2852        break;
2853    }
2854    if (copy_block_index)
2855    {
2856      block0[j]=r->block0[i];
2857      block1[j]=r->block1[i];
2858      wvhdl[j]=r->wvhdl[i];
2859    }
2860
2861    // order[j]=ringorder_no; //  done by omAlloc0
2862  }
2863  if(!need_other_ring)
2864  {
2865    omFreeSize(order,(nblocks+1)*sizeof(int));
2866    omFreeSize(block0,(nblocks+1)*sizeof(int));
2867    omFreeSize(block1,(nblocks+1)*sizeof(int));
2868    omFreeSize(wvhdl,(nblocks+1)*sizeof(int_ptr));
2869    return r;
2870  }
2871  ring res=(ring)omAlloc0Bin(sip_sring_bin);
2872  *res = *r;
2873
2874#ifdef HAVE_PLURAL
2875  res->GetNC() = NULL;
2876#endif
2877
2878  // res->qideal, res->idroot ???
2879  res->wvhdl=wvhdl;
2880  res->order=order;
2881  res->block0=block0;
2882  res->block1=block1;
2883  res->bitmask=exp_limit;
2884  int tmpref=r->cf->ref;
2885  rComplete(res, 1);
2886  r->cf->ref=tmpref;
2887
2888  // adjust res->pFDeg: if it was changed globally, then
2889  // it must also be changed for new ring
2890  if (r->pFDegOrig != res->pFDegOrig &&
2891           rOrd_is_WeightedDegree_Ordering(r))
2892  {
2893    // still might need adjustment for weighted orderings
2894    // and omit_degree
2895    res->firstwv = r->firstwv;
2896    res->firstBlockEnds = r->firstBlockEnds;
2897    res->pFDeg = res->pFDegOrig = pWFirstTotalDegree;
2898  }
2899  if (omitted_degree)
2900    res->pLDeg = res->pLDegOrig = r->pLDegOrig;
2901
2902  rOptimizeLDeg(res);
2903
2904  // set syzcomp
2905  if (res->typ != NULL)
2906  {
2907    if( res->typ[0].ord_typ == ro_syz) // "s" Always on [0] place!
2908    {
2909      res->typ[0] = r->typ[0]; // Copy struct!? + setup the same limit!
2910
2911      if (r->typ[0].data.syz.limit > 0)
2912      {
2913        res->typ[0].data.syz.syz_index
2914          = (int*) omAlloc((r->typ[0].data.syz.limit +1)*sizeof(int));
2915        memcpy(res->typ[0].data.syz.syz_index, r->typ[0].data.syz.syz_index,
2916              (r->typ[0].data.syz.limit +1)*sizeof(int));
2917      }
2918    }
2919
2920    if( iNeedInducedOrderingSetup > 0 )
2921    {
2922      for(j = 0, i = 0; (i < nblocks) && (iNeedInducedOrderingSetup > 0); i++)
2923        if( res->typ[i].ord_typ == ro_is ) // Search for suffixes!
2924        {
2925          ideal F = idrHeadR(r->typ[i].data.is.F, r, res); // Copy F from r into res!
2926          assume(
2927            rSetISReference(
2928              F,  // WILL BE COPIED!
2929              r->typ[i].data.is.limit,
2930              j++,
2931              r->typ[i].data.is.componentWeights, // WILL BE COPIED
2932              res)
2933            );
2934          id_Delete(&F, res);
2935          iNeedInducedOrderingSetup--;
2936        }
2937    } // Process all induced Ordering blocks! ...
2938  }
2939  // the special case: homog (omit_degree) and 1 block rs: that is global:
2940  // it comes from dp
2941  res->OrdSgn=r->OrdSgn;
2942
2943
2944#ifdef HAVE_PLURAL
2945  if (rIsPluralRing(r))
2946  {
2947    if ( nc_rComplete(r, res, false) ) // no qideal!
2948    {
2949#ifndef NDEBUG
2950      WarnS("error in nc_rComplete");
2951#endif
2952      // cleanup?
2953
2954//      rDelete(res);
2955//      return r;
2956
2957      // just go on..
2958    }
2959
2960    if( rIsSCA(r) )
2961    {
2962      if( !sca_Force(res, scaFirstAltVar(r), scaLastAltVar(r)) )
2963      WarnS("error in sca_Force!");
2964    }
2965  }
2966#endif
2967
2968  return res;
2969}
2970
2971// construct Wp,C ring
2972ring rModifyRing_Wp(ring r, int* weights)
2973{
2974  ring res=(ring)omAlloc0Bin(sip_sring_bin);
2975  *res = *r;
2976#ifdef HAVE_PLURAL
2977  res->GetNC() = NULL;
2978#endif
2979
2980  /*weights: entries for 3 blocks: NULL*/
2981  res->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
2982  /*order: Wp,C,0*/
2983  res->order = (int *) omAlloc(3 * sizeof(int *));
2984  res->block0 = (int *)omAlloc0(3 * sizeof(int *));
2985  res->block1 = (int *)omAlloc0(3 * sizeof(int *));
2986  /* ringorder Wp for the first block: var 1..r->N */
2987  res->order[0]  = ringorder_Wp;
2988  res->block0[0] = 1;
2989  res->block1[0] = r->N;
2990  res->wvhdl[0] = weights;
2991  /* ringorder C for the second block: no vars */
2992  res->order[1]  = ringorder_C;
2993  /* the last block: everything is 0 */
2994  res->order[2]  = 0;
2995  /*polynomial ring*/
2996  res->OrdSgn    = 1;
2997
2998  int tmpref=r->cf->ref;
2999  rComplete(res, 1);
3000  r->cf->ref=tmpref;
3001#ifdef HAVE_PLURAL
3002  if (rIsPluralRing(r))
3003  {
3004    if ( nc_rComplete(r, res, false) ) // no qideal!
3005    {
3006#ifndef NDEBUG
3007      WarnS("error in nc_rComplete");
3008#endif
3009      // cleanup?
3010
3011//      rDelete(res);
3012//      return r;
3013
3014      // just go on..
3015    }
3016  }
3017#endif
3018  return res;
3019}
3020
3021// construct lp, C ring with r->N variables, r->names vars....
3022ring rModifyRing_Simple(ring r, BOOLEAN ommit_degree, BOOLEAN ommit_comp, unsigned long exp_limit, BOOLEAN &simple)
3023{
3024  simple=TRUE;
3025  if (!rHasSimpleOrder(r))
3026  {
3027    simple=FALSE; // sorting needed
3028    assume (r != NULL );
3029    assume (exp_limit > 1);
3030    BOOLEAN omitted_degree = FALSE;
3031    int bits;
3032
3033    exp_limit=rGetExpSize(exp_limit, bits, r->N);
3034
3035    int nblocks=1+(ommit_comp!=0);
3036    int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
3037    int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
3038    int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
3039    int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int_ptr));
3040
3041    order[0]=ringorder_lp;
3042    block0[0]=1;
3043    block1[0]=r->N;
3044    if (!ommit_comp)
3045    {
3046      order[1]=ringorder_C;
3047    }
3048    ring res=(ring)omAlloc0Bin(sip_sring_bin);
3049    *res = *r;
3050#ifdef HAVE_PLURAL
3051    res->GetNC() = NULL;
3052#endif
3053    // res->qideal, res->idroot ???
3054    res->wvhdl=wvhdl;
3055    res->order=order;
3056    res->block0=block0;
3057    res->block1=block1;
3058    res->bitmask=exp_limit;
3059    int tmpref=r->cf->ref;
3060    rComplete(res, 1);
3061    r->cf->ref=tmpref;
3062
3063#ifdef HAVE_PLURAL
3064    if (rIsPluralRing(r))
3065    {
3066      if ( nc_rComplete(r, res, false) ) // no qideal!
3067      {
3068#ifndef NDEBUG
3069        WarnS("error in nc_rComplete");
3070#endif
3071        // cleanup?
3072
3073//      rDelete(res);
3074//      return r;
3075
3076      // just go on..
3077      }
3078    }
3079#endif
3080
3081    rOptimizeLDeg(res);
3082
3083    return res;
3084  }
3085  return rModifyRing(r, ommit_degree, ommit_comp, exp_limit);
3086}
3087
3088void rKillModifiedRing_Simple(ring r)
3089{
3090  rKillModifiedRing(r);
3091}
3092
3093
3094void rKillModifiedRing(ring r)
3095{
3096  rUnComplete(r);
3097  omFree(r->order);
3098  omFree(r->block0);
3099  omFree(r->block1);
3100  omFree(r->wvhdl);
3101  omFreeBin(r,sip_sring_bin);
3102}
3103
3104void rKillModified_Wp_Ring(ring r)
3105{
3106  rUnComplete(r);
3107  omFree(r->order);
3108  omFree(r->block0);
3109  omFree(r->block1);
3110  omFree(r->wvhdl[0]);
3111  omFree(r->wvhdl);
3112  omFreeBin(r,sip_sring_bin);
3113}
3114
3115static void rSetOutParams(ring r)
3116{
3117  r->VectorOut = (r->order[0] == ringorder_c);
3118  r->ShortOut = TRUE;
3119  {
3120    int i;
3121    if (r->parameter!=NULL)
3122    {
3123      for (i=0;i<rPar(r);i++)
3124      {
3125        if(strlen(r->parameter[i])>1)
3126        {
3127          r->ShortOut=FALSE;
3128          break;
3129        }
3130      }
3131    }
3132    if (r->ShortOut)
3133    {
3134      // Hmm... sometimes (e.g., from maGetPreimage) new variables
3135      // are introduced, but their names are never set
3136      // hence, we do the following awkward trick
3137      int N = omSizeWOfAddr(r->names);
3138      if (r->N < N) N = r->N;
3139
3140      for (i=(N-1);i>=0;i--)
3141      {
3142        if(r->names[i] != NULL && strlen(r->names[i])>1)
3143        {
3144          r->ShortOut=FALSE;
3145          break;
3146        }
3147      }
3148    }
3149  }
3150  r->CanShortOut = r->ShortOut;
3151}
3152
3153/*2
3154* sets pMixedOrder and pComponentOrder for orderings with more than one block
3155* block of variables (ip is the block number, o_r the number of the ordering)
3156* o is the position of the orderingering in r
3157*/
3158static void rHighSet(ring r, int o_r, int o)
3159{
3160  switch(o_r)
3161  {
3162    case ringorder_lp:
3163    case ringorder_dp:
3164    case ringorder_Dp:
3165    case ringorder_wp:
3166    case ringorder_Wp:
3167    case ringorder_rp:
3168    case ringorder_a:
3169    case ringorder_aa:
3170    case ringorder_a64:
3171      if (r->OrdSgn==-1) r->MixedOrder=TRUE;
3172      break;
3173    case ringorder_ls:
3174    case ringorder_rs:
3175    case ringorder_ds:
3176    case ringorder_Ds:
3177    case ringorder_s:
3178      break;
3179    case ringorder_ws:
3180    case ringorder_Ws:
3181      if (r->wvhdl[o]!=NULL)
3182      {
3183        int i;
3184        for(i=r->block1[o]-r->block0[o];i>=0;i--)
3185          if (r->wvhdl[o][i]<0) { r->MixedOrder=TRUE; break; }
3186      }
3187      break;
3188    case ringorder_c:
3189      r->ComponentOrder=1;
3190      break;
3191    case ringorder_C:
3192    case ringorder_S:
3193      r->ComponentOrder=-1;
3194      break;
3195    case ringorder_M:
3196      r->MixedOrder=TRUE;
3197      break;
3198    case ringorder_IS:
3199    { // TODO: What is r->ComponentOrder???
3200      r->MixedOrder=TRUE;
3201/*
3202      if( r->block0[o] != 0 ) // Suffix has the comonent
3203        r->ComponentOrder = r->block0[o];
3204      else // Prefix has level...
3205        r->ComponentOrder=-1;
3206*/
3207      break;
3208    }
3209
3210    default:
3211      dReportError("wrong internal ordering:%d at %s, l:%d\n",o_r,__FILE__,__LINE__);
3212  }
3213}
3214
3215static void rSetFirstWv(ring r, int i, int* order, int* block1, int** wvhdl)
3216{
3217  // cheat for ringorder_aa
3218  if (order[i] == ringorder_aa)
3219    i++;
3220  if(block1[i]!=r->N) r->LexOrder=TRUE;
3221  r->firstBlockEnds=block1[i];
3222  r->firstwv = wvhdl[i];
3223  if ((order[i]== ringorder_ws)
3224  || (order[i]==ringorder_Ws)
3225  || (order[i]== ringorder_wp)
3226  || (order[i]==ringorder_Wp)
3227  || (order[i]== ringorder_a)
3228   /*|| (order[i]==ringorder_A)*/)
3229  {
3230    int j;
3231    for(j=block1[i]-r->block0[i];j>=0;j--)
3232    {
3233      if (r->firstwv[j]<0) r->MixedOrder=TRUE;
3234      if (r->firstwv[j]==0) r->LexOrder=TRUE;
3235    }
3236  }
3237  else if (order[i]==ringorder_a64)
3238  {
3239    int j;
3240    int64 *w=rGetWeightVec(r);
3241    for(j=block1[i]-r->block0[i];j>=0;j--)
3242    {
3243      if (w[j]==0) r->LexOrder=TRUE;
3244    }
3245  }
3246}
3247
3248static void rOptimizeLDeg(ring r)
3249{
3250  if (r->pFDeg == pDeg)
3251  {
3252    if (r->pLDeg == pLDeg1)
3253      r->pLDeg = pLDeg1_Deg;
3254    if (r->pLDeg == pLDeg1c)
3255      r->pLDeg = pLDeg1c_Deg;
3256  }
3257  else if (r->pFDeg == p_Totaldegree)
3258  {
3259    if (r->pLDeg == pLDeg1)
3260      r->pLDeg = pLDeg1_Totaldegree;
3261    if (r->pLDeg == pLDeg1c)
3262      r->pLDeg = pLDeg1c_Totaldegree;
3263  }
3264  else if (r->pFDeg == pWFirstTotalDegree)
3265  {
3266    if (r->pLDeg == pLDeg1)
3267      r->pLDeg = pLDeg1_WFirstTotalDegree;
3268    if (r->pLDeg == pLDeg1c)
3269      r->pLDeg = pLDeg1c_WFirstTotalDegree;
3270  }
3271}
3272
3273// set pFDeg, pLDeg, MixOrder, ComponentOrder, etc
3274static void rSetDegStuff(ring r)
3275{
3276  int* order = r->order;
3277  int* block0 = r->block0;
3278  int* block1 = r->block1;
3279  int** wvhdl = r->wvhdl;
3280
3281  if (order[0]==ringorder_S ||order[0]==ringorder_s || order[0]==ringorder_IS)
3282  {
3283    order++;
3284    block0++;
3285    block1++;
3286    wvhdl++;
3287  }
3288  r->LexOrder = FALSE;
3289  r->MixedOrder = FALSE;
3290  r->ComponentOrder = 1;
3291  r->pFDeg = p_Totaldegree;
3292  r->pLDeg = (r->OrdSgn == 1 ? pLDegb : pLDeg0);
3293
3294  /*======== ordering type is (_,c) =========================*/
3295  if ((order[0]==ringorder_unspec) || (order[1] == 0)
3296      ||(
3297    ((order[1]==ringorder_c)||(order[1]==ringorder_C)
3298     ||(order[1]==ringorder_S) 
3299     ||(order[1]==ringorder_s))
3300    && (order[0]!=ringorder_M)
3301    && (order[2]==0))
3302    )
3303  {
3304    if ((order[0]!=ringorder_unspec)
3305    && ((order[1]==ringorder_C)||(order[1]==ringorder_S)||
3306        (order[1]==ringorder_s)))
3307      r->ComponentOrder=-1;
3308    if (r->OrdSgn == -1) r->pLDeg = pLDeg0c;
3309    if ((order[0] == ringorder_lp)
3310    || (order[0] == ringorder_ls)
3311    || (order[0] == ringorder_rp)
3312    || (order[0] == ringorder_rs))
3313    {
3314      r->LexOrder=TRUE;
3315      r->pLDeg = pLDeg1c;
3316      r->pFDeg = p_Totaldegree;
3317    }
3318    if ((order[0] == ringorder_a)
3319    || (order[0] == ringorder_wp)
3320    || (order[0] == ringorder_Wp)
3321    || (order[0] == ringorder_ws)
3322    || (order[0] == ringorder_Ws))
3323      r->pFDeg = pWFirstTotalDegree;
3324    r->firstBlockEnds=block1[0];
3325    r->firstwv = wvhdl[0];
3326  }
3327  /*======== ordering type is (c,_) =========================*/
3328  else if (((order[0]==ringorder_c)
3329            ||(order[0]==ringorder_C)
3330            ||(order[0]==ringorder_S)
3331            ||(order[0]==ringorder_s))
3332  && (order[1]!=ringorder_M)
3333  &&  (order[2]==0))
3334  {
3335    if ((order[0]==ringorder_C)||(order[0]==ringorder_S)||
3336        order[0]==ringorder_s)
3337      r->ComponentOrder=-1;
3338    if ((order[1] == ringorder_lp)
3339    || (order[1] == ringorder_ls)
3340    || (order[1] == ringorder_rp)
3341    || order[1] == ringorder_rs)
3342    {
3343      r->LexOrder=TRUE;
3344      r->pLDeg = pLDeg1c;
3345      r->pFDeg = p_Totaldegree;
3346    }
3347    r->firstBlockEnds=block1[1];
3348    if (wvhdl!=NULL) r->firstwv = wvhdl[1];
3349    if ((order[1] == ringorder_a)
3350    || (order[1] == ringorder_wp)
3351    || (order[1] == ringorder_Wp)
3352    || (order[1] == ringorder_ws)
3353    || (order[1] == ringorder_Ws))
3354      r->pFDeg = pWFirstTotalDegree;
3355  }
3356  /*------- more than one block ----------------------*/
3357  else
3358  {
3359    if ((r->VectorOut)||(order[0]==ringorder_C)||(order[0]==ringorder_S)||(order[0]==ringorder_s))
3360    {
3361      rSetFirstWv(r, 1, order, block1, wvhdl);
3362    }
3363    else
3364      rSetFirstWv(r, 0, order, block1, wvhdl);
3365
3366    /*the number of orderings:*/
3367    int i = 0;
3368    while (order[++i] != 0);
3369    do
3370    {
3371      i--;
3372      rHighSet(r, order[i],i);
3373    }
3374    while (i != 0);
3375
3376    if ((order[0]!=ringorder_c)
3377        && (order[0]!=ringorder_C)
3378        && (order[0]!=ringorder_S)
3379        && (order[0]!=ringorder_s))
3380    {
3381      r->pLDeg = pLDeg1c;
3382    }
3383    else
3384    {
3385      r->pLDeg = pLDeg1;
3386    }
3387    r->pFDeg = pWTotaldegree; // may be improved: p_Totaldegree for lp/dp/ls/.. blocks
3388  }
3389 
3390  if (rOrd_is_Totaldegree_Ordering(r) || rOrd_is_WeightedDegree_Ordering(r))
3391    r->pFDeg = pDeg;
3392
3393  r->pFDegOrig = r->pFDeg;
3394  r->pLDegOrig = r->pLDeg;
3395  rOptimizeLDeg(r);
3396}
3397
3398/*2
3399* set NegWeightL_Size, NegWeightL_Offset
3400*/
3401static void rSetNegWeight(ring r)
3402{
3403  int i,l;
3404  if (r->typ!=NULL)
3405  {
3406    l=0;
3407    for(i=0;i<r->OrdSize;i++)
3408    {
3409      if(r->typ[i].ord_typ==ro_wp_neg) l++;
3410    }
3411    if (l>0)
3412    {
3413      r->NegWeightL_Size=l;
3414      r->NegWeightL_Offset=(int *) omAlloc(l*sizeof(int));
3415      l=0;
3416      for(i=0;i<r->OrdSize;i++)
3417      {
3418        if(r->typ[i].ord_typ==ro_wp_neg)
3419        {
3420          r->NegWeightL_Offset[l]=r->typ[i].data.wp.place;
3421          l++;
3422        }
3423      }
3424      return;
3425    }
3426  }
3427  r->NegWeightL_Size = 0;
3428  r->NegWeightL_Offset = NULL;
3429}
3430
3431static void rSetOption(ring r)
3432{
3433  // set redthrough
3434  if (!TEST_OPT_OLDSTD && r->OrdSgn == 1 && ! r->LexOrder)
3435    r->options |= Sy_bit(OPT_REDTHROUGH);
3436  else
3437    r->options &= ~Sy_bit(OPT_REDTHROUGH);
3438
3439  // set intStrategy
3440#ifdef HAVE_RINGS
3441  if (rField_is_Extension(r) || rField_is_Q(r) || rField_is_Ring(r))
3442#else
3443  if (rField_is_Extension(r) || rField_is_Q(r))
3444#endif
3445    r->options |= Sy_bit(OPT_INTSTRATEGY);
3446  else
3447    r->options &= ~Sy_bit(OPT_INTSTRATEGY);
3448
3449  // set redTail
3450  if (r->LexOrder || r->OrdSgn == -1 || rField_is_Extension(r))
3451    r->options &= ~Sy_bit(OPT_REDTAIL);
3452  else
3453    r->options |= Sy_bit(OPT_REDTAIL);
3454}
3455
3456BOOLEAN rComplete(ring r, int force)
3457{
3458  if (r->VarOffset!=NULL && force == 0) return FALSE;
3459  nInitChar(r);
3460  rSetOutParams(r);
3461  int n=rBlocks(r)-1;
3462  int i;
3463  int bits;
3464  r->bitmask=rGetExpSize(r->bitmask,bits,r->N);
3465  r->BitsPerExp = bits;
3466  r->ExpPerLong = BIT_SIZEOF_LONG / bits;
3467  r->divmask=rGetDivMask(bits);
3468
3469  // will be used for ordsgn:
3470  long *tmp_ordsgn=(long *)omAlloc0(3*(n+r->N)*sizeof(long));
3471  // will be used for VarOffset:
3472  int *v=(int *)omAlloc((r->N+1)*sizeof(int));
3473  for(i=r->N; i>=0 ; i--)
3474  {
3475    v[i]=-1;
3476  }
3477  sro_ord *tmp_typ=(sro_ord *)omAlloc0(3*(n+r->N)*sizeof(sro_ord));
3478  int typ_i=0;
3479  int prev_ordsgn=0;
3480
3481  // fill in v, tmp_typ, tmp_ordsgn, determine typ_i (== ordSize)
3482  int j=0;
3483  int j_bits=BITS_PER_LONG;
3484
3485  BOOLEAN need_to_add_comp=FALSE; // Only for ringorder_s and ringorder_S!
3486
3487  for(i=0;i<n;i++)
3488  {
3489    tmp_typ[typ_i].order_index=i;
3490    switch (r->order[i])
3491    {
3492      case ringorder_a:
3493      case ringorder_aa:
3494        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
3495                   r->wvhdl[i]);
3496        typ_i++;
3497        break;
3498
3499      case ringorder_a64:
3500        rO_WDegree64(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3501                     tmp_typ[typ_i], (int64 *)(r->wvhdl[i]));
3502        typ_i++;
3503        break;
3504
3505      case ringorder_c:
3506        rO_Align(j, j_bits);
3507        rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3508        break;
3509
3510      case ringorder_C:
3511        rO_Align(j, j_bits);
3512        rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3513        break;
3514
3515      case ringorder_M:
3516        {
3517          int k,l;
3518          k=r->block1[i]-r->block0[i]+1; // number of vars
3519          for(l=0;l<k;l++)
3520          {
3521            rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3522                       tmp_typ[typ_i],
3523                       r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
3524            typ_i++;
3525          }
3526          break;
3527        }
3528
3529      case ringorder_lp:
3530        rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3531                   tmp_ordsgn,v,bits, -1);
3532        break;
3533
3534      case ringorder_ls:
3535        rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3536                       tmp_ordsgn,v, bits, -1);
3537        break;
3538
3539      case ringorder_rs:
3540        rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3541                       tmp_ordsgn,v, bits, -1);
3542        break;
3543
3544      case ringorder_rp:
3545        rO_LexVars(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3546                       tmp_ordsgn,v, bits, -1);
3547        break;
3548
3549      case ringorder_dp:
3550        if (r->block0[i]==r->block1[i])
3551        {
3552          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3553                     tmp_ordsgn,v, bits, -1);
3554        }
3555        else
3556        {
3557          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3558                     tmp_typ[typ_i]);
3559          typ_i++;
3560          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3561                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3562        }
3563        break;
3564
3565      case ringorder_Dp:
3566        if (r->block0[i]==r->block1[i])
3567        {
3568          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3569                     tmp_ordsgn,v, bits, -1);
3570        }
3571        else
3572        {
3573          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3574                     tmp_typ[typ_i]);
3575          typ_i++;
3576          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3577                     tmp_ordsgn,v, bits, r->block1[i]);
3578        }
3579        break;
3580
3581      case ringorder_ds:
3582        if (r->block0[i]==r->block1[i])
3583        {
3584          rO_LexVars_neg(j, j_bits,r->block0[i],r->block1[i],prev_ordsgn,
3585                         tmp_ordsgn,v,bits, -1);
3586        }
3587        else
3588        {
3589          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3590                         tmp_typ[typ_i]);
3591          typ_i++;
3592          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3593                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3594        }
3595        break;
3596
3597      case ringorder_Ds:
3598        if (r->block0[i]==r->block1[i])
3599        {
3600          rO_LexVars_neg(j, j_bits, r->block0[i],r->block0[i],prev_ordsgn,
3601                         tmp_ordsgn,v, bits, -1);
3602        }
3603        else
3604        {
3605          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3606                         tmp_typ[typ_i]);
3607          typ_i++;
3608          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3609                     tmp_ordsgn,v, bits, r->block1[i]);
3610        }
3611        break;
3612
3613      case ringorder_wp:
3614        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3615                   tmp_typ[typ_i], r->wvhdl[i]);
3616        typ_i++;
3617        { // check for weights <=0
3618          int jj;
3619          BOOLEAN have_bad_weights=FALSE;
3620          for(jj=r->block1[i]-r->block0[i];jj>=0; jj--)
3621          {
3622            if (r->wvhdl[i][jj]<=0) have_bad_weights=TRUE;
3623          }
3624          if (have_bad_weights)
3625          {
3626             rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3627                                     tmp_typ[typ_i]);
3628             typ_i++;
3629          }
3630        }
3631        if (r->block1[i]!=r->block0[i])
3632        {
3633          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3634                         tmp_ordsgn, v,bits, r->block0[i]);
3635        }
3636        break;
3637
3638      case ringorder_Wp:
3639        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3640                   tmp_typ[typ_i], r->wvhdl[i]);
3641        typ_i++;
3642        { // check for weights <=0
3643          int j;
3644          BOOLEAN have_bad_weights=FALSE;
3645          for(j=r->block1[i]-r->block0[i];j>=0; j--)
3646          {
3647            if (r->wvhdl[i][j]<=0) have_bad_weights=TRUE;
3648          }
3649          if (have_bad_weights)
3650          {
3651             rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3652                                     tmp_typ[typ_i]);
3653             typ_i++;
3654          }
3655        }
3656        if (r->block1[i]!=r->block0[i])
3657        {
3658          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3659                     tmp_ordsgn,v, bits, r->block1[i]);
3660        }
3661        break;
3662
3663      case ringorder_ws:
3664        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3665                       tmp_typ[typ_i], r->wvhdl[i]);
3666        typ_i++;
3667        if (r->block1[i]!=r->block0[i])
3668        {
3669          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3670                         tmp_ordsgn, v,bits, r->block0[i]);
3671        }
3672        break;
3673
3674      case ringorder_Ws:
3675        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3676                       tmp_typ[typ_i], r->wvhdl[i]);
3677        typ_i++;
3678        if (r->block1[i]!=r->block0[i])
3679        {
3680          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3681                     tmp_ordsgn,v, bits, r->block1[i]);
3682        }
3683        break;
3684
3685      case ringorder_S:
3686        assume(typ_i == 1); // For LaScala3 only: on the 2nd place ([1])!
3687        // TODO: for K[x]: it is 0...?!
3688        rO_Syzcomp(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
3689        need_to_add_comp=TRUE;
3690        typ_i++;
3691        break;
3692
3693      case ringorder_s:
3694        assume(typ_i == 0 && j == 0);
3695        rO_Syz(j, j_bits, prev_ordsgn, tmp_ordsgn, tmp_typ[typ_i]); // set syz-limit?
3696        need_to_add_comp=TRUE;
3697        typ_i++;
3698        break;
3699
3700      case ringorder_IS:
3701      {
3702
3703        assume( r->block0[i] == r->block1[i] );
3704        const int s = r->block0[i];
3705        assume( -2 < s && s < 2);
3706
3707        if(s == 0) // Prefix IS
3708          rO_ISPrefix(j, j_bits, prev_ordsgn, tmp_ordsgn, r->N, v, tmp_typ[typ_i++]); // What about prev_ordsgn?
3709        else // s = +1 or -1 // Note: typ_i might be incrimented here inside!
3710        {
3711          rO_ISSuffix(j, j_bits, prev_ordsgn, tmp_ordsgn, r->N, v, tmp_typ, typ_i, s); // Suffix.
3712          need_to_add_comp=FALSE;
3713        }
3714
3715        break;
3716      }
3717      case ringorder_unspec:
3718      case ringorder_no:
3719      default:
3720        dReportError("undef. ringorder used\n");
3721        break;
3722    }
3723  }
3724
3725  int j0=j; // save j
3726  int j_bits0=j_bits; // save jbits
3727  rO_Align(j,j_bits);
3728  r->CmpL_Size = j;
3729
3730  j_bits=j_bits0; j=j0;
3731
3732  // fill in some empty slots with variables not already covered
3733  // v0 is special, is therefore normally already covered
3734  // now we do have rings without comp...
3735  if((need_to_add_comp) && (v[0]== -1))
3736  {
3737    if (prev_ordsgn==1)
3738    {
3739      rO_Align(j, j_bits);
3740      rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3741    }
3742    else
3743    {
3744      rO_Align(j, j_bits);
3745      rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3746    }
3747  }
3748  // the variables
3749  for(i=1 ; i<=r->N ; i++)
3750  {
3751    if(v[i]==(-1))
3752    {
3753      if (prev_ordsgn==1)
3754      {
3755        rO_LexVars(j, j_bits, i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3756      }
3757      else
3758      {
3759        rO_LexVars_neg(j,j_bits,i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3760      }
3761    }
3762  }
3763
3764  rO_Align(j,j_bits);
3765  // ----------------------------
3766  // finished with constructing the monomial, computing sizes:
3767
3768  r->ExpL_Size=j;
3769  r->PolyBin = omGetSpecBin(POLYSIZE + (r->ExpL_Size)*sizeof(long));
3770  assume(r->PolyBin != NULL);
3771
3772  // ----------------------------
3773  // indices and ordsgn vector for comparison
3774  //
3775  // r->pCompHighIndex already set
3776  r->ordsgn=(long *)omAlloc0(r->ExpL_Size*sizeof(long));
3777
3778  for(j=0;j<r->CmpL_Size;j++)
3779  {
3780    r->ordsgn[j] = tmp_ordsgn[j];
3781  }
3782
3783  omFreeSize((ADDRESS)tmp_ordsgn,(3*(n+r->N)*sizeof(long)));
3784
3785  // ----------------------------
3786  // description of orderings for setm:
3787  //
3788  r->OrdSize=typ_i;
3789  if (typ_i==0) r->typ=NULL;
3790  else
3791  {
3792    r->typ=(sro_ord*)omAlloc(typ_i*sizeof(sro_ord));
3793    memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
3794  }
3795  omFreeSize((ADDRESS)tmp_typ,(3*(n+r->N)*sizeof(sro_ord)));
3796
3797  // ----------------------------
3798  // indices for (first copy of ) variable entries in exp.e vector (VarOffset):
3799  r->VarOffset=v;
3800
3801  // ----------------------------
3802  // other indicies
3803  r->pCompIndex=(r->VarOffset[0] & 0xffff); //r->VarOffset[0];
3804  i=0; // position
3805  j=0; // index in r->typ
3806  if (i==r->pCompIndex) i++; // IS???
3807  while ((j < r->OrdSize)
3808         && ((r->typ[j].ord_typ==ro_syzcomp) ||
3809             (r->typ[j].ord_typ==ro_syz) || (r->typ[j].ord_typ==ro_isTemp) || (r->typ[j].ord_typ==ro_is) ||
3810             (r->order[r->typ[j].order_index] == ringorder_aa)))
3811  {
3812    i++; j++;
3813  }
3814  // No use of j anymore!!!????
3815
3816  if (i==r->pCompIndex) i++;
3817  r->pOrdIndex=i; // How came it is "i" here???!!!! exp[r->pOrdIndex] is order of a poly... This may be wrong!!! IS
3818
3819  // ----------------------------
3820  rSetDegStuff(r);
3821  rSetOption(r);
3822  // ----------------------------
3823  // r->p_Setm
3824  r->p_Setm = p_GetSetmProc(r);
3825
3826  // ----------------------------
3827  // set VarL_*
3828  rSetVarL(r);
3829
3830  //  ----------------------------
3831  // right-adjust VarOffset
3832  rRightAdjustVarOffset(r);
3833
3834  // ----------------------------
3835  // set NegWeightL*
3836  rSetNegWeight(r);
3837
3838  // ----------------------------
3839  // p_Procs: call AFTER NegWeightL
3840  r->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
3841  p_ProcsSet(r, r->p_Procs);
3842  return FALSE;
3843}
3844
3845void rUnComplete(ring r)
3846{
3847  if (r == NULL) return;
3848  if (r->VarOffset != NULL)
3849  {
3850    if (r->OrdSize!=0 && r->typ != NULL)
3851    {
3852      for(int i = 0; i < r->OrdSize; i++)
3853        if( r->typ[i].ord_typ == ro_is) // Search for suffixes! (prefix have the same VarOffset)
3854        {
3855          id_Delete(&r->typ[i].data.is.F, r);
3856          r->typ[i].data.is.F = NULL; // ?
3857
3858          if( r->typ[i].data.is.componentWeights != NULL )
3859          {
3860            delete r->typ[i].data.is.componentWeights;
3861            r->typ[i].data.is.componentWeights = NULL; // ?
3862          }
3863
3864          if( r->typ[i].data.is.pVarOffset != NULL )
3865          {
3866            omFreeSize((ADDRESS)r->typ[i].data.is.pVarOffset, (r->N +1)*sizeof(int));
3867            r->typ[i].data.is.pVarOffset = NULL; // ?
3868          }
3869        }
3870        else if (r->typ[i].ord_typ == ro_syz)
3871        {
3872          if(r->typ[i].data.syz.limit > 0)
3873            omFreeSize(r->typ[i].data.syz.syz_index, ((r->typ[i].data.syz.limit) +1)*sizeof(int));
3874          r->typ[i].data.syz.syz_index = NULL;
3875        }
3876        else if (r->typ[i].ord_typ == ro_syzcomp)
3877        {
3878          assume( r->typ[i].data.syzcomp.ShiftedComponents == NULL );
3879          assume( r->typ[i].data.syzcomp.Components        == NULL );
3880//          WarnS( "rUnComplete : ord_typ == ro_syzcomp was unhandled!!! Possibly memory leak!!!"  );
3881#ifndef NDEBUG
3882//          assume(0);
3883#endif
3884        }
3885
3886      omFreeSize((ADDRESS)r->typ,r->OrdSize*sizeof(sro_ord)); r->typ = NULL;
3887    }
3888
3889    if (r->order != NULL)
3890    {
3891      // delete r->order!!!???
3892    }
3893
3894    if (r->PolyBin != NULL)
3895      omUnGetSpecBin(&(r->PolyBin));
3896
3897    omFreeSize((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
3898
3899    if (r->ordsgn != NULL && r->CmpL_Size != 0)
3900      omFreeSize((ADDRESS)r->ordsgn,r->ExpL_Size*sizeof(long));
3901    if (r->p_Procs != NULL)
3902      omFreeSize(r->p_Procs, sizeof(p_Procs_s));
3903    omfreeSize(r->VarL_Offset, r->VarL_Size*sizeof(int));
3904  }
3905  if (r->NegWeightL_Offset!=NULL)
3906  {
3907    omFreeSize(r->NegWeightL_Offset, r->NegWeightL_Size*sizeof(int));
3908    r->NegWeightL_Offset=NULL;
3909  }
3910}
3911
3912// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
3913static void rSetVarL(ring r)
3914{
3915  int  min = INT_MAX, min_j = -1;
3916  int* VarL_Number = (int*) omAlloc0(r->ExpL_Size*sizeof(int));
3917
3918  int i,j;
3919
3920  // count how often a var long is occupied by an exponent
3921  for (i=1; i<=r->N; i++)
3922  {
3923    VarL_Number[r->VarOffset[i] & 0xffffff]++;
3924  }
3925
3926  // determine how many and min
3927  for (i=0, j=0; i<r->ExpL_Size; i++)
3928  {
3929    if (VarL_Number[i] != 0)
3930    {
3931      if (min > VarL_Number[i])
3932      {
3933        min = VarL_Number[i];
3934        min_j = j;
3935      }
3936      j++;
3937    }
3938  }
3939
3940  r->VarL_Size = j; // number of long with exp. entries in
3941                    //  in p->exp
3942  r->VarL_Offset = (int*) omAlloc(r->VarL_Size*sizeof(int));
3943  r->VarL_LowIndex = 0;
3944
3945  // set VarL_Offset
3946  for (i=0, j=0; i<r->ExpL_Size; i++)
3947  {
3948    if (VarL_Number[i] != 0)
3949    {
3950      r->VarL_Offset[j] = i;
3951      if (j > 0 && r->VarL_Offset[j-1] != r->VarL_Offset[j] - 1)
3952        r->VarL_LowIndex = -1;
3953      j++;
3954    }
3955  }
3956  if (r->VarL_LowIndex >= 0)
3957    r->VarL_LowIndex = r->VarL_Offset[0];
3958
3959  r->MinExpPerLong = min;
3960  if (min_j != 0)
3961  {
3962    j = r->VarL_Offset[min_j];
3963    r->VarL_Offset[min_j] = r->VarL_Offset[0];
3964    r->VarL_Offset[0] = j;
3965  }
3966  omFree(VarL_Number);
3967}
3968
3969static void rRightAdjustVarOffset(ring r)
3970{
3971  int* shifts = (int*) omAlloc(r->ExpL_Size*sizeof(int));
3972  int i;
3973  // initialize shifts
3974  for (i=0;i<r->ExpL_Size;i++)
3975    shifts[i] = BIT_SIZEOF_LONG;
3976
3977  // find minimal bit shift in each long exp entry
3978  for (i=1;i<=r->N;i++)
3979  {
3980    if (shifts[r->VarOffset[i] & 0xffffff] > r->VarOffset[i] >> 24)
3981      shifts[r->VarOffset[i] & 0xffffff] = r->VarOffset[i] >> 24;
3982  }
3983  // reset r->VarOffset: set the minimal shift to 0
3984  for (i=1;i<=r->N;i++)
3985  {
3986    if (shifts[r->VarOffset[i] & 0xffffff] != 0)
3987      r->VarOffset[i]
3988        = (r->VarOffset[i] & 0xffffff) |
3989        (((r->VarOffset[i] >> 24) - shifts[r->VarOffset[i] & 0xffffff]) << 24);
3990  }
3991  omFree(shifts);
3992}
3993
3994// get r->divmask depending on bits per exponent
3995static unsigned long rGetDivMask(int bits)
3996{
3997  unsigned long divmask = 1;
3998  int i = bits;
3999
4000  while (i < BIT_SIZEOF_LONG)
4001  {
4002    divmask |= (((unsigned long) 1) << (unsigned long) i);
4003    i += bits;
4004  }
4005  return divmask;
4006}
4007
4008#ifdef RDEBUG
4009void rDebugPrint(ring r)
4010{
4011  if (r==NULL)
4012  {
4013    PrintS("NULL ?\n");
4014    return;
4015  }
4016  // corresponds to ro_typ from ring.h:
4017  const char *TYP[]={"ro_dp","ro_wp","ro_wp64","ro_wp_neg","ro_cp",
4018                     "ro_syzcomp", "ro_syz", "ro_isTemp", "ro_is", "ro_none"};
4019  int i,j;
4020
4021  Print("ExpL_Size:%d ",r->ExpL_Size);
4022  Print("CmpL_Size:%d ",r->CmpL_Size);
4023  Print("VarL_Size:%d\n",r->VarL_Size);
4024  Print("bitmask=0x%lx (expbound=%ld) \n",r->bitmask, r->bitmask);
4025  Print("BitsPerExp=%d ExpPerLong=%d MinExpPerLong=%d at L[%d]\n", r->BitsPerExp, r->ExpPerLong, r->MinExpPerLong, r->VarL_Offset[0]);
4026  PrintS("varoffset:\n");
4027  if (r->VarOffset==NULL) PrintS(" NULL\n");
4028  else
4029    for(j=0;j<=r->N;j++)
4030      Print("  v%d at e-pos %d, bit %d\n",
4031            j,r->VarOffset[j] & 0xffffff, r->VarOffset[j] >>24);
4032  Print("divmask=%lx\n", r->divmask);
4033  PrintS("ordsgn:\n");
4034  for(j=0;j<r->CmpL_Size;j++)
4035    Print("  ordsgn %ld at pos %d\n",r->ordsgn[j],j);
4036  Print("OrdSgn:%d\n",r->OrdSgn);
4037  PrintS("ordrec:\n");
4038  for(j=0;j<r->OrdSize;j++)
4039  {
4040    Print("  typ %s", TYP[r->typ[j].ord_typ]);
4041
4042
4043    if (r->typ[j].ord_typ==ro_syz)
4044    {
4045      const short place = r->typ[j].data.syz.place;
4046      const int limit = r->typ[j].data.syz.limit;
4047      const int curr_index = r->typ[j].data.syz.curr_index;
4048      const int* syz_index = r->typ[j].data.syz.syz_index;
4049
4050      Print("  limit %d (place: %d, curr_index: %d), syz_index: ", limit, place, curr_index);
4051
4052      if( syz_index == NULL )
4053        PrintS("(NULL)");
4054      else
4055      {
4056        Print("{");
4057        for( i=0; i <= limit; i++ )
4058          Print("%d ", syz_index[i]);
4059        Print("}");
4060      }
4061
4062    }
4063    else if (r->typ[j].ord_typ==ro_isTemp)
4064    {
4065      Print("  start (level) %d, suffixpos: %d, VO: ",r->typ[j].data.isTemp.start, r->typ[j].data.isTemp.suffixpos);
4066
4067#ifndef NDEBUG
4068      for( int k = 0; k <= r->N; k++)
4069        if (r->typ[j].data.isTemp.pVarOffset[k] != -1)
4070          Print("[%2d]: %09x; ", k, r->typ[j].data.isTemp.pVarOffset[k]);
4071#endif
4072    }
4073    else if (r->typ[j].ord_typ==ro_is)
4074    {
4075      Print("  start %d, end: %d: ",r->typ[j].data.is.start, r->typ[j].data.is.end);
4076
4077//      for( int k = 0; k <= r->N; k++) if (r->typ[j].data.is.pVarOffset[k] != -1) Print("[%2d]: %04x; ", k, r->typ[j].data.is.pVarOffset[k]);
4078
4079      Print("  limit %d\n",r->typ[j].data.is.limit);
4080      #ifndef NDEBUG
4081      PrintS("  F: ");idShow(r->typ[j].data.is.F, r, r, 1);
4082      #endif
4083
4084      PrintS("weights: ");
4085
4086      if( r->typ[j].data.is.componentWeights == NULL )
4087        PrintS("NULL == [0,...0]\n");
4088      else
4089      {
4090        (r->typ[j].data.is.componentWeights)->show(); PrintLn();
4091      }
4092    }
4093    else
4094    {
4095      Print("  place %d",r->typ[j].data.dp.place);
4096
4097      if (r->typ[j].ord_typ!=ro_syzcomp  && r->typ[j].ord_typ!=ro_syz)
4098      {
4099        Print("  start %d",r->typ[j].data.dp.start);
4100        Print("  end %d",r->typ[j].data.dp.end);
4101        if ((r->typ[j].ord_typ==ro_wp)
4102        || (r->typ[j].ord_typ==ro_wp_neg))
4103        {
4104          PrintS(" w:");
4105          for(int l=r->typ[j].data.wp.start;l<=r->typ[j].data.wp.end;l++)
4106            Print(" %d",r->typ[j].data.wp.weights[l-r->typ[j].data.wp.start]);
4107        }
4108        else if (r->typ[j].ord_typ==ro_wp64)
4109        {
4110          PrintS(" w64:");
4111          int l;
4112          for(l=r->typ[j].data.wp64.start;l<=r->typ[j].data.wp64.end;l++)
4113            Print(" %ld",(long)(((int64*)r->typ[j].data.wp64.weights64)+l-r->typ[j].data.wp64.start));
4114          }
4115        }
4116    }
4117    PrintLn();
4118  }
4119  Print("pOrdIndex:%d pCompIndex:%d\n", r->pOrdIndex, r->pCompIndex);
4120  Print("OrdSize:%d\n",r->OrdSize);
4121  PrintS("--------------------\n");
4122  for(j=0;j<r->ExpL_Size;j++)
4123  {
4124    Print("L[%d]: ",j);
4125    if (j< r->CmpL_Size)
4126      Print("ordsgn %ld ", r->ordsgn[j]);
4127    else
4128      PrintS("no comp ");
4129    i=1;
4130    for(;i<=r->N;i++)
4131    {
4132      if( (r->VarOffset[i] & 0xffffff) == j )
4133      {  Print("v%d at e[%d], bit %d; ", i,r->VarOffset[i] & 0xffffff,
4134                                         r->VarOffset[i] >>24 ); }
4135    }
4136    if( r->pCompIndex==j ) PrintS("v0; ");
4137    for(i=0;i<r->OrdSize;i++)
4138    {
4139      if (r->typ[i].data.dp.place == j)
4140      {
4141        Print("ordrec:%s (start:%d, end:%d) ",TYP[r->typ[i].ord_typ],
4142          r->typ[i].data.dp.start, r->typ[i].data.dp.end);
4143      }
4144    }
4145
4146    if (j==r->pOrdIndex)
4147      PrintS("pOrdIndex\n");
4148    else
4149      PrintLn();
4150  }
4151
4152  // p_Procs stuff
4153  p_Procs_s proc_names;
4154  const char* field;
4155  const char* length;
4156  const char* ord;
4157  p_Debug_GetProcNames(r, &proc_names); // changes p_Procs!!!
4158  p_Debug_GetSpecNames(r, field, length, ord);
4159
4160  Print("p_Spec  : %s, %s, %s\n", field, length, ord);
4161  PrintS("p_Procs :\n");
4162  for (i=0; i<(int) (sizeof(p_Procs_s)/sizeof(void*)); i++)
4163  {
4164    Print(" %s,\n", ((char**) &proc_names)[i]);
4165  }
4166
4167  {
4168#define pFDeg_CASE(A) if(r->pFDeg == A) PrintS( "" #A "" )
4169    Print("\npFDeg   : ");
4170   
4171    pFDeg_CASE(p_Totaldegree); else
4172      pFDeg_CASE(pWFirstTotalDegree); else
4173      pFDeg_CASE(pWTotaldegree); else
4174      pFDeg_CASE(pDeg); else
4175      Print("(%p)", r->pFDeg); // default case
4176   
4177    PrintS("\n");
4178#undef pFDeg_CASE
4179  }
4180   
4181}
4182
4183void p_DebugPrint(poly p, const ring r)
4184{
4185  int i,j;
4186  p_Write(p,r);
4187  j=2;
4188  while(p!=NULL)
4189  {
4190    Print("\nexp[0..%d]\n",r->ExpL_Size-1);
4191    for(i=0;i<r->ExpL_Size;i++)
4192      Print("%ld ",p->exp[i]);
4193    PrintLn();
4194    Print("v0:%ld ",p_GetComp(p, r));
4195    for(i=1;i<=r->N;i++) Print(" v%d:%ld",i,p_GetExp(p,i, r));
4196    PrintLn();
4197    pIter(p);
4198    j--;
4199    if (j==0) { PrintS("...\n"); break; }
4200  }
4201}
4202
4203void pDebugPrint(poly p)
4204{
4205  p_DebugPrint(p, currRing);
4206}
4207#endif // RDEBUG
4208
4209/// debug-print monomial poly/vector p, assuming that it lives in the ring R
4210static inline void m_DebugPrint(const poly p, const ring R)
4211{
4212  Print("\nexp[0..%d]\n", R->ExpL_Size - 1);
4213  for(int i = 0; i < R->ExpL_Size; i++)
4214    Print("%09lx ", p->exp[i]);
4215  PrintLn();
4216  Print("v0:%9ld ", p_GetComp(p, R));
4217  for(int i = 1; i <= R->N; i++) Print(" v%d:%5ld",i, p_GetExp(p, i, R));
4218  PrintLn();
4219}
4220
4221
4222#ifndef NDEBUG
4223/// debug-print at most nTerms (2 by default) terms from poly/vector p,
4224/// assuming that lt(p) lives in lmRing and tail(p) lives in tailRing.
4225void p_DebugPrint(const poly p, const ring lmRing, const ring tailRing, const int nTerms)
4226{
4227  assume( nTerms >= 0 );
4228  if( p != NULL )
4229  {
4230    assume( p != NULL );
4231
4232    p_Write(p, lmRing, tailRing);
4233
4234    if( (p != NULL) && (nTerms > 0) )
4235    {
4236      assume( p != NULL );
4237      assume( nTerms > 0 );
4238
4239      // debug pring leading term
4240      m_DebugPrint(p, lmRing);
4241
4242      poly q = pNext(p); // q = tail(p)
4243
4244      // debug pring tail (at most nTerms-1 terms from it)
4245      for(int j = nTerms - 1; (q !=NULL) && (j > 0); pIter(q), --j)
4246        m_DebugPrint(q, tailRing);
4247
4248      if (q != NULL)
4249        PrintS("...\n");
4250    }
4251  }
4252  else
4253    PrintS("0\n");
4254}
4255#endif
4256
4257
4258//    F = system("ISUpdateComponents", F, V, MIN );
4259//    // replace gen(i) -> gen(MIN + V[i-MIN]) for all i > MIN in all terms from F!
4260void pISUpdateComponents(ideal F, const intvec *const V, const int MIN, const ring r = currRing)
4261{
4262  assume( V != NULL );
4263  assume( MIN >= 0 );
4264
4265  if( F == NULL )
4266    return;
4267
4268  for( int j = (F->ncols*F->nrows) - 1; j >= 0; j-- )
4269  {
4270#ifdef PDEBUG
4271    Print("F[%d]:", j);
4272    p_DebugPrint(F->m[j], r, r, 0);
4273#endif
4274
4275    for( poly p = F->m[j]; p != NULL; pIter(p) )
4276    {
4277      int c = p_GetComp(p, r);
4278
4279      if( c > MIN )
4280      {
4281#ifdef PDEBUG
4282        Print("gen[%d] -> gen(%d)\n", c, MIN + (*V)[ c - MIN - 1 ]);
4283#endif
4284
4285        p_SetComp( p, MIN + (*V)[ c - MIN - 1 ], r );
4286      }
4287    }
4288#ifdef PDEBUG
4289    Print("new F[%d]:", j);
4290    p_Test(F->m[j], r);
4291    p_DebugPrint(F->m[j], r, r, 0);
4292#endif
4293  }
4294
4295}
4296
4297
4298
4299
4300/*2
4301* asssume that rComplete was called with r
4302* assume that the first block ist ringorder_S
4303* change the block to reflect the sequence given by appending v
4304*/
4305
4306#ifdef PDEBUG
4307void rDBChangeSComps(int* currComponents,
4308                     long* currShiftedComponents,
4309                     int length,
4310                     ring r)
4311{
4312  assume(r->typ[1].ord_typ == ro_syzcomp);
4313     
4314  r->typ[1].data.syzcomp.length = length;
4315  rNChangeSComps( currComponents, currShiftedComponents, r);
4316}
4317void rDBGetSComps(int** currComponents,
4318                 long** currShiftedComponents,
4319                 int *length,
4320                 ring r)
4321{
4322  assume(r->typ[1].ord_typ == ro_syzcomp);
4323 
4324  *length = r->typ[1].data.syzcomp.length;
4325  rNGetSComps( currComponents, currShiftedComponents, r);
4326}
4327#endif
4328
4329void rNChangeSComps(int* currComponents, long* currShiftedComponents, ring r)
4330{
4331  assume(r->typ[1].ord_typ == ro_syzcomp);
4332
4333  r->typ[1].data.syzcomp.ShiftedComponents = currShiftedComponents;
4334  r->typ[1].data.syzcomp.Components = currComponents;
4335}
4336
4337void rNGetSComps(int** currComponents, long** currShiftedComponents, ring r)
4338{
4339  assume(r->typ[1].ord_typ == ro_syzcomp);
4340
4341  *currShiftedComponents = r->typ[1].data.syzcomp.ShiftedComponents;
4342  *currComponents =   r->typ[1].data.syzcomp.Components;
4343}
4344
4345/////////////////////////////////////////////////////////////////////////////
4346//
4347// The following routines all take as input a ring r, and return R
4348// where R has a certain property. R might be equal r in which case r
4349// had already this property
4350//
4351// Without argument, these functions work on currRing and change it,
4352// if necessary
4353
4354// for the time being, this is still here
4355static ring rAssure_SyzComp(const ring r, BOOLEAN complete = TRUE);
4356
4357ring rCurrRingAssure_SyzComp()
4358{
4359#if MYTEST
4360  PrintS("rCurrRingAssure_SyzComp(), currRing:  \n");
4361  rWrite(currRing);
4362#ifdef RDEBUG
4363  rDebugPrint(currRing);
4364#endif
4365  PrintLn();
4366#endif
4367
4368  ring r = rAssure_SyzComp(currRing, TRUE);
4369
4370  if( r != currRing )
4371  {
4372    rChangeCurrRing(r);
4373    assume(currRing == r);
4374
4375#if MYTEST
4376  PrintS("\nrCurrRingAssure_SyzComp(): new currRing: \n");
4377  rWrite(currRing);
4378#ifdef RDEBUG
4379  rDebugPrint(currRing);
4380#endif
4381  PrintLn();
4382#endif
4383  }
4384
4385  return r;
4386}
4387
4388static ring rAssure_SyzComp(const ring r, BOOLEAN complete)
4389{
4390  if ( (r->order[0] == ringorder_s) ) return r;
4391
4392  if ( (r->order[0] == ringorder_IS) )
4393  {
4394#ifndef NDEBUG
4395    WarnS("rAssure_SyzComp: input ring has an IS-ordering!");
4396#endif
4397//    return r;
4398  }
4399  ring res=rCopy0(r, FALSE, FALSE);
4400  int i=rBlocks(r);
4401  int j;
4402
4403  res->order=(int *)omAlloc((i+1)*sizeof(int));
4404  res->block0=(int *)omAlloc0((i+1)*sizeof(int));
4405  res->block1=(int *)omAlloc0((i+1)*sizeof(int));
4406  int ** wvhdl =(int **)omAlloc0((i+1)*sizeof(int**));
4407  for(j=i;j>0;j--)
4408  {
4409    res->order[j]=r->order[j-1];
4410    res->block0[j]=r->block0[j-1];
4411    res->block1[j]=r->block1[j-1];
4412    if (r->wvhdl[j-1] != NULL)
4413    {
4414      wvhdl[j] = (int*) omMemDup(r->wvhdl[j-1]);
4415    }
4416  }
4417  res->order[0]=ringorder_s;
4418
4419  res->wvhdl = wvhdl;
4420
4421  if (complete)
4422  {
4423    rComplete(res, 1);
4424
4425#ifdef HAVE_PLURAL
4426    if (rIsPluralRing(r))
4427    {
4428      if ( nc_rComplete(r, res, false) ) // no qideal!
4429      {
4430#ifndef NDEBUG
4431        WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
4432#endif
4433      }
4434    }
4435    assume(rIsPluralRing(r) == rIsPluralRing(res));
4436#endif
4437
4438
4439#ifdef HAVE_PLURAL
4440    ring old_ring = r;
4441
4442#if MYTEST
4443    PrintS("rCurrRingAssure_SyzComp(): temp r': ");
4444    rWrite(r);
4445#ifdef RDEBUG
4446    rDebugPrint(r);
4447#endif
4448    PrintLn();
4449#endif
4450#endif
4451
4452
4453    if (r->qideal!=NULL)
4454    {
4455      res->qideal= idrCopyR_NoSort(r->qideal, r, res);
4456
4457      assume(idRankFreeModule(res->qideal, res) == 0);
4458
4459#ifdef HAVE_PLURAL
4460      if( rIsPluralRing(res) )
4461        if( nc_SetupQuotient(res, r, true) )
4462        {
4463//          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4464        }
4465
4466#endif
4467      assume(idRankFreeModule(res->qideal, res) == 0);
4468    }
4469
4470#ifdef HAVE_PLURAL
4471    assume((res->qideal==NULL) == (old_ring->qideal==NULL));
4472    assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
4473    assume(rIsSCA(res) == rIsSCA(old_ring));
4474    assume(ncRingType(res) == ncRingType(old_ring));
4475#endif
4476
4477#if MYTEST
4478    PrintS("rCurrRingAssure_SyzComp(): res: ");
4479    rWrite(r);
4480#ifdef RDEBUG
4481    rDebugPrint(r);
4482#endif
4483    PrintLn();
4484#endif
4485
4486  }
4487
4488  return res;
4489}
4490
4491ring rAssure_TDeg(ring r, int start_var, int end_var, int &pos)
4492{
4493  int i;
4494  if (r->typ!=NULL)
4495  {
4496    for(i=r->OrdSize-1;i>=0;i--)
4497    {
4498      if ((r->typ[i].ord_typ==ro_dp)
4499      && (r->typ[i].data.dp.start==start_var)
4500      && (r->typ[i].data.dp.end==end_var))
4501      {
4502        pos=r->typ[i].data.dp.place;
4503        //printf("no change, pos=%d\n",pos);
4504        return r;
4505      }
4506    }
4507  }
4508
4509#ifdef HAVE_PLURAL
4510  nc_struct* save=r->GetNC();
4511  r->GetNC()=NULL;
4512#endif
4513  ring res=rCopy(r);
4514
4515  i=rBlocks(r);
4516  int j;
4517
4518  res->ExpL_Size=r->ExpL_Size+1; // one word more in each monom
4519  res->PolyBin=omGetSpecBin(POLYSIZE + (res->ExpL_Size)*sizeof(long));
4520  omFree((ADDRESS)res->ordsgn);
4521  res->ordsgn=(long *)omAlloc0(res->ExpL_Size*sizeof(long));
4522  for(j=0;j<r->CmpL_Size;j++)
4523  {
4524    res->ordsgn[j] = r->ordsgn[j];
4525  }
4526  res->OrdSize=r->OrdSize+1;   // one block more for pSetm
4527  if (r->typ!=NULL)
4528    omFree((ADDRESS)res->typ);
4529  res->typ=(sro_ord*)omAlloc0(res->OrdSize*sizeof(sro_ord));
4530  if (r->typ!=NULL)
4531    memcpy(res->typ,r->typ,r->OrdSize*sizeof(sro_ord));
4532  // the additional block for pSetm: total degree at the last word
4533  // but not included in the compare part
4534  res->typ[res->OrdSize-1].ord_typ=ro_dp;
4535  res->typ[res->OrdSize-1].data.dp.start=start_var;
4536  res->typ[res->OrdSize-1].data.dp.end=end_var;
4537  res->typ[res->OrdSize-1].data.dp.place=res->ExpL_Size-1;
4538  pos=res->ExpL_Size-1;
4539  //if ((start_var==1) && (end_var==res->N)) res->pOrdIndex=pos;
4540  extern void p_Setm_General(poly p, ring r);
4541  res->p_Setm=p_Setm_General;
4542  // ----------------------------
4543  omFree((ADDRESS)res->p_Procs);
4544  res->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
4545
4546  p_ProcsSet(res, res->p_Procs);
4547  if (res->qideal!=NULL) id_Delete(&res->qideal,res);
4548#ifdef HAVE_PLURAL
4549  r->GetNC()=save;
4550  if (rIsPluralRing(r))
4551  {
4552    if ( nc_rComplete(r, res, false) ) // no qideal!
4553    {
4554#ifndef NDEBUG
4555      WarnS("error in nc_rComplete");
4556#endif
4557      // just go on..
4558    }
4559  }
4560#endif
4561  if (r->qideal!=NULL)
4562  {
4563     res->qideal=idrCopyR_NoSort(r->qideal,r, res);
4564#ifdef HAVE_PLURAL
4565     if (rIsPluralRing(res))
4566     {
4567       nc_SetupQuotient(res, currRing);
4568     }
4569     assume((res->qideal==NULL) == (r->qideal==NULL));
4570#endif
4571  }
4572
4573#ifdef HAVE_PLURAL
4574  assume(rIsPluralRing(res) == rIsPluralRing(r));
4575  assume(rIsSCA(res) == rIsSCA(r));
4576  assume(ncRingType(res) == ncRingType(r));
4577#endif
4578
4579  return res;
4580}
4581
4582ring rAssure_HasComp(ring r)
4583{
4584  int last_block;
4585  int i=0;
4586  do
4587  {
4588     if (r->order[i] == ringorder_c ||
4589        r->order[i] == ringorder_C) return r;
4590     if (r->order[i] == 0)
4591        break;
4592     i++;
4593  } while (1);
4594  //WarnS("re-creating ring with comps");
4595  last_block=i-1;
4596
4597  ring new_r = rCopy0(r, FALSE, FALSE);
4598  i+=2;
4599  new_r->wvhdl=(int **)omAlloc0(i * sizeof(int_ptr));
4600  new_r->order   = (int *) omAlloc0(i * sizeof(int));
4601  new_r->block0   = (int *) omAlloc0(i * sizeof(int));
4602  new_r->block1   = (int *) omAlloc0(i * sizeof(int));
4603  memcpy(new_r->order,r->order,(i-1) * sizeof(int));
4604  memcpy(new_r->block0,r->block0,(i-1) * sizeof(int));
4605  memcpy(new_r->block1,r->block1,(i-1) * sizeof(int));
4606  for (int j=0; j<=last_block; j++)
4607  {
4608    if (r->wvhdl[j]!=NULL)
4609    {
4610      new_r->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
4611    }
4612  }
4613  last_block++;
4614  new_r->order[last_block]=ringorder_C;
4615  //new_r->block0[last_block]=0;
4616  //new_r->block1[last_block]=0;
4617  //new_r->wvhdl[last_block]=NULL;
4618
4619  rComplete(new_r, 1);
4620
4621#ifdef HAVE_PLURAL
4622  if (rIsPluralRing(r))
4623  {
4624    if ( nc_rComplete(r, new_r, false) ) // no qideal!
4625    {
4626#ifndef NDEBUG
4627      WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
4628#endif
4629    }
4630  }
4631  assume(rIsPluralRing(r) == rIsPluralRing(new_r));
4632#endif
4633
4634  return new_r;
4635}
4636
4637static ring rAssure_CompLastBlock(ring r, BOOLEAN complete = TRUE)
4638{
4639  int last_block = rBlocks(r) - 2;
4640  if (r->order[last_block] != ringorder_c &&
4641      r->order[last_block] != ringorder_C)
4642  {
4643    int c_pos = 0;
4644    int i;
4645
4646    for (i=0; i< last_block; i++)
4647    {
4648      if (r->order[i] == ringorder_c || r->order[i] == ringorder_C)
4649      {
4650        c_pos = i;
4651        break;
4652      }
4653    }
4654    if (c_pos != -1)
4655    {
4656      ring new_r = rCopy0(r, FALSE, TRUE);
4657      for (i=c_pos+1; i<=last_block; i++)
4658      {
4659        new_r->order[i-1] = new_r->order[i];
4660        new_r->block0[i-1] = new_r->block0[i];
4661        new_r->block1[i-1] = new_r->block1[i];
4662        new_r->wvhdl[i-1] = new_r->wvhdl[i];
4663      }
4664      new_r->order[last_block] = r->order[c_pos];
4665      new_r->block0[last_block] = r->block0[c_pos];
4666      new_r->block1[last_block] = r->block1[c_pos];
4667      new_r->wvhdl[last_block] = r->wvhdl[c_pos];
4668      if (complete)
4669      {
4670        rComplete(new_r, 1);
4671
4672#ifdef HAVE_PLURAL
4673        if (rIsPluralRing(r))
4674        {
4675          if ( nc_rComplete(r, new_r, false) ) // no qideal!
4676          {
4677#ifndef NDEBUG
4678            WarnS("error in nc_rComplete");   // cleanup?//      rDelete(res);//      return r;      // just go on..
4679#endif
4680          }
4681        }
4682        assume(rIsPluralRing(r) == rIsPluralRing(new_r));
4683#endif
4684      }
4685      return new_r;
4686    }
4687  }
4688  return r;
4689}
4690
4691ring rCurrRingAssure_CompLastBlock()
4692{
4693  ring new_r = rAssure_CompLastBlock(currRing);
4694  if (currRing != new_r)
4695  {
4696    ring old_r = currRing;
4697    rChangeCurrRing(new_r);
4698    if (old_r->qideal != NULL)
4699    {
4700      new_r->qideal = idrCopyR(old_r->qideal, old_r);
4701      currQuotient = new_r->qideal;
4702#ifdef HAVE_PLURAL
4703      if( rIsPluralRing(new_r) )
4704        if( nc_SetupQuotient(new_r, old_r, true) )
4705        {
4706#ifndef NDEBUG
4707          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4708#endif
4709        }
4710#endif
4711    }
4712
4713#ifdef HAVE_PLURAL
4714    assume((new_r->qideal==NULL) == (old_r->qideal==NULL));
4715    assume(rIsPluralRing(new_r) == rIsPluralRing(old_r));
4716    assume(rIsSCA(new_r) == rIsSCA(old_r));
4717    assume(ncRingType(new_r) == ncRingType(old_r));
4718#endif
4719
4720    rTest(new_r);
4721    rTest(old_r);
4722  }
4723  return new_r;
4724}
4725
4726// Moves _c or _C ordering to the last place AND adds _s on the 1st place
4727ring rCurrRingAssure_SyzComp_CompLastBlock()
4728{
4729  ring new_r_1 = rAssure_CompLastBlock(currRing, FALSE); // due to this FALSE - no completion!
4730  ring new_r = rAssure_SyzComp(new_r_1, FALSE); // new_r_1 is used only here!!!
4731
4732  if (new_r != currRing)
4733  {
4734    ring old_r = currRing;
4735    if (new_r_1 != new_r && new_r_1 != old_r) rDelete(new_r_1);
4736    rComplete(new_r, 1);
4737#ifdef HAVE_PLURAL
4738    if (rIsPluralRing(old_r))
4739    {
4740      if ( nc_rComplete(old_r, new_r, false) ) // no qideal!
4741      {
4742#ifndef NDEBUG
4743        WarnS("error in nc_rComplete"); // cleanup?      rDelete(res);       return r;  // just go on...?
4744#endif
4745        }
4746    }
4747    assume(rIsPluralRing(new_r) == rIsPluralRing(old_r));
4748#endif
4749    rChangeCurrRing(new_r);
4750    if (old_r->qideal != NULL)
4751    {
4752      new_r->qideal = idrCopyR(old_r->qideal, old_r);
4753      currQuotient = new_r->qideal;
4754
4755#ifdef HAVE_PLURAL
4756      if( rIsPluralRing(old_r) )
4757        if( nc_SetupQuotient(new_r, old_r, true) )
4758        {
4759#ifndef NDEBUG
4760          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4761#endif
4762        }
4763#endif
4764    }
4765
4766#ifdef HAVE_PLURAL
4767    assume((new_r->qideal==NULL) == (old_r->qideal==NULL));
4768    assume(rIsPluralRing(new_r) == rIsPluralRing(old_r));
4769    assume(rIsSCA(new_r) == rIsSCA(old_r));
4770    assume(ncRingType(new_r) == ncRingType(old_r));
4771#endif
4772
4773    rTest(new_r);
4774    rTest(old_r);
4775  }
4776  return new_r;
4777}
4778
4779// use this for global orderings consisting of two blocks
4780static ring rCurrRingAssure_Global(rRingOrder_t b1, rRingOrder_t b2)
4781{
4782  int r_blocks = rBlocks(currRing);
4783  int i;
4784
4785  assume(b1 == ringorder_c || b1 == ringorder_C ||
4786         b2 == ringorder_c || b2 == ringorder_C ||
4787         b2 == ringorder_S);
4788  if ((r_blocks == 3) &&
4789      (currRing->order[0] == b1) &&
4790      (currRing->order[1] == b2) &&
4791      (currRing->order[2] == 0))
4792    return currRing;
4793  ring res = rCopy0(currRing, TRUE, FALSE);
4794  res->order = (int*)omAlloc0(3*sizeof(int));
4795  res->block0 = (int*)omAlloc0(3*sizeof(int));
4796  res->block1 = (int*)omAlloc0(3*sizeof(int));
4797  res->wvhdl = (int**)omAlloc0(3*sizeof(int*));
4798  res->order[0] = b1;
4799  res->order[1] = b2;
4800  if (b1 == ringorder_c || b1 == ringorder_C)
4801  {
4802    res->block0[1] = 1;
4803    res->block1[1] = currRing->N;
4804  }
4805  else
4806  {
4807    res->block0[0] = 1;
4808    res->block1[0] = currRing->N;
4809  }
4810  // HANNES: This sould be set in rComplete
4811  res->OrdSgn = 1;
4812  rComplete(res, 1);
4813#ifdef HAVE_PLURAL
4814  if (rIsPluralRing(currRing))
4815  {
4816    if ( nc_rComplete(currRing, res, false) ) // no qideal!
4817    {
4818#ifndef NDEBUG
4819      WarnS("error in nc_rComplete");
4820#endif
4821    }
4822  }
4823#endif
4824  rChangeCurrRing(res);
4825  return res;
4826}
4827
4828
4829ring rAssure_InducedSchreyerOrdering(const ring r, BOOLEAN complete = TRUE, int sgn = 1)
4830{ // TODO: ???? Add leading Syz-comp ordering here...????
4831
4832#if MYTEST
4833    Print("rAssure_InducedSchreyerOrdering(r, complete = %d, sgn = %d): r: \n", complete, sgn);
4834    rWrite(r);
4835#ifdef RDEBUG
4836    rDebugPrint(r);
4837#endif
4838    PrintLn();
4839#endif
4840  assume((sgn == 1) || (sgn == -1));
4841
4842  ring res=rCopy0(r, FALSE, FALSE); // No qideal & ordering copy.
4843
4844  int n = rBlocks(r); // Including trailing zero!
4845
4846  // Create 2 more blocks for prefix/suffix:
4847  res->order=(int *)omAlloc0((n+2)*sizeof(int)); // 0  ..  n+1
4848  res->block0=(int *)omAlloc0((n+2)*sizeof(int));
4849  res->block1=(int *)omAlloc0((n+2)*sizeof(int));
4850  int ** wvhdl =(int **)omAlloc0((n+2)*sizeof(int**));
4851
4852  // Encapsulate all existing blocks between induced Schreyer ordering markers: prefix and suffix!
4853  // Note that prefix and suffix have the same ringorder marker and only differ in block[] parameters!
4854
4855  // new 1st block
4856  int j = 0;
4857  res->order[j] = ringorder_IS; // Prefix
4858  res->block0[j] = res->block1[j] = 0;
4859  // wvhdl[j] = NULL;
4860  j++;
4861
4862  for(int i = 0; (i <= n) && (r->order[i] != 0); i++, j++) // i = [0 .. n-1] <- non-zero old blocks
4863  {
4864    res->order [j] = r->order [i];
4865    res->block0[j] = r->block0[i];
4866    res->block1[j] = r->block1[i];
4867
4868    if (r->wvhdl[i] != NULL)
4869    {
4870      wvhdl[j] = (int*) omMemDup(r->wvhdl[i]);
4871    } // else wvhdl[j] = NULL;
4872  }
4873
4874  // new last block
4875  res->order [j] = ringorder_IS; // Suffix
4876  res->block0[j] = res->block1[j] = sgn; // Sign of v[o]: 1 for C, -1 for c
4877  // wvhdl[j] = NULL;
4878  j++;
4879
4880  // res->order [j] = 0; // The End!
4881  res->wvhdl = wvhdl;
4882
4883  // j == the last zero block now!
4884  assume(j == (n+1));
4885  assume(res->order[0]==ringorder_IS);
4886  assume(res->order[j-1]==ringorder_IS);
4887  assume(res->order[j]==0);
4888
4889
4890  if (complete)
4891  {
4892    rComplete(res, 1);
4893
4894#if MYTEST
4895    PrintS("rAssure_InducedSchreyerOrdering(): temp res: ");
4896    rWrite(res);
4897#ifdef RDEBUG
4898    rDebugPrint(res);
4899#endif
4900    PrintLn();
4901#endif
4902
4903#ifdef HAVE_PLURAL
4904    if (rIsPluralRing(r))
4905    {
4906      if ( nc_rComplete(r, res, false) ) // no qideal!
4907      {
4908#ifndef NDEBUG
4909        WarnS("error in nc_rComplete");      // cleanup?//      rDelete(res);//      return r;      // just go on..
4910#endif
4911      }
4912    }
4913    assume(rIsPluralRing(r) == rIsPluralRing(res));
4914#endif
4915
4916
4917#ifdef HAVE_PLURAL
4918    ring old_ring = r;
4919
4920#if MYTEST
4921    PrintS("rAssure_InducedSchreyerOrdering(): temp nc res: ");
4922    rWrite(res);
4923#ifdef RDEBUG
4924    rDebugPrint(res);
4925#endif
4926    PrintLn();
4927#endif
4928#endif
4929
4930    if (r->qideal!=NULL)
4931    {
4932      res->qideal= idrCopyR_NoSort(r->qideal, r, res);
4933
4934      assume(idRankFreeModule(res->qideal, res) == 0);
4935
4936#ifdef HAVE_PLURAL
4937      if( rIsPluralRing(res) )
4938        if( nc_SetupQuotient(res, r, true) )
4939        {
4940//          WarnS("error in nc_SetupQuotient"); // cleanup?      rDelete(res);       return r;  // just go on...?
4941        }
4942
4943#endif
4944      assume(idRankFreeModule(res->qideal, res) == 0);
4945    }
4946
4947#ifdef HAVE_PLURAL
4948    assume((res->qideal==NULL) == (old_ring->qideal==NULL));
4949    assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
4950    assume(rIsSCA(res) == rIsSCA(old_ring));
4951    assume(ncRingType(res) == ncRingType(old_ring));
4952#endif
4953  }
4954
4955  return res;
4956}
4957
4958ring rCurrRingAssure_dp_S()
4959{
4960  return rCurrRingAssure_Global(ringorder_dp, ringorder_S);
4961}
4962
4963ring rCurrRingAssure_dp_C()
4964{
4965  return rCurrRingAssure_Global(ringorder_dp, ringorder_C);
4966}
4967
4968ring rCurrRingAssure_C_dp()
4969{
4970  return rCurrRingAssure_Global(ringorder_C, ringorder_dp);
4971}
4972
4973
4974
4975/// Finds p^th IS ordering, and returns its position in r->typ[]
4976/// returns -1 if something went wrong!
4977int rGetISPos(const int p = 0, const ring r = currRing)
4978{
4979  // Put the reference set F into the ring -ordering -recor
4980#if MYTEST
4981  Print("rIsIS(p: %d)\nF:", p);
4982  PrintLn();
4983#endif
4984
4985  if (r->typ==NULL)
4986  {
4987    dReportError("'rIsIS:' Error: wrong ring! (typ == NULL)");
4988    return -1;
4989  }
4990
4991  int j = p; // Which IS record to use...
4992  for( int pos = 0; pos < r->OrdSize; pos++ )
4993    if( r->typ[pos].ord_typ == ro_is)
4994      if( j-- == 0 )
4995      {
4996        return pos;
4997      }
4998
4999  return -1;
5000}
5001
5002
5003
5004
5005
5006
5007/// Changes r by setting induced ordering parameters: limit and reference leading terms
5008/// F belong to r, we will DO a copy! (same to componentWeights)
5009/// We will use it AS IS!
5010/// returns true is everything was allright!
5011bool rSetISReference(const ideal F, const int i = 0, const int p = 0, const intvec * componentWeights = NULL, const ring r = currRing)
5012{
5013  // Put the reference set F into the ring -ordering -recor
5014#if MYTEST
5015  Print("rSetISReference(F, i: %d, p: %d, w)\nF:", i, p);
5016  idShow(F, r, r, 1); // currRing!
5017  PrintLn();
5018  PrintS("w: ");
5019  if(componentWeights == NULL)
5020    PrintS("NULL\n");
5021  else
5022    componentWeights->show();
5023#endif
5024
5025  // TEST THAT THERE ARE DEGs!!!
5026  // assume( componentWeights == NULL  ); // ???
5027  if( componentWeights != NULL )
5028  {
5029//    assure that the ring r has degrees!!!
5030//    Add weights to degrees of F[i]
5031  }
5032
5033  if (r->typ==NULL)
5034  {
5035    dReportError("Error: WRONG USE of rSetISReference: wrong ring! (typ == NULL)");
5036    return false;
5037  }
5038
5039
5040  int pos = rGetISPos(p, r);
5041
5042  if( pos == -1 )
5043  {
5044    dReportError("Error: WRONG USE of rSetISReference: specified ordering block was not found!!!" );
5045    return false;
5046  }
5047
5048#if MYTEST
5049  if( i != r->typ[pos].data.is.limit )
5050    Print("Changing record on pos: %d\nOld limit: %d --->> New Limit: %d\n", pos, r->typ[pos].data.is.limit, i);
5051#endif
5052
5053  const ideal FF = id_Copy(F, r); // idrHeadR(F, r, r);
5054
5055
5056  if( r->typ[pos].data.is.F != NULL)
5057  {
5058#if MYTEST
5059    PrintS("Deleting old reference set F... \n");        // idShow(r->typ[pos].data.is.F, r);         PrintLn();
5060#endif
5061    id_Delete(&r->typ[pos].data.is.F, r);
5062    r->typ[pos].data.is.F = NULL;
5063  }
5064
5065  assume(r->typ[pos].data.is.F == NULL);
5066
5067  r->typ[pos].data.is.F = FF; // F is owened by ring now! TODO: delete at the end!
5068
5069  if(r->typ[pos].data.is.componentWeights != NULL)
5070  {
5071#if MYTEST
5072    PrintS("Deleting old componentWeights: "); r->typ[pos].data.is.componentWeights->show(); PrintLn();
5073#endif
5074    delete r->typ[pos].data.is.componentWeights;
5075    r->typ[pos].data.is.componentWeights = NULL;
5076  }
5077
5078
5079  assume(r->typ[pos].data.is.componentWeights == NULL);
5080
5081  if( componentWeights != NULL )
5082    componentWeights = ivCopy(componentWeights); // componentWeights is owened by ring now! TODO: delete at the end!
5083
5084  r->typ[pos].data.is.componentWeights = componentWeights;
5085
5086  r->typ[pos].data.is.limit = i; // First induced component
5087
5088#if MYTEST
5089  PrintS("New reference set FF : \n");        idShow(FF, r, r, 1);         PrintLn();
5090#endif
5091
5092  return true;
5093}
5094
5095
5096void rSetSyzComp(int k)
5097{
5098  if(k < 0)
5099  {
5100    dReportError("rSetSyzComp with negative limit!");
5101    return;
5102  }
5103
5104  assume( k >= 0 );
5105  if (TEST_OPT_PROT) Print("{%d}", k);
5106  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz))
5107  {
5108    if( k == currRing->typ[0].data.syz.limit )
5109      return; // nothing to do
5110
5111    int i;
5112    if (currRing->typ[0].data.syz.limit == 0)
5113    {
5114      currRing->typ[0].data.syz.syz_index = (int*) omAlloc0((k+1)*sizeof(int));
5115      currRing->typ[0].data.syz.syz_index[0] = 0;
5116      currRing->typ[0].data.syz.curr_index = 1;
5117    }
5118    else
5119    {
5120      currRing->typ[0].data.syz.syz_index = (int*)
5121        omReallocSize(currRing->typ[0].data.syz.syz_index,
5122                (currRing->typ[0].data.syz.limit+1)*sizeof(int),
5123                (k+1)*sizeof(int));
5124    }
5125    for (i=currRing->typ[0].data.syz.limit + 1; i<= k; i++)
5126    {
5127      currRing->typ[0].data.syz.syz_index[i] =
5128        currRing->typ[0].data.syz.curr_index;
5129    }
5130    if(k < currRing->typ[0].data.syz.limit) // ?
5131    {
5132#ifndef NDEBUG
5133      Warn("rSetSyzComp called with smaller limit (%d) as before (%d)", k, currRing->typ[0].data.syz.limit);
5134#endif
5135      currRing->typ[0].data.syz.curr_index = 1 + currRing->typ[0].data.syz.syz_index[k];
5136    }
5137
5138
5139    currRing->typ[0].data.syz.limit = k;
5140    currRing->typ[0].data.syz.curr_index++;
5141  }
5142  else if(
5143            (currRing->typ!=NULL) &&
5144            (currRing->typ[0].ord_typ==ro_isTemp)
5145           )
5146  {
5147//      (currRing->typ[currRing->typ[0].data.isTemp.suffixpos].data.is.limit == k)
5148#ifndef NDEBUG
5149    Warn("rSetSyzComp(%d) in an IS ring! Be careful!", k);
5150#endif
5151  }
5152  else
5153  if ((currRing->order[0]!=ringorder_c) && (k!=0)) // ???
5154  {
5155    dReportError("syzcomp in incompatible ring");
5156  }
5157#ifdef PDEBUG
5158  extern int pDBsyzComp;
5159  pDBsyzComp=k;
5160#endif
5161}
5162
5163// return the max-comonent wchich has syzIndex i
5164int rGetMaxSyzComp(int i)
5165{
5166  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz) &&
5167      currRing->typ[0].data.syz.limit > 0 && i > 0)
5168  {
5169    assume(i <= currRing->typ[0].data.syz.limit);
5170    int j;
5171    for (j=0; j<currRing->typ[0].data.syz.limit; j++)
5172    {
5173      if (currRing->typ[0].data.syz.syz_index[j] == i  &&
5174          currRing->typ[0].data.syz.syz_index[j+1] != i)
5175      {
5176        assume(currRing->typ[0].data.syz.syz_index[j+1] == i+1);
5177        return j;
5178      }
5179    }
5180    return currRing->typ[0].data.syz.limit;
5181  }
5182  else
5183  {
5184    return 0;
5185  }
5186}
5187
5188BOOLEAN rRing_is_Homog(ring r)
5189{
5190  if (r == NULL) return FALSE;
5191  int i, j, nb = rBlocks(r);
5192  for (i=0; i<nb; i++)
5193  {
5194    if (r->wvhdl[i] != NULL)
5195    {
5196      int length = r->block1[i] - r->block0[i];
5197      int* wvhdl = r->wvhdl[i];
5198      if (r->order[i] == ringorder_M) length *= length;
5199      assume(omSizeOfAddr(wvhdl) >= length*sizeof(int));
5200
5201      for (j=0; j< length; j++)
5202      {
5203        if (wvhdl[j] != 0 && wvhdl[j] != 1) return FALSE;
5204      }
5205    }
5206  }
5207  return TRUE;
5208}
5209
5210BOOLEAN rRing_has_CompLastBlock(ring r)
5211{
5212  assume(r != NULL);
5213  int lb = rBlocks(r) - 2;
5214  return (r->order[lb] == ringorder_c || r->order[lb] == ringorder_C);
5215}
5216
5217n_coeffType rFieldType(ring r)
5218{
5219  if (rField_is_Zp(r))     return n_Zp;
5220  if (rField_is_Q(r))      return n_Q;
5221  if (rField_is_R(r))      return n_R;
5222  if (rField_is_GF(r))     return n_GF;
5223  if (rField_is_long_R(r)) return n_long_R;
5224  if (rField_is_Zp_a(r))   return n_Zp_a;
5225  if (rField_is_Q_a(r))    return n_Q_a;
5226  if (rField_is_long_C(r)) return n_long_C;
5227  #ifdef HAVE_RINGS
5228   if (rField_is_Ring_Z(r)) return n_Z;
5229   if (rField_is_Ring_ModN(r)) return n_Zm;
5230   if (rField_is_Ring_PtoM(r)) return n_Zpn;
5231   if (rField_is_Ring_2toM(r)) return  n_Z2n;
5232  #endif
5233
5234  return n_unknown;
5235}
5236
5237int64 * rGetWeightVec(ring r)
5238{
5239  assume(r!=NULL);
5240  assume(r->OrdSize>0);
5241  int i=0;
5242  while((r->typ[i].ord_typ!=ro_wp64) && (r->typ[i].ord_typ>0)) i++;
5243  assume(r->typ[i].ord_typ==ro_wp64);
5244  return (int64*)(r->typ[i].data.wp64.weights64);
5245}
5246
5247void rSetWeightVec(ring r, int64 *wv)
5248{
5249  assume(r!=NULL);
5250  assume(r->OrdSize>0);
5251  assume(r->typ[0].ord_typ==ro_wp64);
5252  memcpy(r->typ[0].data.wp64.weights64,wv,r->N*sizeof(int64));
5253}
5254
5255#include <ctype.h>
5256
5257static int rRealloc1(ring r, ring src, int size, int pos)
5258{
5259  r->order=(int*)omReallocSize(r->order, size*sizeof(int), (size+1)*sizeof(int));
5260  r->block0=(int*)omReallocSize(r->block0, size*sizeof(int), (size+1)*sizeof(int));
5261  r->block1=(int*)omReallocSize(r->block1, size*sizeof(int), (size+1)*sizeof(int));
5262  r->wvhdl=(int_ptr*)omReallocSize(r->wvhdl,size*sizeof(int_ptr), (size+1)*sizeof(int_ptr));
5263  for(int k=size; k>pos; k--) r->wvhdl[k]=r->wvhdl[k-1];
5264  r->order[size]=0;
5265  size++;
5266  return size;
5267}
5268static int rReallocM1(ring r, ring src, int size, int pos)
5269{
5270  r->order=(int*)omReallocSize(r->order, size*sizeof(int), (size-1)*sizeof(int));
5271  r->block0=(int*)omReallocSize(r->block0, size*sizeof(int), (size-1)*sizeof(int));
5272  r->block1=(int*)omReallocSize(r->block1, size*sizeof(int), (size-1)*sizeof(int));
5273  r->wvhdl=(int_ptr*)omReallocSize(r->wvhdl,size*sizeof(int_ptr), (size-1)*sizeof(int_ptr));
5274  for(int k=pos+1; k<size; k++) r->wvhdl[k]=r->wvhdl[k+1];
5275  size--;
5276  return size;
5277}
5278static void rOppWeight(int *w, int l)
5279{
5280  int i2=(l+1)/2;
5281  for(int j=0; j<=i2; j++)
5282  {
5283    int t=w[j];
5284    w[j]=w[l-j];
5285    w[l-j]=t;
5286  }
5287}
5288
5289#define rOppVar(R,I) (rVar(R)+1-I)
5290
5291ring rOpposite(ring src)
5292  /* creates an opposite algebra of R */
5293  /* that is R^opp, where f (*^opp) g = g*f  */
5294  /* treats the case of qring */
5295{
5296  if (src == NULL) return(NULL);
5297
5298#ifdef RDEBUG
5299  rTest(src);
5300#endif
5301
5302  ring save = currRing;
5303  rChangeCurrRing(src);
5304
5305#ifdef RDEBUG
5306  rTest(src);
5307//  rWrite(src);
5308//  rDebugPrint(src);
5309#endif
5310
5311
5312//  ring r = rCopy0(src,TRUE); /* TRUE for copy the qideal: Why??? */
5313  ring r = rCopy0(src,FALSE); /* qideal will be deleted later on!!! */
5314
5315  /*  rChangeCurrRing(r); */
5316  // change vars v1..vN -> vN..v1
5317  int i;
5318  int i2 = (rVar(r)-1)/2;
5319  for(i=i2; i>=0; i--)
5320  {
5321    // index: 0..N-1
5322    //Print("ex var names: %d <-> %d\n",i,rOppVar(r,i));
5323    // exchange names
5324    char *p;
5325    p = r->names[rVar(r)-1-i];
5326    r->names[rVar(r)-1-i] = r->names[i];
5327    r->names[i] = p;
5328  }
5329//  i2=(rVar(r)+1)/2;
5330//  for(int i=i2; i>0; i--)
5331//  {
5332//    // index: 1..N
5333//    //Print("ex var places: %d <-> %d\n",i,rVar(r)+1-i);
5334//    // exchange VarOffset
5335//    int t;
5336//    t=r->VarOffset[i];
5337//    r->VarOffset[i]=r->VarOffset[rOppVar(r,i)];
5338//    r->VarOffset[rOppVar(r,i)]=t;
5339//  }
5340  // change names:
5341  for (i=rVar(r)-1; i>=0; i--)
5342  {
5343    char *p=r->names[i];
5344    if(isupper(*p)) *p = tolower(*p);
5345    else            *p = toupper(*p);
5346  }
5347  // change ordering: listing
5348  // change ordering: compare
5349//  for(i=0; i<r->OrdSize; i++)
5350//  {
5351//    int t,tt;
5352//    switch(r->typ[i].ord_typ)
5353//    {
5354//      case ro_dp:
5355//      //
5356//        t=r->typ[i].data.dp.start;
5357//        r->typ[i].data.dp.start=rOppVar(r,r->typ[i].data.dp.end);
5358//        r->typ[i].data.dp.end=rOppVar(r,t);
5359//        break;
5360//      case ro_wp:
5361//      case ro_wp_neg:
5362//      {
5363//        t=r->typ[i].data.wp.start;
5364//        r->typ[i].data.wp.start=rOppVar(r,r->typ[i].data.wp.end);
5365//        r->typ[i].data.wp.end=rOppVar(r,t);
5366//        // invert r->typ[i].data.wp.weights
5367//        rOppWeight(r->typ[i].data.wp.weights,
5368//                   r->typ[i].data.wp.end-r->typ[i].data.wp.start);
5369//        break;
5370//      }
5371//      //case ro_wp64:
5372//      case ro_syzcomp:
5373//      case ro_syz:
5374//         WerrorS("not implemented in rOpposite");
5375//         // should not happen
5376//         break;
5377//
5378//      case ro_cp:
5379//        t=r->typ[i].data.cp.start;
5380//        r->typ[i].data.cp.start=rOppVar(r,r->typ[i].data.cp.end);
5381//        r->typ[i].data.cp.end=rOppVar(r,t);
5382//        break;
5383//      case ro_none:
5384//      default:
5385//       Werror("unknown type in rOpposite(%d)",r->typ[i].ord_typ);
5386//       break;
5387//    }
5388//  }
5389  // Change order/block structures (needed for rPrint, rAdd etc.)
5390  int j=0;
5391  int l=rBlocks(src);
5392  for(i=0; src->order[i]!=0; i++)
5393  {
5394    switch (src->order[i])
5395    {
5396      case ringorder_c: /* c-> c */
5397      case ringorder_C: /* C-> C */
5398      case ringorder_no /*=0*/: /* end-of-block */
5399        r->order[j]=src->order[i];
5400        j++; break;
5401      case ringorder_lp: /* lp -> rp */
5402        r->order[j]=ringorder_rp;
5403        r->block0[j]=rOppVar(r, src->block1[i]);
5404        r->block1[j]=rOppVar(r, src->block0[i]);
5405        break;
5406      case ringorder_rp: /* rp -> lp */
5407        r->order[j]=ringorder_lp;
5408        r->block0[j]=rOppVar(r, src->block1[i]);
5409        r->block1[j]=rOppVar(r, src->block0[i]);
5410        break;
5411      case ringorder_dp: /* dp -> a(1..1),ls */
5412      {
5413        l=rRealloc1(r,src,l,j);
5414        r->order[j]=ringorder_a;
5415        r->block0[j]=rOppVar(r, src->block1[i]);
5416        r->block1[j]=rOppVar(r, src->block0[i]);
5417        r->wvhdl[j]=(int*)omAlloc((r->block1[j]-r->block0[j]+1)*sizeof(int));
5418        for(int k=r->block0[j]; k<=r->block1[j]; k++)
5419          r->wvhdl[j][k-r->block0[j]]=1;
5420        j++;
5421        r->order[j]=ringorder_ls;
5422        r->block0[j]=rOppVar(r, src->block1[i]);
5423        r->block1[j]=rOppVar(r, src->block0[i]);
5424        j++;
5425        break;
5426      }
5427      case ringorder_Dp: /* Dp -> a(1..1),rp */
5428      {
5429        l=rRealloc1(r,src,l,j);
5430        r->order[j]=ringorder_a;
5431        r->block0[j]=rOppVar(r, src->block1[i]);
5432        r->block1[j]=rOppVar(r, src->block0[i]);
5433        r->wvhdl[j]=(int*)omAlloc((r->block1[j]-r->block0[j]+1)*sizeof(int));
5434        for(int k=r->block0[j]; k<=r->block1[j]; k++)
5435          r->wvhdl[j][k-r->block0[j]]=1;
5436        j++;
5437        r->order[j]=ringorder_rp;
5438        r->block0[j]=rOppVar(r, src->block1[i]);
5439        r->block1[j]=rOppVar(r, src->block0[i]);
5440        j++;
5441        break;
5442      }
5443      case ringorder_wp: /* wp -> a(...),ls */
5444      {
5445        l=rRealloc1(r,src,l,j);
5446        r->order[j]=ringorder_a;
5447        r->block0[j]=rOppVar(r, src->block1[i]);
5448        r->block1[j]=rOppVar(r, src->block0[i]);
5449        r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=r->wvhdl[j+1]=NULL;
5450        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5451        j++;
5452        r->order[j]=ringorder_ls;
5453        r->block0[j]=rOppVar(r, src->block1[i]);
5454        r->block1[j]=rOppVar(r, src->block0[i]);
5455        j++;
5456        break;
5457      }
5458      case ringorder_Wp: /* Wp -> a(...),rp */
5459      {
5460        l=rRealloc1(r,src,l,j);
5461        r->order[j]=ringorder_a;
5462        r->block0[j]=rOppVar(r, src->block1[i]);
5463        r->block1[j]=rOppVar(r, src->block0[i]);
5464        r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=r->wvhdl[j+1]=NULL;
5465        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5466        j++;
5467        r->order[j]=ringorder_rp;
5468        r->block0[j]=rOppVar(r, src->block1[i]);
5469        r->block1[j]=rOppVar(r, src->block0[i]);
5470        j++;
5471        break;
5472      }
5473      case ringorder_M: /* M -> M */
5474      {
5475        r->order[j]=ringorder_M;
5476        r->block0[j]=rOppVar(r, src->block1[i]);
5477        r->block1[j]=rOppVar(r, src->block0[i]);
5478        int n=r->block1[j]-r->block0[j];
5479        /* M is a (n+1)x(n+1) matrix */
5480        for (int nn=0; nn<=n; nn++)
5481        {
5482          rOppWeight(&(r->wvhdl[j][nn*(n+1)]), n /*r->block1[j]-r->block0[j]*/);
5483        }
5484        j++;
5485        break;
5486      }
5487      case ringorder_a: /*  a(...),ls -> wp/dp */
5488      {
5489        r->block0[j]=rOppVar(r, src->block1[i]);
5490        r->block1[j]=rOppVar(r, src->block0[i]);
5491        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5492        if (src->order[i+1]==ringorder_ls)
5493        {
5494          r->order[j]=ringorder_wp;
5495          i++;
5496          //l=rReallocM1(r,src,l,j);
5497        }
5498        else
5499        {
5500          r->order[j]=ringorder_a;
5501        }
5502        j++;
5503        break;
5504      }
5505      // not yet done:
5506      case ringorder_ls:
5507      case ringorder_rs:
5508      case ringorder_ds:
5509      case ringorder_Ds:
5510      case ringorder_ws:
5511      case ringorder_Ws:
5512      // should not occur:
5513      case ringorder_S:
5514      case ringorder_IS:
5515      case ringorder_s:
5516      case ringorder_aa:
5517      case ringorder_L:
5518      case ringorder_unspec:
5519        Werror("order %s not (yet) supported", rSimpleOrdStr(src->order[i]));
5520        break;
5521    }
5522  }
5523  rComplete(r);
5524
5525
5526#ifdef RDEBUG
5527  rTest(r);
5528#endif
5529
5530  rChangeCurrRing(r);
5531
5532#ifdef RDEBUG
5533  rTest(r);
5534//  rWrite(r);
5535//  rDebugPrint(r);
5536#endif
5537
5538
5539#ifdef HAVE_PLURAL
5540  // now, we initialize a non-comm structure on r
5541  if (rIsPluralRing(src))
5542  {
5543    assume( currRing == r);
5544
5545    int *perm       = (int *)omAlloc0((rVar(r)+1)*sizeof(int));
5546    int *par_perm   = NULL;
5547    nMapFunc nMap   = nSetMap(src);
5548    int ni,nj;
5549    for(i=1; i<=r->N; i++)
5550    {
5551      perm[i] = rOppVar(r,i);
5552    }
5553
5554    matrix C = mpNew(rVar(r),rVar(r));
5555    matrix D = mpNew(rVar(r),rVar(r));
5556
5557    for (i=1; i< rVar(r); i++)
5558    {
5559      for (j=i+1; j<=rVar(r); j++)
5560      {
5561        ni = r->N +1 - i;
5562        nj = r->N +1 - j; /* i<j ==>   nj < ni */
5563
5564        assume(MATELEM(src->GetNC()->C,i,j) != NULL);
5565        MATELEM(C,nj,ni) = pPermPoly(MATELEM(src->GetNC()->C,i,j),perm,src,nMap,par_perm,src->P);
5566
5567        if(MATELEM(src->GetNC()->D,i,j) != NULL)
5568          MATELEM(D,nj,ni) = pPermPoly(MATELEM(src->GetNC()->D,i,j),perm,src,nMap,par_perm,src->P);
5569      }
5570    }
5571
5572    idTest((ideal)C);
5573    idTest((ideal)D);
5574
5575    if (nc_CallPlural(C, D, NULL, NULL, r, false, false, true, r)) // no qring setup!
5576      WarnS("Error initializing non-commutative multiplication!");
5577
5578#ifdef RDEBUG
5579    rTest(r);
5580//    rWrite(r);
5581//    rDebugPrint(r);
5582#endif
5583
5584    assume( r->GetNC()->IsSkewConstant == src->GetNC()->IsSkewConstant);
5585
5586    omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
5587  }
5588#endif /* HAVE_PLURAL */
5589
5590  /* now oppose the qideal for qrings */
5591  if (src->qideal != NULL)
5592  {
5593    id_Delete(&(r->qideal), r);
5594
5595#ifdef HAVE_PLURAL
5596    r->qideal = idOppose(src, src->qideal); // into the currRing: r
5597#else
5598    r->qideal = id_Copy(src->qideal, currRing); // ?
5599#endif
5600
5601#ifdef HAVE_PLURAL
5602    if( rIsPluralRing(r) )
5603    {
5604      nc_SetupQuotient(r);
5605#ifdef RDEBUG
5606      rTest(r);
5607//      rWrite(r);
5608//      rDebugPrint(r);
5609#endif
5610    }
5611#endif
5612  }
5613#ifdef HAVE_PLURAL
5614  if( rIsPluralRing(r) )
5615    assume( ncRingType(r) == ncRingType(src) );
5616#endif
5617  rTest(r);
5618
5619  rChangeCurrRing(save);
5620  return r;
5621}
5622
5623ring rEnvelope(ring R)
5624  /* creates an enveloping algebra of R */
5625  /* that is R^e = R \tensor_K R^opp */
5626{
5627  ring Ropp = rOpposite(R);
5628  ring Renv = NULL;
5629  int stat = rSum(R, Ropp, Renv); /* takes care of qideals */
5630  if ( stat <=0 )
5631    WarnS("Error in rEnvelope at rSum");
5632  rTest(Renv);
5633  return Renv;
5634}
5635
5636#ifdef HAVE_PLURAL
5637BOOLEAN nc_rComplete(const ring src, ring dest, bool bSetupQuotient)
5638/* returns TRUE is there were errors */
5639/* dest is actualy equals src with the different ordering */
5640/* we map src->nc correctly to dest->src */
5641/* to be executed after rComplete, before rChangeCurrRing */
5642{
5643// NOTE: Originally used only by idElimination to transfer NC structure to dest
5644// ring created by dirty hack (without nc_CallPlural)
5645  rTest(src);
5646
5647  assume(!rIsPluralRing(dest)); // destination must be a newly constructed commutative ring
5648
5649  if (!rIsPluralRing(src))
5650  {
5651    return FALSE;
5652  }
5653
5654  const int N = dest->N;
5655
5656  assume(src->N == N);
5657
5658  ring save = currRing;
5659
5660  if (dest != save)
5661    rChangeCurrRing(dest);
5662
5663  const ring srcBase = src;
5664
5665  assume( nSetMap(srcBase) == nSetMap(currRing) ); // currRing is important here!
5666
5667  matrix C = mpNew(N,N); // ring independent
5668  matrix D = mpNew(N,N);
5669
5670  matrix C0 = src->GetNC()->C;
5671  matrix D0 = src->GetNC()->D;
5672
5673
5674  poly p = NULL;
5675  number n = NULL;
5676
5677  // map C and D into dest
5678  for (int i = 1; i < N; i++)
5679  {
5680    for (int j = i + 1; j <= N; j++)
5681    {
5682      const number n = n_Copy(p_GetCoeff(MATELEM(C0,i,j), srcBase), srcBase); // src, mapping for coeffs into currRing = dest!
5683      const poly   p = p_NSet(n, dest);
5684      MATELEM(C,i,j) = p;
5685      if (MATELEM(D0,i,j) != NULL)
5686        MATELEM(D,i,j) = prCopyR(MATELEM(D0,i,j), srcBase, dest); // ?
5687    }
5688  }
5689  /* One must test C and D _only_ in r->GetNC()->basering!!! not in r!!! */
5690
5691  idTest((ideal)C); // in dest!
5692  idTest((ideal)D);
5693
5694  if (nc_CallPlural(C, D, NULL, NULL, dest, bSetupQuotient, false, true, dest)) // also takes care about quotient ideal
5695  {
5696    //WarnS("Error transferring non-commutative structure");
5697    // error message should be in the interpreter interface
5698
5699    mpDelete(&C, dest);
5700    mpDelete(&D, dest);
5701
5702    if (currRing != save)
5703       rChangeCurrRing(save);
5704
5705    return TRUE;
5706  }
5707
5708//  mpDelete(&C, dest); // used by nc_CallPlural!
5709//  mpDelete(&D, dest);
5710
5711  if (dest != save)
5712    rChangeCurrRing(save);
5713
5714  assume(rIsPluralRing(dest));
5715  return FALSE;
5716}
5717#endif
5718
5719void rModify_a_to_A(ring r)
5720// to be called BEFORE rComplete:
5721// changes every Block with a(...) to A(...)
5722{
5723   int i=0;
5724   int j;
5725   while(r->order[i]!=0)
5726   {
5727      if (r->order[i]==ringorder_a)
5728      {
5729        r->order[i]=ringorder_a64;
5730        int *w=r->wvhdl[i];
5731        int64 *w64=(int64 *)omAlloc((r->block1[i]-r->block0[i]+1)*sizeof(int64));
5732        for(j=r->block1[i]-r->block0[i];j>=0;j--)
5733                w64[j]=(int64)w[j];
5734        r->wvhdl[i]=(int*)w64;
5735        omFreeSize(w,(r->block1[i]-r->block0[i]+1)*sizeof(int));
5736      }
5737      i++;
5738   }
5739}
Note: See TracBrowser for help on using the repository browser.