source: git/kernel/ring.cc @ 9e8da7

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