source: git/libpolys/polys/monomials/ring.cc @ 95c1fa

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