source: git/kernel/ring.cc @ b39bc1f

spielwiese
Last change on this file since b39bc1f was b39bc1f, checked in by Viktor Levandovskyy <levandov@…>, 20 years ago
*levandov: new commands oppose, opposite and envelope are available git-svn-id: file:///usr/local/Singular/svn/trunk@7578 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 95.0 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ring.cc,v 1.25 2004-10-18 18:57:07 levandov Exp $ */
5
6/*
7* ABSTRACT - the interpreter related ring operations
8*/
9
10/* includes */
11#include <math.h>
12#include "mod2.h"
13#include "structs.h"
14#include "omalloc.h"
15#include "polys.h"
16#include "numbers.h"
17#include "febase.h"
18#include "ipconv.h"
19#include "intvec.h"
20#include "longalg.h"
21#include "ffields.h"
22#include "ideals.h"
23#include "ring.h"
24#include "prCopy.h"
25#include "../Singular/ipshell.h"
26#include "p_Procs.h"
27#ifdef HAVE_PLURAL
28#include "gring.h"
29#include "matpol.h"
30#include "maps.h"
31#endif
32
33#define BITS_PER_LONG 8*SIZEOF_LONG
34
35static const char * const ringorder_name[] =
36{
37  " ?", //ringorder_no = 0,
38  "a", //ringorder_a,
39  "c", //ringorder_c,
40  "C", //ringorder_C,
41  "M", //ringorder_M,
42  "S", //ringorder_S,
43  "s", //ringorder_s,
44  "lp", //ringorder_lp,
45  "dp", //ringorder_dp,
46  "rp", //ringorder_rp,
47  "Dp", //ringorder_Dp,
48  "wp", //ringorder_wp,
49  "Wp", //ringorder_Wp,
50  "ls", //ringorder_ls,
51  "ds", //ringorder_ds,
52  "Ds", //ringorder_Ds,
53  "ws", //ringorder_ws,
54  "Ws", //ringorder_Ws,
55  "L", //ringorder_L,
56  "aa", //ringorder_aa
57  " _" //ringorder_unspec
58};
59
60const char * rSimpleOrdStr(int ord)
61{
62  return ringorder_name[ord];
63}
64
65// unconditionally deletes fields in r
66void rDelete(ring r);
67// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
68static void rSetVarL(ring r);
69// get r->divmask depending on bits per exponent
70static unsigned long rGetDivMask(int bits);
71// right-adjust r->VarOffset
72static void rRightAdjustVarOffset(ring r);
73static void rOptimizeLDeg(ring r);
74
75/*0 implementation*/
76//BOOLEAN rField_is_R(ring r=currRing)
77//{
78//  if (r->ch== -1)
79//  {
80//    if (r->float_len==(short)0) return TRUE;
81//  }
82//  return FALSE;
83//}
84
85// internally changes the gloabl ring and resets the relevant
86// global variables:
87// complete == FALSE : only delete operations are enabled
88// complete == TRUE  : full reset of all variables
89void rChangeCurrRing(ring r)
90{
91  /*------------ set global ring vars --------------------------------*/
92  currRing = r;
93  currQuotient=NULL;
94  if (r != NULL)
95  {
96    rTest(r);
97    /*------------ set global ring vars --------------------------------*/
98    currQuotient=r->qideal;
99
100    /*------------ global variables related to coefficients ------------*/
101    nSetChar(r);
102
103    /*------------ global variables related to polys -------------------*/
104    pSetGlobals(r);
105  }
106}
107
108
109ring rDefault(int ch, int N, char **n)
110{
111  ring r=(ring) omAlloc0Bin(sip_sring_bin);
112  r->ch    = ch;
113  r->N     = N;
114  /*r->P     = 0; Alloc0 */
115  /*names*/
116  r->names = (char **) omAlloc0(N * sizeof(char_ptr));
117  int i;
118  for(i=0;i<N;i++)
119  {
120    r->names[i]  = omStrDup(n[i]);
121  }
122  /*weights: entries for 2 blocks: NULL*/
123  r->wvhdl = (int **)omAlloc0(2 * sizeof(int_ptr));
124  /*order: lp,0*/
125  r->order = (int *) omAlloc(2* sizeof(int *));
126  r->block0 = (int *)omAlloc0(2 * sizeof(int *));
127  r->block1 = (int *)omAlloc0(2 * sizeof(int *));
128  /* ringorder dp for the first block: var 1..N */
129  r->order[0]  = ringorder_lp;
130  r->block0[0] = 1;
131  r->block1[0] = N;
132  /* the last block: everything is 0 */
133  r->order[1]  = 0;
134  /*polynomial ring*/
135  r->OrdSgn    = 1;
136
137  /* complete ring intializations */
138  rComplete(r);
139  return r;
140}
141
142///////////////////////////////////////////////////////////////////////////
143//
144// rInit: define a new ring from sleftv's
145//
146
147/////////////////////////////
148// Auxillary functions
149//
150
151// check intvec, describing the ordering
152BOOLEAN rCheckIV(intvec *iv)
153{
154  if ((iv->length()!=2)&&(iv->length()!=3))
155  {
156    WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
157    return TRUE;
158  }
159  return FALSE;
160}
161
162int rTypeOfMatrixOrder(intvec * order)
163{
164  int i=0,j,typ=1;
165  int sz = (int)sqrt((double)(order->length()-2));
166
167  while ((i<sz) && (typ==1))
168  {
169    j=0;
170    while ((j<sz) && ((*order)[j*sz+i+2]==0)) j++;
171    if (j>=sz)
172    {
173      typ = 0;
174      WerrorS("Matrix order not complete");
175    }
176    else if ((*order)[j*sz+i+2]<0)
177      typ = -1;
178    else
179      i++;
180  }
181  return typ;
182}
183
184// set R->order, R->block, R->wvhdl, r->OrdSgn from sleftv
185BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R);
186
187// get array of strings from list of sleftv's
188BOOLEAN rSleftvList2StringArray(sleftv* sl, char** p);
189
190
191/*2
192 * set a new ring from the data:
193 s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
194 */
195
196int r_IsRingVar(char *n, ring r)
197{
198  if ((r!=NULL) && (r->names!=NULL))
199  {
200    for (int i=0; i<r->N; i++)
201    {
202      if (r->names[i]==NULL) return -1;
203      if (strcmp(n,r->names[i]) == 0) return (int)i;
204    }
205  }
206  return -1;
207}
208
209
210void rWrite(ring r)
211{
212  if ((r==NULL)||(r->order==NULL))
213    return; /*to avoid printing after errors....*/
214
215  int nblocks=rBlocks(r);
216
217  // omCheckAddrSize(r,sizeof(ip_sring));
218  omCheckAddrSize(r->order,nblocks*sizeof(int));
219  omCheckAddrSize(r->block0,nblocks*sizeof(int));
220  omCheckAddrSize(r->block1,nblocks*sizeof(int));
221  omCheckAddrSize(r->wvhdl,nblocks*sizeof(int_ptr));
222  omCheckAddrSize(r->names,r->N*sizeof(char_ptr));
223
224  nblocks--;
225
226
227  if (rField_is_GF(r))
228  {
229    Print("//   # ground field : %d\n",rInternalChar(r));
230    Print("//   primitive element : %s\n", r->parameter[0]);
231    if (r==currRing)
232    {
233      StringSetS("//   minpoly        : ");
234      nfShowMipo();PrintS(StringAppendS("\n"));
235    }
236  }
237  else
238  {
239    PrintS("//   characteristic : ");
240    if ( rField_is_R(r) )             PrintS("0 (real)\n");  /* R */
241    else if ( rField_is_long_R(r) )
242      Print("0 (real:%d digits, additional %d digits)\n",
243             r->float_len,r->float_len2);  /* long R */
244    else if ( rField_is_long_C(r) )
245      Print("0 (complex:%d digits, additional %d digits)\n",
246             r->float_len, r->float_len2);  /* long C */
247    else
248      Print ("%d\n",rChar(r)); /* Fp(a) */
249    if (r->parameter!=NULL)
250    {
251      Print ("//   %d parameter    : ",rPar(r));
252      char **sp=r->parameter;
253      int nop=0;
254      while (nop<rPar(r))
255      {
256        PrintS(*sp);
257        PrintS(" ");
258        sp++; nop++;
259      }
260      PrintS("\n//   minpoly        : ");
261      if ( rField_is_long_C(r) )
262      {
263        // i^2+1:
264        Print("(%s^2+1)\n",r->parameter[0]);
265      }
266      else if (r->minpoly==NULL)
267      {
268        PrintS("0\n");
269      }
270      else if (r==currRing)
271      {
272        StringSetS(""); nWrite(r->minpoly); PrintS(StringAppendS("\n"));
273      }
274      else
275      {
276        PrintS("...\n");
277      }
278    }
279  }
280  Print("//   number of vars : %d",r->N);
281
282  //for (nblocks=0; r->order[nblocks]; nblocks++);
283  nblocks=rBlocks(r)-1;
284
285  for (int l=0, nlen=0 ; l<nblocks; l++)
286  {
287    int i;
288    Print("\n//        block %3d : ",l+1);
289
290    Print("ordering %s", rSimpleOrdStr(r->order[l]));
291
292    if ((r->order[l] >= ringorder_lp)
293    ||(r->order[l] == ringorder_M)
294    ||(r->order[l] == ringorder_a)
295    ||(r->order[l] == ringorder_aa))
296    {
297      PrintS("\n//                  : names    ");
298      for (i = r->block0[l]-1; i<r->block1[l]; i++)
299      {
300        nlen = strlen(r->names[i]);
301        Print("%s ",r->names[i]);
302      }
303    }
304#ifndef NDEBUG
305    else if (r->order[l] == ringorder_s)
306    {
307      Print("  syzcomp at %d",r->typ[l].data.syz.limit);
308    }
309#endif
310
311    if (r->wvhdl[l]!=NULL)
312    {
313      for (int j= 0;
314           j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
315           j+=i)
316      {
317        PrintS("\n//                  : weights  ");
318        for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
319        {
320          Print("%*d " ,nlen,r->wvhdl[l][i+j],i+j);
321        }
322        if (r->order[l]!=ringorder_M) break;
323      }
324    }
325  }
326#ifdef HAVE_PLURAL
327  if ((r->nc!=NULL) && (r==currRing))
328  {
329    poly pl=NULL;
330    int nl;
331    PrintS("\n//   noncommutative relations:");
332    //    Print("\n//   noncommutative relations (type %d):",(int)r->nc->type);
333    for (int i = 1; i<r->N; i++)
334    {
335      for (int j = i+1; j<=r->N; j++)
336      {
337        nl=nIsOne(p_GetCoeff(MATELEM(r->nc->C,i,j),r));
338        if ((MATELEM(r->nc->D,i,j)!=NULL)||(!nl))
339        {
340          Print("\n//    %s%s=",r->names[j-1],r->names[i-1]);
341          pl=MATELEM(r->nc->MT[UPMATELEM(i,j,r->N)],1,1);
342          pWrite0(pl);
343        }
344      }
345    }
346#ifdef PDEBUG
347    Print("\n//   noncommutative type:%d",r->nc->type);
348    Print("\n//   is skew constant:%d",r->nc->IsSkewConstant);
349    Print("\n//   ref:%d",r->nc->ref);
350#endif
351  }
352#endif
353  if (r->qideal!=NULL)
354  {
355    PrintS("\n// quotient ring from ideal");
356    if (r==currRing)
357    {
358      PrintLn();
359      iiWriteMatrix((matrix)r->qideal,"_",1);
360    }
361    else PrintS(" ...");
362  }
363}
364
365void rDelete(ring r)
366{
367  int i, j;
368
369  if (r == NULL) return;
370
371#ifdef HAVE_PLURAL
372  if (r->nc != NULL)
373  {
374    if (r->nc->ref>1) /* in use by somebody else */
375    {
376      r->nc->ref--;
377    }
378    else
379    {
380      ncKill(r);
381    }
382  }
383#endif
384  nKillChar(r);
385  rUnComplete(r);
386  // delete order stuff
387  if (r->order != NULL)
388  {
389    i=rBlocks(r);
390    assume(r->block0 != NULL && r->block1 != NULL && r->wvhdl != NULL);
391    // delete order
392    omFreeSize((ADDRESS)r->order,i*sizeof(int));
393    omFreeSize((ADDRESS)r->block0,i*sizeof(int));
394    omFreeSize((ADDRESS)r->block1,i*sizeof(int));
395    // delete weights
396    for (j=0; j<i; j++)
397    {
398      if (r->wvhdl[j]!=NULL)
399        omFree(r->wvhdl[j]);
400    }
401    omFreeSize((ADDRESS)r->wvhdl,i*sizeof(int *));
402  }
403  else
404  {
405    assume(r->block0 == NULL && r->block1 == NULL && r->wvhdl == NULL);
406  }
407
408  // delete varnames
409  if(r->names!=NULL)
410  {
411    for (i=0; i<r->N; i++)
412    {
413      if (r->names[i] != NULL) omFree((ADDRESS)r->names[i]);
414    }
415    omFreeSize((ADDRESS)r->names,r->N*sizeof(char_ptr));
416  }
417
418  // delete parameter
419  if (r->parameter!=NULL)
420  {
421    char **s=r->parameter;
422    j = 0;
423    while (j < rPar(r))
424    {
425      if (*s != NULL) omFree((ADDRESS)*s);
426      s++;
427      j++;
428    }
429    omFreeSize((ADDRESS)r->parameter,rPar(r)*sizeof(char_ptr));
430  }
431  omFreeBin(r, ip_sring_bin);
432}
433
434int rOrderName(char * ordername)
435{
436  int order=ringorder_unspec;
437  while (order!= 0)
438  {
439    if (strcmp(ordername,rSimpleOrdStr(order))==0)
440      break;
441    order--;
442  }
443  if (order==0) Werror("wrong ring order `%s`",ordername);
444  omFree((ADDRESS)ordername);
445  return order;
446}
447
448char * rOrdStr(ring r)
449{
450  int nblocks,l,i;
451
452  for (nblocks=0; r->order[nblocks]; nblocks++);
453  nblocks--;
454
455  StringSetS("");
456  for (l=0; ; l++)
457  {
458    StringAppend((char *)rSimpleOrdStr(r->order[l]));
459    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
460    {
461      if (r->wvhdl[l]!=NULL)
462      {
463        StringAppendS("(");
464        for (int j= 0;
465             j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
466             j+=i+1)
467        {
468          char c=',';
469          for (i = 0; i<r->block1[l]-r->block0[l]; i++)
470          {
471            StringAppend("%d," ,r->wvhdl[l][i+j]);
472          }
473          if (r->order[l]!=ringorder_M)
474          {
475            StringAppend("%d)" ,r->wvhdl[l][i+j]);
476            break;
477          }
478          if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
479            c=')';
480          StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
481        }
482      }
483      else
484        StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
485    }
486    if (l==nblocks) return omStrDup(StringAppendS(""));
487    StringAppendS(",");
488  }
489}
490
491char * rVarStr(ring r)
492{
493  int i;
494  int l=2;
495  char *s;
496
497  for (i=0; i<r->N; i++)
498  {
499    l+=strlen(r->names[i])+1;
500  }
501  s=(char *)omAlloc(l);
502  s[0]='\0';
503  for (i=0; i<r->N-1; i++)
504  {
505    strcat(s,r->names[i]);
506    strcat(s,",");
507  }
508  strcat(s,r->names[i]);
509  return s;
510}
511
512char * rCharStr(ring r)
513{
514  char *s;
515  int i;
516
517  if (r->parameter==NULL)
518  {
519    i=r->ch;
520    if(i==-1)
521      s=omStrDup("real");                    /* R */
522    else
523    {
524      s=(char *)omAlloc(6);
525      sprintf(s,"%d",i);                   /* Q, Z/p */
526    }
527    return s;
528  }
529  if (rField_is_long_C(r))
530  {
531    s=(char *)omAlloc(21+strlen(r->parameter[0]));
532    sprintf(s,"complex,%d,%s",r->float_len,r->parameter[0]);   /* C */
533    return s;
534  }
535  int l=0;
536  for(i=0; i<rPar(r);i++)
537  {
538    l+=(strlen(r->parameter[i])+1);
539  }
540  s=(char *)omAlloc(l+6);
541  s[0]='\0';
542  if (r->ch<0)       sprintf(s,"%d",-r->ch); /* Fp(a) */
543  else if (r->ch==1) sprintf(s,"0");         /* Q(a)  */
544  else
545  {
546    sprintf(s,"%d,%s",r->ch,r->parameter[0]); /* Fq  */
547    return s;
548  }
549  char tt[2];
550  tt[0]=',';
551  tt[1]='\0';
552  for(i=0; i<rPar(r);i++)
553  {
554    strcat(s,tt);
555    strcat(s,r->parameter[i]);
556  }
557  return s;
558}
559
560char * rParStr(ring r)
561{
562  if (r->parameter==NULL) return omStrDup("");
563
564  int i;
565  int l=2;
566
567  for (i=0; i<rPar(r); i++)
568  {
569    l+=strlen(r->parameter[i])+1;
570  }
571  char *s=(char *)omAlloc(l);
572  s[0]='\0';
573  for (i=0; i<rPar(r)-1; i++)
574  {
575    strcat(s,r->parameter[i]);
576    strcat(s,",");
577  }
578  strcat(s,r->parameter[i]);
579  return s;
580}
581
582char * rString(ring r)
583{
584  char *ch=rCharStr(r);
585  char *var=rVarStr(r);
586  char *ord=rOrdStr(r);
587  char *res=(char *)omAlloc(strlen(ch)+strlen(var)+strlen(ord)+9);
588  sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
589  omFree((ADDRESS)ch);
590  omFree((ADDRESS)var);
591  omFree((ADDRESS)ord);
592  return res;
593}
594
595int  rIsExtension(ring r)
596{
597  return (r->parameter!=NULL); /* R, Q, Fp: FALSE */
598}
599
600int  rIsExtension()
601{
602  return rIsExtension( currRing );
603}
604
605int rChar(ring r)
606{
607  if (rField_is_numeric(r))
608    return 0;
609  if (!rIsExtension(r)) /* Q, Fp */
610    return r->ch;
611  if (rField_is_Zp_a(r))  /* Fp(a)  */
612    return -r->ch;
613  if (rField_is_Q_a(r))   /* Q(a)  */
614    return 0;
615  /*else*/               /* GF(p,n) */
616  {
617    if ((r->ch & 1)==0) return 2;
618    int i=3;
619    while ((r->ch % i)!=0) i+=2;
620    return i;
621  }
622}
623
624/*2
625 *returns -1 for not compatible, (sum is undefined)
626 *         0 for equal, (and sum)
627 *         1 for compatible (and sum)
628 */
629int rSum(ring r1, ring r2, ring &sum)
630{
631  if (r1==r2)
632  {
633    sum=r1;
634    r1->ref++;
635    return 0;
636  }
637  ring save=currRing;
638  ip_sring tmpR;
639  memset(&tmpR,0,sizeof(tmpR));
640  /* check coeff. field =====================================================*/
641  if (rInternalChar(r1)==rInternalChar(r2))
642  {
643    tmpR.ch=rInternalChar(r1);
644    if (rField_is_Q(r1)||rField_is_Zp(r1)||rField_is_GF(r1)) /*Q, Z/p, GF(p,n)*/
645    {
646      if (r1->parameter!=NULL)
647      {
648        if (strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
649        {
650          tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
651          tmpR.parameter[0]=omStrDup(r1->parameter[0]);
652          tmpR.P=1;
653        }
654        else
655        {
656          WerrorS("GF(p,n)+GF(p,n)");
657          return -1;
658        }
659      }
660    }
661    else if ((r1->ch==1)||(r1->ch<-1)) /* Q(a),Z/p(a) */
662    {
663      if (r1->minpoly!=NULL)
664      {
665        if (r2->minpoly!=NULL)
666        {
667          // HANNES: TODO: delete nSetChar
668          rChangeCurrRing(r1);
669          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
670              && n_Equal(r1->minpoly,r2->minpoly, r1))
671          {
672            tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
673            tmpR.parameter[0]=omStrDup(r1->parameter[0]);
674            tmpR.minpoly=n_Copy(r1->minpoly, r1);
675            tmpR.P=1;
676            // HANNES: TODO: delete nSetChar
677            rChangeCurrRing(save);
678          }
679          else
680          {
681            // HANNES: TODO: delete nSetChar
682            rChangeCurrRing(save);
683            WerrorS("different minpolys");
684            return -1;
685          }
686        }
687        else
688        {
689          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
690              && (rPar(r2)==1))
691          {
692            tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
693            tmpR.parameter[0]=omStrDup(r1->parameter[0]);
694            tmpR.P=1;
695            tmpR.minpoly=n_Copy(r1->minpoly, r1);
696          }
697          else
698          {
699            WerrorS("different parameters and minpoly!=0");
700            return -1;
701          }
702        }
703      }
704      else /* r1->minpoly==NULL */
705      {
706        if (r2->minpoly!=NULL)
707        {
708          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
709              && (rPar(r1)==1))
710          {
711            tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
712            tmpR.parameter[0]=omStrDup(r1->parameter[0]);
713            tmpR.P=1;
714            tmpR.minpoly=n_Copy(r2->minpoly, r2);
715          }
716          else
717          {
718            WerrorS("different parameters and minpoly!=0");
719            return -1;
720          }
721        }
722        else
723        {
724          int len=rPar(r1)+rPar(r2);
725          tmpR.parameter=(char **)omAlloc0(len*sizeof(char_ptr));
726          int i;
727          for (i=0;i<rPar(r1);i++)
728          {
729            tmpR.parameter[i]=omStrDup(r1->parameter[i]);
730          }
731          int j,l;
732          for(j=0;j<rPar(r2);j++)
733          {
734            for(l=0;l<i;l++)
735            {
736              if(strcmp(tmpR.parameter[l],r2->parameter[j])==0)
737                break;
738            }
739            if (l==i)
740            {
741              tmpR.parameter[i]=omStrDup(r2->parameter[j]);
742              i++;
743            }
744          }
745          if (i!=len)
746          {
747            tmpR.parameter=(char**)omReallocSize(tmpR.parameter,len*sizeof(char_ptr),i*sizeof(char_ptr));
748          }
749          tmpR.P=i;
750        }
751      }
752    }
753  }
754  else /* r1->ch!=r2->ch */
755  {
756    if (r1->ch<-1) /* Z/p(a) */
757    {
758      if ((r2->ch==0) /* Q */
759          || (r2->ch==-r1->ch)) /* Z/p */
760      {
761        tmpR.ch=rInternalChar(r1);
762        tmpR.P=rPar(r1);
763        tmpR.parameter=(char **)omAlloc(rPar(r1)*sizeof(char_ptr));
764        int i;
765        for (i=0;i<rPar(r1);i++)
766        {
767          tmpR.parameter[i]=omStrDup(r1->parameter[i]);
768        }
769        if (r1->minpoly!=NULL)
770        {
771          tmpR.minpoly=n_Copy(r1->minpoly, r1);
772        }
773      }
774      else  /* R, Q(a),Z/q,Z/p(a),GF(p,n) */
775      {
776        WerrorS("Z/p(a)+(R,Q(a),Z/q(a),GF(q,n))");
777        return -1;
778      }
779    }
780    else if (r1->ch==-1) /* R */
781    {
782      WerrorS("R+..");
783      return -1;
784    }
785    else if (r1->ch==0) /* Q */
786    {
787      if ((r2->ch<-1)||(r2->ch==1)) /* Z/p(a),Q(a) */
788      {
789        tmpR.ch=rInternalChar(r2);
790        tmpR.P=rPar(r2);
791        tmpR.parameter=(char **)omAlloc(rPar(r2)*sizeof(char_ptr));
792        int i;
793        for (i=0;i<rPar(r2);i++)
794        {
795          tmpR.parameter[i]=omStrDup(r2->parameter[i]);
796        }
797        if (r2->minpoly!=NULL)
798        {
799          tmpR.minpoly=n_Copy(r2->minpoly, r2);
800        }
801      }
802      else if (r2->ch>1) /* Z/p,GF(p,n) */
803      {
804        tmpR.ch=r2->ch;
805        if (r2->parameter!=NULL)
806        {
807          tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
808          tmpR.P=1;
809          tmpR.parameter[0]=omStrDup(r2->parameter[0]);
810        }
811      }
812      else
813      {
814        WerrorS("Q+R");
815        return -1; /* R */
816      }
817    }
818    else if (r1->ch==1) /* Q(a) */
819    {
820      if (r2->ch==0) /* Q */
821      {
822        tmpR.ch=rInternalChar(r1);
823        tmpR.P=rPar(r1);
824        tmpR.parameter=(char **)omAlloc(rPar(r1)*sizeof(char_ptr));
825        int i;
826        for(i=0;i<rPar(r1);i++)
827        {
828          tmpR.parameter[i]=omStrDup(r1->parameter[i]);
829        }
830        if (r1->minpoly!=NULL)
831        {
832          tmpR.minpoly=n_Copy(r1->minpoly, r1);
833        }
834      }
835      else  /* R, Z/p,GF(p,n) */
836      {
837        WerrorS("Q(a)+(R,Z/p,GF(p,n))");
838        return -1;
839      }
840    }
841    else /* r1->ch >=2 , Z/p */
842    {
843      if (r2->ch==0) /* Q */
844      {
845        tmpR.ch=r1->ch;
846      }
847      else if (r2->ch==-r1->ch) /* Z/p(a) */
848      {
849        tmpR.ch=rInternalChar(r2);
850        tmpR.P=rPar(r2);
851        tmpR.parameter=(char **)omAlloc(rPar(r2)*sizeof(char_ptr));
852        int i;
853        for(i=0;i<rPar(r2);i++)
854        {
855          tmpR.parameter[i]=omStrDup(r2->parameter[i]);
856        }
857        if (r2->minpoly!=NULL)
858        {
859          tmpR.minpoly=n_Copy(r2->minpoly, r2);
860        }
861      }
862      else
863      {
864        WerrorS("Z/p+(GF(q,n),Z/q(a),R,Q(a))");
865        return -1; /* GF(p,n),Z/q(a),R,Q(a) */
866      }
867    }
868  }
869  /* variable names ========================================================*/
870  int i,j,k;
871  int l=r1->N+r2->N;
872  char **names=(char **)omAlloc0(l*sizeof(char_ptr));
873  k=0;
874
875  // collect all varnames from r1, except those which are parameters
876  // of r2, or those which are the empty string
877  for (i=0;i<r1->N;i++)
878  {
879    BOOLEAN b=TRUE;
880
881    if (*(r1->names[i]) == '\0')
882      b = FALSE;
883    else if ((r2->parameter!=NULL) && (strlen(r1->names[i])==1))
884    {
885      for(j=0;j<rPar(r2);j++)
886      {
887        if (strcmp(r1->names[i],r2->parameter[j])==0)
888        {
889          b=FALSE;
890          break;
891        }
892      }
893    }
894
895    if (b)
896    {
897      //Print("name : %d: %s\n",k,r1->names[i]);
898      names[k]=omStrDup(r1->names[i]);
899      k++;
900    }
901    //else
902    //  Print("no name (par1) %s\n",r1->names[i]);
903  }
904  // Add variables from r2, except those which are parameters of r1
905  // those which are empty strings, and those which equal a var of r1
906  for(i=0;i<r2->N;i++)
907  {
908    BOOLEAN b=TRUE;
909
910    if (*(r2->names[i]) == '\0')
911      b = FALSE;
912    else if ((r1->parameter!=NULL) && (strlen(r2->names[i])==1))
913    {
914      for(j=0;j<rPar(r1);j++)
915      {
916        if (strcmp(r2->names[i],r1->parameter[j])==0)
917        {
918          b=FALSE;
919          break;
920        }
921      }
922    }
923
924    if (b)
925    {
926      for(j=0;j<r1->N;j++)
927      {
928        if (strcmp(r1->names[j],r2->names[i])==0)
929        {
930          b=FALSE;
931          break;
932        }
933      }
934      if (b)
935      {
936        //Print("name : %d : %s\n",k,r2->names[i]);
937        names[k]=omStrDup(r2->names[i]);
938        k++;
939      }
940      //else
941      //  Print("no name (var): %s\n",r2->names[i]);
942    }
943    //else
944    //  Print("no name (par): %s\n",r2->names[i]);
945  }
946  // check whether we found any vars at all
947  if (k == 0)
948  {
949    names[k]=omStrDup("");
950    k=1;
951  }
952  tmpR.N=k;
953  tmpR.names=names;
954  /* ordering *======================================================== */
955  tmpR.OrdSgn=1;
956  if ((r1->order[0]==ringorder_unspec)
957      && (r2->order[0]==ringorder_unspec))
958  {
959    tmpR.order=(int*)omAlloc(3*sizeof(int));
960    tmpR.block0=(int*)omAlloc(3*sizeof(int));
961    tmpR.block1=(int*)omAlloc(3*sizeof(int));
962    tmpR.wvhdl=(int**)omAlloc0(3*sizeof(int_ptr));
963    tmpR.order[0]=ringorder_unspec;
964    tmpR.order[1]=ringorder_C;
965    tmpR.order[2]=0;
966    tmpR.block0[0]=1;
967    tmpR.block1[0]=tmpR.N;
968  }
969  else if (l==k) /* r3=r1+r2 */
970  {
971    int b;
972    ring rb;
973    if (r1->order[0]==ringorder_unspec)
974    {
975      /* extend order of r2 to r3 */
976      b=rBlocks(r2);
977      rb=r2;
978      tmpR.OrdSgn=r2->OrdSgn;
979    }
980    else if (r2->order[0]==ringorder_unspec)
981    {
982      /* extend order of r1 to r3 */
983      b=rBlocks(r1);
984      rb=r1;
985      tmpR.OrdSgn=r1->OrdSgn;
986    }
987    else
988    {
989      b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
990      rb=NULL;
991    }
992    tmpR.order=(int*)omAlloc0(b*sizeof(int));
993    tmpR.block0=(int*)omAlloc0(b*sizeof(int));
994    tmpR.block1=(int*)omAlloc0(b*sizeof(int));
995    tmpR.wvhdl=(int**)omAlloc0(b*sizeof(int_ptr));
996    /* weights not implemented yet ...*/
997    if (rb!=NULL)
998    {
999      for (i=0;i<b;i++)
1000      {
1001        tmpR.order[i]=rb->order[i];
1002        tmpR.block0[i]=rb->block0[i];
1003        tmpR.block1[i]=rb->block1[i];
1004        if (rb->wvhdl[i]!=NULL)
1005          WarnS("rSum: weights not implemented");
1006      }
1007      tmpR.block0[0]=1;
1008    }
1009    else /* ring sum for complete rings */
1010    {
1011      for (i=0;r1->order[i]!=0;i++)
1012      {
1013        tmpR.order[i]=r1->order[i];
1014        tmpR.block0[i]=r1->block0[i];
1015        tmpR.block1[i]=r1->block1[i];
1016        if (r1->wvhdl[i]!=NULL)
1017          tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1018      }
1019      j=i;
1020      i--;
1021      if ((r1->order[i]==ringorder_c)
1022          ||(r1->order[i]==ringorder_C))
1023      {
1024        j--;
1025        tmpR.order[b-2]=r1->order[i];
1026      }
1027      for (i=0;r2->order[i]!=0;i++)
1028      {
1029        if ((r2->order[i]!=ringorder_c)
1030            &&(r2->order[i]!=ringorder_C))
1031        {
1032          tmpR.order[j]=r2->order[i];
1033          tmpR.block0[j]=r2->block0[i]+r1->N;
1034          tmpR.block1[j]=r2->block1[i]+r1->N;
1035          if (r2->wvhdl[i]!=NULL)
1036          {
1037            tmpR.wvhdl[j] = (int*) omMemDup(r2->wvhdl[i]);
1038          }
1039          j++;
1040        }
1041      }
1042      if((r1->OrdSgn==-1)||(r2->OrdSgn==-1))
1043        tmpR.OrdSgn=-1;
1044    }
1045  }
1046  else if ((k==r1->N) && (k==r2->N)) /* r1 and r2 are "quite" the same ring */
1047    /* copy r1, because we have the variables from r1 */
1048  {
1049    int b=rBlocks(r1);
1050
1051    tmpR.order=(int*)omAlloc0(b*sizeof(int));
1052    tmpR.block0=(int*)omAlloc0(b*sizeof(int));
1053    tmpR.block1=(int*)omAlloc0(b*sizeof(int));
1054    tmpR.wvhdl=(int**)omAlloc0(b*sizeof(int_ptr));
1055    /* weights not implemented yet ...*/
1056    for (i=0;i<b;i++)
1057    {
1058      tmpR.order[i]=r1->order[i];
1059      tmpR.block0[i]=r1->block0[i];
1060      tmpR.block1[i]=r1->block1[i];
1061      if (r1->wvhdl[i]!=NULL)
1062      {
1063        tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1064      }
1065    }
1066    tmpR.OrdSgn=r1->OrdSgn;
1067  }
1068  else
1069  {
1070    for(i=0;i<k;i++) omFree((ADDRESS)tmpR.names[i]);
1071    omFreeSize((ADDRESS)names,tmpR.N*sizeof(char_ptr));
1072    Werror("difficulties with variables: %d,%d -> %d",rVar(r1),rVar(r2),k);
1073    return -1;
1074  }
1075  sum=(ring)omAllocBin(ip_sring_bin);
1076  memcpy(sum,&tmpR,sizeof(ip_sring));
1077  rComplete(sum);
1078//#ifdef RDEBUG
1079//  rDebugPrint(sum);
1080//#endif
1081#ifdef HAVE_PLURAL
1082  BOOLEAN R1_is_nc = rIsPluralRing(r1);
1083  BOOLEAN R2_is_nc = rIsPluralRing(r2);
1084  if ( (R1_is_nc) || (R2_is_nc))
1085  {
1086    ring R1 = rCopy(r1);
1087    ring R2 = rCopy(r2);
1088    /* basic nc constructions  */
1089    sum->nc = (nc_struct *)omAlloc0(sizeof(nc_struct));
1090    sum->nc->ref = 1;
1091    sum->nc->basering = sum;
1092    if ( !R1_is_nc ) nc_rCreateNCcomm(R1);
1093    if ( !R2_is_nc ) nc_rCreateNCcomm(R2);
1094    /* nc types */
1095    sum->nc->type = nc_undef;
1096    nc_type t1 = R1->nc->type, t2 = R2->nc->type;
1097    if ( t1==t2) sum->nc->type = t1;
1098    else
1099    {
1100      if ( (t1==nc_general) || (t2==nc_general) ) sum->nc->type = nc_general;
1101    }
1102    if (sum->nc->type == nc_undef) /* not yet done */
1103    {
1104      switch (t1) 
1105      {
1106        case nc_comm:
1107          sum->nc->type = t2;
1108          break;
1109        case nc_lie:
1110          switch(t2)
1111          {
1112            case nc_skew:
1113              sum->nc->type = nc_general;  break;
1114            case nc_comm:
1115              sum->nc->type = nc_lie;  break;
1116            default:
1117              /*sum->nc->type = nc_undef;*/  break;
1118          }
1119          break;
1120        case nc_skew:
1121          switch(t2)
1122          {
1123            case nc_lie:
1124              sum->nc->type = nc_lie;  break;
1125            case nc_comm:
1126              sum->nc->type = nc_skew;  break;
1127            default:
1128              /*sum->nc->type = nc_undef;*/  break;
1129          }
1130        default:
1131          /*sum->nc->type = nc_undef;*/
1132          break;
1133      }
1134    }
1135    if (sum->nc->type == nc_undef)
1136      WarnS("Error on recognizing nc types");
1137    /* multiplication matrices */
1138    ring old_ring = currRing;
1139    rChangeCurrRing(sum);
1140/* find permutations of vars and pars */
1141    int *perm1 = (int *)omAlloc0((rVar(R1)+1)*sizeof(int));
1142    int *par_perm1 = NULL;
1143    if (rPar(R1)!=0) par_perm1=(int *)omAlloc0((rPar(R1)+1)*sizeof(int));
1144    int *perm2 = (int *)omAlloc0((rVar(R2)+1)*sizeof(int));
1145    int *par_perm2 = NULL;
1146    if (rPar(R2)!=0) par_perm2=(int *)omAlloc0((rPar(R2)+1)*sizeof(int));
1147    //    maFindPerm(char **preim_names, int preim_n, char **preim_par, int preim_p,
1148    //                char **names,       int n,       char **par,       int nop,
1149    //                int * perm, int *par_perm, int ch);
1150    maFindPerm(R1->names,  rVar(R1),  R1->parameter,  rPar(R1),
1151               sum->names, rVar(sum), sum->parameter, rPar(sum),
1152               perm1, par_perm1, sum->ch);
1153    maFindPerm(R2->names,  rVar(R2),  R2->parameter,  rPar(R2),
1154               sum->names, rVar(sum), sum->parameter, rPar(sum),
1155               perm2, par_perm2, sum->ch);
1156    nMapFunc nMap1 = nSetMap(R1);
1157    nMapFunc nMap2 = nSetMap(R2);
1158    matrix C1 = R1->nc->C, C2 = R2->nc->C;
1159    matrix D1 = R1->nc->D, D2 = R2->nc->D;
1160    int l = rVar(R1) + rVar(R2);
1161    matrix C  = mpNew(l,l);
1162    matrix D  = mpNew(l,l);
1163    int param_shift = 0;
1164    for (i=1; i<= rVar(R1) + rVar(R2); i++)
1165    {
1166      for (j= i+1; j<= rVar(R1) + rVar(R2); j++)
1167      {
1168        MATELEM(C,i,j) = pOne();
1169      }
1170    }
1171    for (i=1; i< rVar(R1); i++)
1172    {
1173      for (j=i+1; j<=rVar(R1); j++)
1174      {
1175        MATELEM(C,i,j) = pPermPoly(MATELEM(C1,i,j),perm1,R1,nMap1,par_perm1,rPar(R1));
1176        MATELEM(D,i,j) = pPermPoly(MATELEM(D1,i,j),perm1,R1,nMap1,par_perm1,rPar(R1));
1177        //      MATELEM(C,i,j) = p_CopyEmbed(MATELEM(C1,i,j),R1,0,param_shift);
1178          //prCopyR_NoSort(MATELEM(C1,i,j),R1,sum);
1179        //      MATELEM(D,i,j) = prCopyR(MATELEM(D1,i,j),R1,sum);
1180        //      MATELEM(D,i,j) = p_CopyEmbed(MATELEM(D1,i,j),R1,0,param_shift);
1181
1182      }
1183    }
1184    for (i=1; i< rVar(R2); i++)
1185    {
1186      for (j=i+1; j<=rVar(R2); j++)
1187      {
1188        //      MATELEM(C,rVar(R1)+i,rVar(R1)+j) = prCopyR_NoSort(MATELEM(C2,i,j),R2,sum);
1189        //      MATELEM(D,rVar(R1)+i,rVar(R1)+j) = prCopyR(MATELEM(D2,i,j),R2,sum);
1190        //      MATELEM(C,rVar(R1)+i,rVar(R1)+j) = p_CopyEmbed(MATELEM(C2,i,j),R2, rVar(R1),param_shift);
1191        //      MATELEM(D,rVar(R1)+i,rVar(R1)+j) = p_CopyEmbed(MATELEM(D2,i,j),R2, rVar(R1),param_shift);
1192
1193        MATELEM(C,rVar(R1)+i,rVar(R1)+j) = pPermPoly(MATELEM(C2,i,j),perm2,R2,nMap2,par_perm2,rPar(R2));
1194        MATELEM(D,rVar(R1)+i,rVar(R1)+j) = pPermPoly(MATELEM(D2,i,j),perm2,R2,nMap2,par_perm2,rPar(R2));
1195      }
1196    }
1197    sum->nc->C = C;
1198    sum->nc->D = D;
1199    idTest((ideal)C);
1200    idTest((ideal)D);
1201    if (nc_InitMultiplication(sum))
1202      WarnS("Error initializing multiplication!");
1203    sum->nc->IsSkewConstant =(int)((R1->nc->IsSkewConstant) && (R2->nc->IsSkewConstant));
1204    /* delete R1, R2*/
1205    rDelete(R1);
1206    rDelete(R2);
1207    if ( old_ring != NULL)
1208      rChangeCurrRing(old_ring);
1209  }
1210#endif
1211  return 1;
1212}
1213/*2
1214 * create a copy of the ring r, which must be equivalent to currRing
1215 * used for qring definition,..
1216 * (i.e.: normal rings: same nCopy as currRing;
1217 *        qring:        same nCopy, same idCopy as currRing)
1218 * DOES NOT CALL rComplete
1219 */
1220static ring rCopy0(ring r, BOOLEAN copy_qideal = TRUE,
1221                   BOOLEAN copy_ordering = TRUE)
1222{
1223  if (r == NULL) return NULL;
1224  int i,j;
1225  ring res=(ring)omAllocBin(ip_sring_bin);
1226
1227  memcpy4(res,r,sizeof(ip_sring));
1228  res->VarOffset = NULL;
1229  res->ref=0;
1230  if (r->algring!=NULL)
1231    r->algring->ref++;
1232  if (r->parameter!=NULL)
1233  {
1234    res->minpoly=nCopy(r->minpoly);
1235    int l=rPar(r);
1236    res->parameter=(char **)omAlloc(l*sizeof(char_ptr));
1237    int i;
1238    for(i=0;i<rPar(r);i++)
1239    {
1240      res->parameter[i]=omStrDup(r->parameter[i]);
1241    }
1242  }
1243  if (copy_ordering == TRUE)
1244  {
1245    i=rBlocks(r);
1246    res->wvhdl   = (int **)omAlloc(i * sizeof(int_ptr));
1247    res->order   = (int *) omAlloc(i * sizeof(int));
1248    res->block0  = (int *) omAlloc(i * sizeof(int));
1249    res->block1  = (int *) omAlloc(i * sizeof(int));
1250    for (j=0; j<i; j++)
1251    {
1252      if (r->wvhdl[j]!=NULL)
1253      {
1254        res->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
1255      }
1256      else
1257        res->wvhdl[j]=NULL;
1258    }
1259    memcpy4(res->order,r->order,i * sizeof(int));
1260    memcpy4(res->block0,r->block0,i * sizeof(int));
1261    memcpy4(res->block1,r->block1,i * sizeof(int));
1262  }
1263  else
1264  {
1265    res->wvhdl = NULL;
1266    res->order = NULL;
1267    res->block0 = NULL;
1268    res->block1 = NULL;
1269  }
1270
1271  res->names   = (char **)omAlloc0(rVar(r) * sizeof(char_ptr));
1272  for (i=0; i<res->N; i++)
1273  {
1274    res->names[i] = omStrDup(r->names[i]);
1275  }
1276  res->idroot = NULL;
1277  if (r->qideal!=NULL)
1278  {
1279    if (copy_qideal) res->qideal= idrCopyR_NoSort(r->qideal, r);
1280    else res->qideal = NULL;
1281  }
1282#ifdef HAVE_PLURAL
1283  if (rIsPluralRing(r))
1284  {
1285    res->nc=r->nc;
1286    res->nc->ref++;
1287  }
1288#endif
1289  return res;
1290}
1291
1292/*2
1293 * create a copy of the ring r, which must be equivalent to currRing
1294 * used for qring definition,..
1295 * (i.e.: normal rings: same nCopy as currRing;
1296 *        qring:        same nCopy, same idCopy as currRing)
1297 */
1298ring rCopy(ring r)
1299{
1300  if (r == NULL) return NULL;
1301  ring res=rCopy0(r);
1302  rComplete(res, 1);
1303  return res;
1304}
1305
1306// returns TRUE, if r1 equals r2 FALSE, otherwise Equality is
1307// determined componentwise, if qr == 1, then qrideal equality is
1308// tested, as well
1309BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
1310{
1311  int i, j;
1312
1313  if (r1 == r2) return 1;
1314
1315  if (r1 == NULL || r2 == NULL) return 0;
1316
1317  if ((rInternalChar(r1) != rInternalChar(r2))
1318  || (r1->float_len != r2->float_len)
1319  || (r1->float_len2 != r2->float_len2)
1320  || (rVar(r1) != rVar(r2))
1321  || (r1->OrdSgn != r2->OrdSgn)
1322  || (rPar(r1) != rPar(r2)))
1323    return 0;
1324
1325  for (i=0; i<rVar(r1); i++)
1326  {
1327    if (r1->names[i] != NULL && r2->names[i] != NULL)
1328    {
1329      if (strcmp(r1->names[i], r2->names[i])) return 0;
1330    }
1331    else if ((r1->names[i] != NULL) ^ (r2->names[i] != NULL))
1332    {
1333      return 0;
1334    }
1335  }
1336
1337  i=0;
1338  while (r1->order[i] != 0)
1339  {
1340    if (r2->order[i] == 0) return 0;
1341    if ((r1->order[i] != r2->order[i]) ||
1342        (r1->block0[i] != r2->block0[i]) || (r2->block0[i] != r1->block0[i]))
1343      return 0;
1344    if (r1->wvhdl[i] != NULL)
1345    {
1346      if (r2->wvhdl[i] == NULL)
1347        return 0;
1348      for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1349        if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1350          return 0;
1351    }
1352    else if (r2->wvhdl[i] != NULL) return 0;
1353    i++;
1354  }
1355
1356  for (i=0; i<rPar(r1);i++)
1357  {
1358      if (strcmp(r1->parameter[i], r2->parameter[i])!=0)
1359        return 0;
1360  }
1361
1362  if (r1->minpoly != NULL)
1363  {
1364    if (r2->minpoly == NULL) return 0;
1365    if (currRing == r1 || currRing == r2)
1366    {
1367      if (! nEqual(r1->minpoly, r2->minpoly)) return 0;
1368    }
1369  }
1370  else if (r2->minpoly != NULL) return 0;
1371
1372  if (qr)
1373  {
1374    if (r1->qideal != NULL)
1375    {
1376      ideal id1 = r1->qideal, id2 = r2->qideal;
1377      int i, n;
1378      poly *m1, *m2;
1379
1380      if (id2 == NULL) return 0;
1381      if ((n = IDELEMS(id1)) != IDELEMS(id2)) return 0;
1382
1383      if (currRing == r1 || currRing == r2)
1384      {
1385        m1 = id1->m;
1386        m2 = id2->m;
1387        for (i=0; i<n; i++)
1388          if (! pEqualPolys(m1[i],m2[i])) return 0;
1389      }
1390    }
1391    else if (r2->qideal != NULL) return 0;
1392  }
1393
1394  return 1;
1395}
1396
1397rOrderType_t rGetOrderType(ring r)
1398{
1399  // check for simple ordering
1400  if (rHasSimpleOrder(r))
1401  {
1402    if ((r->order[1] == ringorder_c) || (r->order[1] == ringorder_C))
1403    {
1404      switch(r->order[0])
1405      {
1406          case ringorder_dp:
1407          case ringorder_wp:
1408          case ringorder_ds:
1409          case ringorder_ws:
1410          case ringorder_ls:
1411          case ringorder_unspec:
1412            if (r->order[1] == ringorder_C ||  r->order[0] == ringorder_unspec)
1413              return rOrderType_ExpComp;
1414            return rOrderType_Exp;
1415
1416          default:
1417            assume(r->order[0] == ringorder_lp ||
1418                   r->order[0] == ringorder_rp ||
1419                   r->order[0] == ringorder_Dp ||
1420                   r->order[0] == ringorder_Wp ||
1421                   r->order[0] == ringorder_Ds ||
1422                   r->order[0] == ringorder_Ws);
1423
1424            if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1425            return rOrderType_Exp;
1426      }
1427    }
1428    else
1429    {
1430      assume((r->order[0]==ringorder_c)||(r->order[0]==ringorder_C));
1431      return rOrderType_CompExp;
1432    }
1433  }
1434  else
1435    return rOrderType_General;
1436}
1437
1438BOOLEAN rHasSimpleOrder(ring r)
1439{
1440  if (r->order[0] == ringorder_unspec) return TRUE;
1441  int blocks = rBlocks(r) - 1;
1442  assume(blocks >= 1);
1443  if (blocks == 1) return TRUE;
1444  if (blocks > 2)  return FALSE;
1445  if (r->order[0] != ringorder_c && r->order[0] != ringorder_C &&
1446      r->order[1] != ringorder_c && r->order[1] != ringorder_C)
1447    return FALSE;
1448  if (r->order[1] == ringorder_M || r->order[0] == ringorder_M)
1449    return FALSE;
1450  return TRUE;
1451}
1452
1453// returns TRUE, if simple lp or ls ordering
1454BOOLEAN rHasSimpleLexOrder(ring r)
1455{
1456  return rHasSimpleOrder(r) &&
1457    (r->order[0] == ringorder_ls ||
1458     r->order[0] == ringorder_lp ||
1459     r->order[1] == ringorder_ls ||
1460     r->order[1] == ringorder_lp);
1461}
1462
1463BOOLEAN rOrder_is_DegOrdering(rRingOrder_t order)
1464{
1465  switch(order)
1466  {
1467      case ringorder_dp:
1468      case ringorder_Dp:
1469      case ringorder_ds:
1470      case ringorder_Ds:
1471      case ringorder_Ws:
1472      case ringorder_Wp:
1473      case ringorder_ws:
1474      case ringorder_wp:
1475        return TRUE;
1476
1477      default:
1478        return FALSE;
1479  }
1480}
1481
1482BOOLEAN rOrder_is_WeightedOrdering(rRingOrder_t order)
1483{
1484  switch(order)
1485  {
1486      case ringorder_Ws:
1487      case ringorder_Wp:
1488      case ringorder_ws:
1489      case ringorder_wp:
1490        return TRUE;
1491
1492      default:
1493        return FALSE;
1494  }
1495}
1496
1497BOOLEAN rHasSimpleOrderAA(ring r)
1498{
1499  int blocks = rBlocks(r) - 1;
1500  if (blocks > 3 || blocks < 2) return FALSE;
1501  if (blocks == 3)
1502  {
1503    return ((r->order[0] == ringorder_aa && r->order[1] != ringorder_M &&
1504             (r->order[2] == ringorder_c || r->order[2] == ringorder_C)) ||
1505            ((r->order[0] == ringorder_c || r->order[0] == ringorder_C) &&
1506             r->order[1] == ringorder_aa && r->order[2] != ringorder_M));
1507  }
1508  else
1509  {
1510    return (r->order[0] == ringorder_aa && r->order[1] != ringorder_M);
1511  }
1512}
1513
1514// return TRUE if p_SetComp requires p_Setm
1515BOOLEAN rOrd_SetCompRequiresSetm(ring r)
1516{
1517  if (r->typ != NULL)
1518  {
1519    int pos;
1520    for (pos=0;pos<r->OrdSize;pos++)
1521    {
1522      sro_ord* o=&(r->typ[pos]);
1523      if (o->ord_typ == ro_syzcomp || o->ord_typ == ro_syz) return TRUE;
1524    }
1525  }
1526  return FALSE;
1527}
1528
1529// return TRUE if p->exp[r->pOrdIndex] holds total degree of p */
1530BOOLEAN rOrd_is_Totaldegree_Ordering(ring r)
1531{
1532  // Hmm.... what about Syz orderings?
1533  return (rVar(r) > 1 &&
1534          ((rHasSimpleOrder(r) &&
1535           (rOrder_is_DegOrdering((rRingOrder_t)r->order[0]) ||
1536            rOrder_is_DegOrdering(( rRingOrder_t)r->order[1]))) ||
1537           (rHasSimpleOrderAA(r) &&
1538            (rOrder_is_DegOrdering((rRingOrder_t)r->order[1]) ||
1539             rOrder_is_DegOrdering((rRingOrder_t)r->order[2])))));
1540}
1541
1542// return TRUE if p->exp[r->pOrdIndex] holds a weighted degree of p */
1543BOOLEAN rOrd_is_WeightedDegree_Ordering(ring r =currRing)
1544{
1545  // Hmm.... what about Syz orderings?
1546  return ((rVar(r) > 1) &&
1547          rHasSimpleOrder(r) &&
1548          (rOrder_is_WeightedOrdering((rRingOrder_t)r->order[0]) ||
1549           rOrder_is_WeightedOrdering(( rRingOrder_t)r->order[1])));
1550}
1551
1552BOOLEAN rIsPolyVar(int v, ring r)
1553{
1554  int  i=0;
1555  while(r->order[i]!=0)
1556  {
1557    if((r->block0[i]<=v)
1558    && (r->block1[i]>=v))
1559    {
1560      switch(r->order[i])
1561      {
1562        case ringorder_a:
1563          return (r->wvhdl[i][v-r->block0[i]]>0);
1564        case ringorder_M:
1565          return 2; /*don't know*/
1566        case ringorder_lp:
1567        case ringorder_rp:
1568        case ringorder_dp:
1569        case ringorder_Dp:
1570        case ringorder_wp:
1571        case ringorder_Wp:
1572          return TRUE;
1573        case ringorder_ls:
1574        case ringorder_ds:
1575        case ringorder_Ds:
1576        case ringorder_ws:
1577        case ringorder_Ws:
1578          return FALSE;
1579        default:
1580          break;
1581      }
1582    }
1583    i++;
1584  }
1585  return 3; /* could not find var v*/
1586}
1587
1588#ifdef RDEBUG
1589// This should eventually become a full-fledge ring check, like pTest
1590BOOLEAN rDBTest(ring r, char* fn, int l)
1591{
1592  int i,j;
1593
1594  if (r == NULL)
1595  {
1596    dReportError("Null ring in %s:%d", fn, l);
1597    return FALSE;
1598  }
1599
1600
1601  if (r->N == 0) return TRUE;
1602
1603//  omCheckAddrSize(r,sizeof(ip_sring));
1604#if OM_CHECK > 0
1605  i=rBlocks(r);
1606  omCheckAddrSize(r->order,i*sizeof(int));
1607  omCheckAddrSize(r->block0,i*sizeof(int));
1608  omCheckAddrSize(r->block1,i*sizeof(int));
1609  omCheckAddrSize(r->wvhdl,i*sizeof(int *));
1610  for (j=0;j<i; j++)
1611  {
1612    if (r->wvhdl[j] != NULL) omCheckAddr(r->wvhdl[j]);
1613  }
1614#endif
1615  if (r->VarOffset == NULL)
1616  {
1617    dReportError("Null ring VarOffset -- no rComplete (?) in n %s:%d", fn, l);
1618    return FALSE;
1619  }
1620  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(int));
1621
1622  if ((r->OrdSize==0)!=(r->typ==NULL))
1623  {
1624    dReportError("mismatch OrdSize and typ-pointer in %s:%d");
1625    return FALSE;
1626  }
1627  omcheckAddrSize(r->typ,r->OrdSize*sizeof(*(r->typ)));
1628  omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(*(r->VarOffset)));
1629  // test assumptions:
1630  for(i=0;i<=r->N;i++)
1631  {
1632    if(r->typ!=NULL)
1633    {
1634      for(j=0;j<r->OrdSize;j++)
1635      {
1636        if (r->typ[j].ord_typ==ro_cp)
1637        {
1638          if(((short)r->VarOffset[i]) == r->typ[j].data.cp.place)
1639            dReportError("ordrec %d conflicts with var %d",j,i);
1640        }
1641        else
1642          if ((r->typ[j].ord_typ!=ro_syzcomp)
1643          && (r->VarOffset[i] == r->typ[j].data.dp.place))
1644            dReportError("ordrec %d conflicts with var %d",j,i);
1645      }
1646    }
1647    int tmp;
1648      tmp=r->VarOffset[i] & 0xffffff;
1649      #if SIZEOF_LONG == 8
1650        if ((r->VarOffset[i] >> 24) >63)
1651      #else
1652        if ((r->VarOffset[i] >> 24) >31)
1653      #endif
1654          dReportError("bit_start out of range:%d",r->VarOffset[i] >> 24);
1655      if (i > 0 && ((tmp<0) ||(tmp>r->ExpL_Size-1)))
1656      {
1657        dReportError("varoffset out of range for var %d: %d",i,tmp);
1658      }
1659  }
1660  if(r->typ!=NULL)
1661  {
1662    for(j=0;j<r->OrdSize;j++)
1663    {
1664      if ((r->typ[j].ord_typ==ro_dp)
1665      || (r->typ[j].ord_typ==ro_wp)
1666      || (r->typ[j].ord_typ==ro_wp_neg))
1667      {
1668        if (r->typ[j].data.dp.start > r->typ[j].data.dp.end)
1669          dReportError("in ordrec %d: start(%d) > end(%d)",j,
1670            r->typ[j].data.dp.start, r->typ[j].data.dp.end);
1671        if ((r->typ[j].data.dp.start < 1)
1672        || (r->typ[j].data.dp.end > r->N))
1673          dReportError("in ordrec %d: start(%d)<1 or end(%d)>vars(%d)",j,
1674            r->typ[j].data.dp.start, r->typ[j].data.dp.end,r->N);
1675      }
1676    }
1677  }
1678  //assume(r->cf!=NULL);
1679
1680  return TRUE;
1681}
1682#endif
1683
1684static void rO_Align(int &place, int &bitplace)
1685{
1686  // increment place to the next aligned one
1687  // (count as Exponent_t,align as longs)
1688  if (bitplace!=BITS_PER_LONG)
1689  {
1690    place++;
1691    bitplace=BITS_PER_LONG;
1692  }
1693}
1694
1695static void rO_TDegree(int &place, int &bitplace, int start, int end,
1696    long *o, sro_ord &ord_struct)
1697{
1698  // degree (aligned) of variables v_start..v_end, ordsgn 1
1699  rO_Align(place,bitplace);
1700  ord_struct.ord_typ=ro_dp;
1701  ord_struct.data.dp.start=start;
1702  ord_struct.data.dp.end=end;
1703  ord_struct.data.dp.place=place;
1704  o[place]=1;
1705  place++;
1706  rO_Align(place,bitplace);
1707}
1708
1709static void rO_TDegree_neg(int &place, int &bitplace, int start, int end,
1710    long *o, sro_ord &ord_struct)
1711{
1712  // degree (aligned) of variables v_start..v_end, ordsgn -1
1713  rO_Align(place,bitplace);
1714  ord_struct.ord_typ=ro_dp;
1715  ord_struct.data.dp.start=start;
1716  ord_struct.data.dp.end=end;
1717  ord_struct.data.dp.place=place;
1718  o[place]=-1;
1719  place++;
1720  rO_Align(place,bitplace);
1721}
1722
1723static void rO_WDegree(int &place, int &bitplace, int start, int end,
1724    long *o, sro_ord &ord_struct, int *weights)
1725{
1726  // weighted degree (aligned) of variables v_start..v_end, ordsgn 1
1727  while((start<end) && (weights[0]==0)) { start++; weights++; }
1728  while((start<end) && (weights[end-start]==0)) { end--; }
1729  int i;
1730  int pure_tdeg=1;
1731  for(i=start;i<=end;i++)
1732  {
1733    if(weights[i-start]!=1)
1734    {
1735      pure_tdeg=0;
1736      break;
1737    }
1738  }
1739  if (pure_tdeg)
1740  {
1741    rO_TDegree(place,bitplace,start,end,o,ord_struct);
1742    return;
1743  }
1744  rO_Align(place,bitplace);
1745  ord_struct.ord_typ=ro_wp;
1746  ord_struct.data.wp.start=start;
1747  ord_struct.data.wp.end=end;
1748  ord_struct.data.wp.place=place;
1749  ord_struct.data.wp.weights=weights;
1750  o[place]=1;
1751  place++;
1752  rO_Align(place,bitplace);
1753  for(i=start;i<=end;i++)
1754  {
1755    if(weights[i-start]<0)
1756    {
1757      ord_struct.ord_typ=ro_wp_neg;
1758      break;
1759    }
1760  }
1761}
1762
1763static void rO_WDegree_neg(int &place, int &bitplace, int start, int end,
1764    long *o, sro_ord &ord_struct, int *weights)
1765{
1766  // weighted degree (aligned) of variables v_start..v_end, ordsgn -1
1767  while((start<end) && (weights[0]==0)) { start++; weights++; }
1768  while((start<end) && (weights[end-start]==0)) { end--; }
1769  rO_Align(place,bitplace);
1770  ord_struct.ord_typ=ro_wp;
1771  ord_struct.data.wp.start=start;
1772  ord_struct.data.wp.end=end;
1773  ord_struct.data.wp.place=place;
1774  ord_struct.data.wp.weights=weights;
1775  o[place]=-1;
1776  place++;
1777  rO_Align(place,bitplace);
1778  int i;
1779  for(i=start;i<=end;i++)
1780  {
1781    if(weights[i-start]<0)
1782    {
1783      ord_struct.ord_typ=ro_wp_neg;
1784      break;
1785    }
1786  }
1787}
1788
1789static void rO_LexVars(int &place, int &bitplace, int start, int end,
1790  int &prev_ord, long *o,int *v, int bits, int opt_var)
1791{
1792  // a block of variables v_start..v_end with lex order, ordsgn 1
1793  int k;
1794  int incr=1;
1795  if(prev_ord==-1) rO_Align(place,bitplace);
1796
1797  if (start>end)
1798  {
1799    incr=-1;
1800  }
1801  for(k=start;;k+=incr)
1802  {
1803    bitplace-=bits;
1804    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
1805    o[place]=1;
1806    v[k]= place | (bitplace << 24);
1807    if (k==end) break;
1808  }
1809  prev_ord=1;
1810  if (opt_var!= -1)
1811  {
1812    assume((opt_var == end+1) ||(opt_var == end-1));
1813    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-2");
1814    int save_bitplace=bitplace;
1815    bitplace-=bits;
1816    if (bitplace < 0)
1817    {
1818      bitplace=save_bitplace;
1819      return;
1820    }
1821    // there is enough space for the optional var
1822    v[opt_var]=place | (bitplace << 24);
1823  }
1824}
1825
1826static void rO_LexVars_neg(int &place, int &bitplace, int start, int end,
1827  int &prev_ord, long *o,int *v, int bits, int opt_var)
1828{
1829  // a block of variables v_start..v_end with lex order, ordsgn -1
1830  int k;
1831  int incr=1;
1832  if(prev_ord==1) rO_Align(place,bitplace);
1833
1834  if (start>end)
1835  {
1836    incr=-1;
1837  }
1838  for(k=start;;k+=incr)
1839  {
1840    bitplace-=bits;
1841    if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
1842    o[place]=-1;
1843    v[k]=place | (bitplace << 24);
1844    if (k==end) break;
1845  }
1846  prev_ord=-1;
1847//  #if 0
1848  if (opt_var!= -1)
1849  {
1850    assume((opt_var == end+1) ||(opt_var == end-1));
1851    if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-1");
1852    int save_bitplace=bitplace;
1853    bitplace-=bits;
1854    if (bitplace < 0)
1855    {
1856      bitplace=save_bitplace;
1857      return;
1858    }
1859    // there is enough space for the optional var
1860    v[opt_var]=place | (bitplace << 24);
1861  }
1862//  #endif
1863}
1864
1865static void rO_Syzcomp(int &place, int &bitplace, int &prev_ord,
1866    long *o, sro_ord &ord_struct)
1867{
1868  // ordering is derived from component number
1869  rO_Align(place,bitplace);
1870  ord_struct.ord_typ=ro_syzcomp;
1871  ord_struct.data.syzcomp.place=place;
1872  ord_struct.data.syzcomp.Components=NULL;
1873  ord_struct.data.syzcomp.ShiftedComponents=NULL;
1874  o[place]=1;
1875  prev_ord=1;
1876  place++;
1877  rO_Align(place,bitplace);
1878}
1879
1880static void rO_Syz(int &place, int &bitplace, int &prev_ord,
1881    long *o, sro_ord &ord_struct)
1882{
1883  // ordering is derived from component number
1884  // let's reserve one Exponent_t for it
1885  if ((prev_ord== 1) || (bitplace!=BITS_PER_LONG))
1886    rO_Align(place,bitplace);
1887  ord_struct.ord_typ=ro_syz;
1888  ord_struct.data.syz.place=place;
1889  ord_struct.data.syz.limit=0;
1890  ord_struct.data.syz.syz_index = NULL;
1891  ord_struct.data.syz.curr_index = 1;
1892  o[place]= -1;
1893  prev_ord=-1;
1894  place++;
1895}
1896
1897static unsigned long rGetExpSize(unsigned long bitmask, int & bits)
1898{
1899  if (bitmask == 0)
1900  {
1901    bits=16; bitmask=0xffff;
1902  }
1903  else if (bitmask <= 1)
1904  {
1905    bits=1; bitmask = 1;
1906  }
1907  else if (bitmask <= 3)
1908  {
1909    bits=2; bitmask = 3;
1910  }
1911  else if (bitmask <= 7)
1912  {
1913    bits=3; bitmask=7;
1914  }
1915  else if (bitmask <= 0xf)
1916  {
1917    bits=4; bitmask=0xf;
1918  }
1919  else if (bitmask <= 0x1f)
1920  {
1921    bits=5; bitmask=0x1f;
1922  }
1923  else if (bitmask <= 0x3f)
1924  {
1925    bits=6; bitmask=0x3f;
1926  }
1927#if SIZEOF_LONG == 8
1928  else if (bitmask <= 0x7f)
1929  {
1930    bits=7; bitmask=0x7f; /* 64 bit longs only */
1931  }
1932#endif
1933  else if (bitmask <= 0xff)
1934  {
1935    bits=8; bitmask=0xff;
1936  }
1937#if SIZEOF_LONG == 8
1938  else if (bitmask <= 0x1ff)
1939  {
1940    bits=9; bitmask=0x1ff; /* 64 bit longs only */
1941  }
1942#endif
1943  else if (bitmask <= 0x3ff)
1944  {
1945    bits=10; bitmask=0x3ff;
1946  }
1947#if SIZEOF_LONG == 8
1948  else if (bitmask <= 0xfff)
1949  {
1950    bits=12; bitmask=0xfff; /* 64 bit longs only */
1951  }
1952#endif
1953  else if (bitmask <= 0xffff)
1954  {
1955    bits=16; bitmask=0xffff;
1956  }
1957#if SIZEOF_LONG == 8
1958  else if (bitmask <= 0xfffff)
1959  {
1960    bits=20; bitmask=0xfffff; /* 64 bit longs only */
1961  }
1962  else if (bitmask <= 0xffffffff)
1963  {
1964    bits=32; bitmask=0xffffffff;
1965  }
1966  else
1967  {
1968    bits=64; bitmask=0xffffffffffffffff;
1969  }
1970#else
1971  else
1972  {
1973    bits=32; bitmask=0xffffffff;
1974  }
1975#endif
1976  return bitmask;
1977}
1978
1979/*2
1980* optimize rGetExpSize for a block of N variables, exp <=bitmask
1981*/
1982static unsigned long rGetExpSize(unsigned long bitmask, int & bits, int N)
1983{
1984  bitmask =rGetExpSize(bitmask, bits);
1985  int vars_per_long=BIT_SIZEOF_LONG/bits;
1986  int bits1;
1987  loop
1988  {
1989    if (bits == BIT_SIZEOF_LONG)
1990    {
1991      bits =  BIT_SIZEOF_LONG - 1;
1992      return LONG_MAX;
1993    }
1994    unsigned long bitmask1 =rGetExpSize(bitmask+1, bits1);
1995    int vars_per_long1=BIT_SIZEOF_LONG/bits1;
1996    if ((((N+vars_per_long-1)/vars_per_long) ==
1997         ((N+vars_per_long1-1)/vars_per_long1)))
1998    {
1999      vars_per_long=vars_per_long1;
2000      bits=bits1;
2001      bitmask=bitmask1;
2002    }
2003    else
2004    {
2005      return bitmask; /* and bits */
2006    }
2007  }
2008}
2009
2010/*2
2011 * create a copy of the ring r, which must be equivalent to currRing
2012 * used for std computations
2013 * may share data structures with currRing
2014 * DOES CALL rComplete
2015 */
2016ring rModifyRing(ring r, BOOLEAN omit_degree,
2017                         BOOLEAN omit_comp,
2018                         unsigned long exp_limit)
2019{
2020  assume (r != NULL );
2021  assume (exp_limit > 1);
2022  BOOLEAN need_other_ring;
2023  BOOLEAN omitted_degree = FALSE;
2024  int bits;
2025
2026  exp_limit=rGetExpSize(exp_limit, bits, r->N);
2027  need_other_ring = (exp_limit != r->bitmask);
2028
2029  int nblocks=rBlocks(r);
2030  int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
2031  int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
2032  int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
2033  int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int_ptr));
2034
2035  int i=0;
2036  int j=0; /*  i index in r, j index in res */
2037  loop
2038  {
2039    BOOLEAN copy_block_index=TRUE;
2040    int r_ord=r->order[i];
2041    if (r->block0[i]==r->block1[i])
2042    {
2043      switch(r_ord)
2044      {
2045        case ringorder_wp:
2046        case ringorder_dp:
2047        case ringorder_Wp:
2048        case ringorder_Dp:
2049          r_ord=ringorder_lp;
2050          break;
2051        case ringorder_Ws:
2052        case ringorder_Ds:
2053        case ringorder_ws:
2054        case ringorder_ds:
2055          r_ord=ringorder_ls;
2056          break;
2057        default:
2058          break;
2059      }
2060    }
2061    switch(r_ord)
2062    {
2063      case ringorder_C:
2064      case ringorder_c:
2065        if (!omit_comp)
2066        {
2067          order[j]=r_ord; /*r->order[i]*/;
2068        }
2069        else
2070        {
2071          j--;
2072          need_other_ring=TRUE;
2073          omit_comp=FALSE;
2074          copy_block_index=FALSE;
2075        }
2076        break;
2077      case ringorder_wp:
2078      case ringorder_dp:
2079      case ringorder_ws:
2080      case ringorder_ds:
2081        if(!omit_degree)
2082        {
2083          order[j]=r_ord; /*r->order[i]*/;
2084        }
2085        else
2086        {
2087          order[j]=ringorder_rp;
2088          need_other_ring=TRUE;
2089          omit_degree=FALSE;
2090          omitted_degree = TRUE;
2091        }
2092        break;
2093      case ringorder_Wp:
2094      case ringorder_Dp:
2095      case ringorder_Ws:
2096      case ringorder_Ds:
2097        if(!omit_degree)
2098        {
2099          order[j]=r_ord; /*r->order[i];*/
2100        }
2101        else
2102        {
2103          order[j]=ringorder_lp;
2104          need_other_ring=TRUE;
2105          omit_degree=FALSE;
2106          omitted_degree = TRUE;
2107        }
2108        break;
2109      default:
2110        order[j]=r_ord; /*r->order[i];*/
2111        break;
2112    }
2113    if (copy_block_index)
2114    {
2115      block0[j]=r->block0[i];
2116      block1[j]=r->block1[i];
2117      wvhdl[j]=r->wvhdl[i];
2118    }
2119    i++;j++;
2120    // order[j]=ringorder_no; //  done by omAlloc0
2121    if (i==nblocks) break;
2122  }
2123  if(!need_other_ring)
2124  {
2125    omFreeSize(order,(nblocks+1)*sizeof(int));
2126    omFreeSize(block0,(nblocks+1)*sizeof(int));
2127    omFreeSize(block1,(nblocks+1)*sizeof(int));
2128    omFreeSize(wvhdl,(nblocks+1)*sizeof(int_ptr));
2129    return r;
2130  }
2131  ring res=(ring)omAlloc0Bin(ip_sring_bin);
2132  *res = *r;
2133  // res->qideal, res->idroot ???
2134  res->wvhdl=wvhdl;
2135  res->order=order;
2136  res->block0=block0;
2137  res->block1=block1;
2138  res->bitmask=exp_limit;
2139  int tmpref=r->cf->ref;
2140  rComplete(res, 1);
2141  r->cf->ref=tmpref;
2142
2143  // adjust res->pFDeg: if it was changed globally, then
2144  // it must also be changed for new ring
2145  if (r->pFDegOrig != res->pFDegOrig &&
2146           rOrd_is_WeightedDegree_Ordering(r))
2147  {
2148    // still might need adjustment for weighted orderings
2149    // and omit_degree
2150    res->firstwv = r->firstwv;
2151    res->firstBlockEnds = r->firstBlockEnds;
2152    res->pFDeg = res->pFDegOrig = pWFirstTotalDegree;
2153  }
2154  if (omitted_degree)
2155    res->pLDeg = res->pLDegOrig = r->pLDegOrig;
2156
2157  rOptimizeLDeg(res);
2158
2159  // set syzcomp
2160  if (res->typ != NULL && res->typ[0].ord_typ == ro_syz)
2161  {
2162    res->typ[0] = r->typ[0];
2163    if (r->typ[0].data.syz.limit > 0)
2164    {
2165      res->typ[0].data.syz.syz_index
2166        = (int*) omAlloc((r->typ[0].data.syz.limit +1)*sizeof(int));
2167      memcpy(res->typ[0].data.syz.syz_index, r->typ[0].data.syz.syz_index,
2168             (r->typ[0].data.syz.limit +1)*sizeof(int));
2169    }
2170  }
2171  return res;
2172}
2173
2174// construct Wp,C ring
2175ring rModifyRing_Wp(ring r, int* weights)
2176{
2177  ring res=(ring)omAlloc0Bin(ip_sring_bin);
2178  *res = *r;
2179  /*weights: entries for 3 blocks: NULL*/
2180  res->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
2181  /*order: dp,C,0*/
2182  res->order = (int *) omAlloc(3 * sizeof(int *));
2183  res->block0 = (int *)omAlloc0(3 * sizeof(int *));
2184  res->block1 = (int *)omAlloc0(3 * sizeof(int *));
2185  /* ringorder dp for the first block: var 1..3 */
2186  res->order[0]  = ringorder_Wp;
2187  res->block0[0] = 1;
2188  res->block1[0] = r->N;
2189  res->wvhdl[0] = weights;
2190  /* ringorder C for the second block: no vars */
2191  res->order[1]  = ringorder_C;
2192  /* the last block: everything is 0 */
2193  res->order[2]  = 0;
2194  /*polynomial ring*/
2195  res->OrdSgn    = 1;
2196
2197  int tmpref=r->cf->ref;
2198  rComplete(res, 1);
2199  r->cf->ref=tmpref;
2200  return res;
2201}
2202
2203// construct lp ring with r->N variables, r->names vars....
2204ring rModifyRing_Simple(ring r, BOOLEAN ommit_degree, BOOLEAN ommit_comp, unsigned long exp_limit, BOOLEAN &simple)
2205{
2206  simple=TRUE;
2207  if (!rHasSimpleOrder(r))
2208  {
2209    simple=FALSE; // sorting needed
2210    assume (r != NULL );
2211    assume (exp_limit > 1);
2212    BOOLEAN omitted_degree = FALSE;
2213    int bits;
2214
2215    exp_limit=rGetExpSize(exp_limit, bits, r->N);
2216
2217    int nblocks=1+(ommit_comp!=0);
2218    int *order=(int*)omAlloc0((nblocks+1)*sizeof(int));
2219    int *block0=(int*)omAlloc0((nblocks+1)*sizeof(int));
2220    int *block1=(int*)omAlloc0((nblocks+1)*sizeof(int));
2221    int **wvhdl=(int**)omAlloc0((nblocks+1)*sizeof(int_ptr));
2222
2223    order[0]=ringorder_lp;
2224    block0[0]=1;
2225    block1[0]=r->N;
2226    if (!ommit_comp)
2227    {
2228      order[1]=ringorder_C;
2229    }
2230    ring res=(ring)omAlloc0Bin(ip_sring_bin);
2231    *res = *r;
2232    // res->qideal, res->idroot ???
2233    res->wvhdl=wvhdl;
2234    res->order=order;
2235    res->block0=block0;
2236    res->block1=block1;
2237    res->bitmask=exp_limit;
2238    int tmpref=r->cf->ref;
2239    rComplete(res, 1);
2240    r->cf->ref=tmpref;
2241
2242    rOptimizeLDeg(res);
2243
2244    return res;
2245  }
2246  return rModifyRing(r, ommit_degree, ommit_comp, exp_limit);
2247}
2248
2249void rKillModifiedRing_Simple(ring r)
2250{
2251  rKillModifiedRing(r);
2252}
2253
2254
2255void rKillModifiedRing(ring r)
2256{
2257  rUnComplete(r);
2258  omFree(r->order);
2259  omFree(r->block0);
2260  omFree(r->block1);
2261  omFree(r->wvhdl);
2262  omFreeBin(r,ip_sring_bin);
2263}
2264
2265void rKillModified_Wp_Ring(ring r)
2266{
2267  rUnComplete(r);
2268  omFree(r->order);
2269  omFree(r->block0);
2270  omFree(r->block1);
2271  omFree(r->wvhdl[0]);
2272  omFree(r->wvhdl);
2273  omFreeBin(r,ip_sring_bin);
2274}
2275
2276static void rSetOutParams(ring r)
2277{
2278  r->VectorOut = (r->order[0] == ringorder_c);
2279  r->ShortOut = TRUE;
2280#ifdef HAVE_TCL
2281  if (tcllmode)
2282  {
2283    r->ShortOut = FALSE;
2284  }
2285  else
2286#endif
2287  {
2288    int i;
2289    if ((r->parameter!=NULL) && (r->ch<2))
2290    {
2291      for (i=0;i<rPar(r);i++)
2292      {
2293        if(strlen(r->parameter[i])>1)
2294        {
2295          r->ShortOut=FALSE;
2296          break;
2297        }
2298      }
2299    }
2300    if (r->ShortOut)
2301    {
2302      // Hmm... sometimes (e.g., from maGetPreimage) new variables
2303      // are intorduced, but their names are never set
2304      // hence, we do the following awkward trick
2305      int N = omSizeWOfAddr(r->names);
2306      if (r->N < N) N = r->N;
2307
2308      for (i=(N-1);i>=0;i--)
2309      {
2310        if(r->names[i] != NULL && strlen(r->names[i])>1)
2311        {
2312          r->ShortOut=FALSE;
2313          break;
2314        }
2315      }
2316    }
2317  }
2318  r->CanShortOut = r->ShortOut;
2319}
2320
2321/*2
2322* sets pMixedOrder and pComponentOrder for orderings with more than one block
2323* block of variables (ip is the block number, o_r the number of the ordering)
2324* o is the position of the orderingering in r
2325*/
2326static void rHighSet(ring r, int o_r, int o)
2327{
2328  switch(o_r)
2329  {
2330    case ringorder_lp:
2331    case ringorder_dp:
2332    case ringorder_Dp:
2333    case ringorder_wp:
2334    case ringorder_Wp:
2335    case ringorder_rp:
2336    case ringorder_a:
2337    case ringorder_aa:
2338      if (r->OrdSgn==-1) r->MixedOrder=TRUE;
2339      break;
2340    case ringorder_ls:
2341    case ringorder_ds:
2342    case ringorder_Ds:
2343    case ringorder_s:
2344      break;
2345    case ringorder_ws:
2346    case ringorder_Ws:
2347      if (r->wvhdl[o]!=NULL)
2348      {
2349        int i;
2350        for(i=r->block1[o]-r->block0[o];i>=0;i--)
2351          if (r->wvhdl[o][i]<0) { r->MixedOrder=TRUE; break; }
2352      }
2353      break;
2354    case ringorder_c:
2355      r->ComponentOrder=1;
2356      break;
2357    case ringorder_C:
2358    case ringorder_S:
2359      r->ComponentOrder=-1;
2360      break;
2361    case ringorder_M:
2362      r->MixedOrder=TRUE;
2363      break;
2364    default:
2365      dReportError("wrong internal ordering:%d at %s, l:%d\n",o_r,__FILE__,__LINE__);
2366  }
2367}
2368
2369static void rSetFirstWv(ring r, int i, int* order, int* block1, int** wvhdl)
2370{
2371  // cheat for ringorder_aa
2372  if (order[i] == ringorder_aa)
2373    i++;
2374  if(block1[i]!=r->N) r->LexOrder=TRUE;
2375  r->firstBlockEnds=block1[i];
2376  r->firstwv = wvhdl[i];
2377  if ((order[i]== ringorder_ws) || (order[i]==ringorder_Ws))
2378  {
2379    int j;
2380    for(j=block1[i]-r->block0[i];j>=0;j--)
2381      if (r->firstwv[j]<0) { r->MixedOrder=TRUE; break; }
2382  }
2383}
2384
2385static void rOptimizeLDeg(ring r)
2386{
2387  if (r->pFDeg == pDeg)
2388  {
2389    if (r->pLDeg == pLDeg1)
2390      r->pLDeg = pLDeg1_Deg;
2391    if (r->pLDeg == pLDeg1c)
2392      r->pLDeg = pLDeg1c_Deg;
2393  }
2394  else if (r->pFDeg == pTotaldegree)
2395  {
2396    if (r->pLDeg == pLDeg1)
2397      r->pLDeg = pLDeg1_Totaldegree;
2398    if (r->pLDeg == pLDeg1c)
2399      r->pLDeg = pLDeg1c_Totaldegree;
2400  }
2401  else if (r->pFDeg == pWFirstTotalDegree)
2402  {
2403    if (r->pLDeg == pLDeg1)
2404      r->pLDeg = pLDeg1_WFirstTotalDegree;
2405    if (r->pLDeg == pLDeg1c)
2406      r->pLDeg = pLDeg1c_WFirstTotalDegree;
2407  }
2408}
2409
2410// set pFDeg, pLDeg, MixOrder, ComponentOrder, etc
2411static void rSetDegStuff(ring r)
2412{
2413  int* order = r->order;
2414  int* block0 = r->block0;
2415  int* block1 = r->block1;
2416  int** wvhdl = r->wvhdl;
2417
2418  if (order[0]==ringorder_S ||order[0]==ringorder_s)
2419  {
2420    order++;
2421    block0++;
2422    block1++;
2423    wvhdl++;
2424  }
2425  r->LexOrder = FALSE;
2426  r->MixedOrder = FALSE;
2427  r->ComponentOrder = 1;
2428  r->pFDeg = pTotaldegree;
2429  r->pLDeg = (r->OrdSgn == 1 ? pLDegb : pLDeg0);
2430
2431  /*======== ordering type is (_,c) =========================*/
2432  if ((order[0]==ringorder_unspec) || (order[1] == 0)
2433      ||(
2434    ((order[1]==ringorder_c)||(order[1]==ringorder_C)
2435     ||(order[1]==ringorder_S)
2436     ||(order[1]==ringorder_s))
2437    && (order[0]!=ringorder_M)
2438    && (order[2]==0))
2439    )
2440  {
2441    if ((order[0]!=ringorder_unspec)
2442    && ((order[1]==ringorder_C)||(order[1]==ringorder_S)||
2443        (order[1]==ringorder_s)))
2444      r->ComponentOrder=-1;
2445    if (r->OrdSgn == -1) r->pLDeg = pLDeg0c;
2446    if ((order[0] == ringorder_lp) || (order[0] == ringorder_ls) || order[0] == ringorder_rp)
2447    {
2448      r->LexOrder=TRUE;
2449      r->pLDeg = pLDeg1c;
2450    }
2451    if (order[0] == ringorder_wp || order[0] == ringorder_Wp ||
2452        order[0] == ringorder_ws || order[0] == ringorder_Ws)
2453      r->pFDeg = pWFirstTotalDegree;
2454    r->firstBlockEnds=block1[0];
2455    r->firstwv = wvhdl[0];
2456  }
2457  /*======== ordering type is (c,_) =========================*/
2458  else if (((order[0]==ringorder_c)
2459            ||(order[0]==ringorder_C)
2460            ||(order[0]==ringorder_S)
2461            ||(order[0]==ringorder_s))
2462  && (order[1]!=ringorder_M)
2463  &&  (order[2]==0))
2464  {
2465    if ((order[0]==ringorder_C)||(order[0]==ringorder_S)||
2466        order[0]==ringorder_s)
2467      r->ComponentOrder=-1;
2468    if ((order[1] == ringorder_lp) || (order[1] == ringorder_ls) || order[1] == ringorder_rp)
2469    {
2470      r->LexOrder=TRUE;
2471      r->pLDeg = pLDeg1c;
2472    }
2473    r->firstBlockEnds=block1[1];
2474    r->firstwv = wvhdl[1];
2475    if (order[1] == ringorder_wp || order[1] == ringorder_Wp ||
2476        order[1] == ringorder_ws || order[1] == ringorder_Ws)
2477      r->pFDeg = pWFirstTotalDegree;
2478  }
2479  /*------- more than one block ----------------------*/
2480  else
2481  {
2482    if ((r->VectorOut)||(order[0]==ringorder_C)||(order[0]==ringorder_S)||(order[0]==ringorder_s))
2483    {
2484      rSetFirstWv(r, 1, order, block1, wvhdl);
2485    }
2486    else
2487      rSetFirstWv(r, 0, order, block1, wvhdl);
2488
2489    /*the number of orderings:*/
2490    int i = 0;
2491    while (order[++i] != 0);
2492    do
2493    {
2494      i--;
2495      rHighSet(r, order[i],i);
2496    }
2497    while (i != 0);
2498
2499    if ((order[0]!=ringorder_c)
2500        && (order[0]!=ringorder_C)
2501        && (order[0]!=ringorder_S)
2502        && (order[0]!=ringorder_s))
2503    {
2504      r->pLDeg = pLDeg1c;
2505    }
2506    else
2507    {
2508      r->pLDeg = pLDeg1;
2509    }
2510    r->pFDeg = pWTotaldegree; // may be improved: pTotaldegree for lp/dp/ls/.. blocks
2511  }
2512  if (rOrd_is_Totaldegree_Ordering(r) || rOrd_is_WeightedDegree_Ordering(r))
2513    r->pFDeg = pDeg;
2514
2515  r->pFDegOrig = r->pFDeg;
2516  r->pLDegOrig = r->pLDeg;
2517  rOptimizeLDeg(r);
2518}
2519
2520/*2
2521* set NegWeightL_Size, NegWeightL_Offset
2522*/
2523static void rSetNegWeight(ring r)
2524{
2525  int i,l;
2526  if (r->typ!=NULL)
2527  {
2528    l=0;
2529    for(i=0;i<r->OrdSize;i++)
2530    {
2531      if(r->typ[i].ord_typ==ro_wp_neg) l++;
2532    }
2533    if (l>0)
2534    {
2535      r->NegWeightL_Size=l;
2536      r->NegWeightL_Offset=(int *) omAlloc(l*sizeof(int));
2537      l=0;
2538      for(i=0;i<r->OrdSize;i++)
2539      {
2540        if(r->typ[i].ord_typ==ro_wp_neg)
2541        {
2542          r->NegWeightL_Offset[l]=r->typ[i].data.wp.place;
2543          l++;
2544        }
2545      }
2546      return;
2547    }
2548  }
2549  r->NegWeightL_Size = 0;
2550  r->NegWeightL_Offset = NULL;
2551}
2552
2553static void rSetOption(ring r)
2554{
2555  // set redthrough
2556  if (!TEST_OPT_OLDSTD && r->OrdSgn == 1 && ! r->LexOrder)
2557    r->options |= Sy_bit(OPT_REDTHROUGH);
2558  else
2559    r->options &= ~Sy_bit(OPT_REDTHROUGH);
2560
2561  // set intStrategy
2562  if (rField_is_Extension(r) || rField_is_Q(r))
2563    r->options |= Sy_bit(OPT_INTSTRATEGY);
2564  else
2565    r->options &= ~Sy_bit(OPT_INTSTRATEGY);
2566
2567  // set redTail
2568  if (r->LexOrder || r->OrdSgn == -1 || rField_is_Extension(r))
2569    r->options &= ~Sy_bit(OPT_REDTAIL);
2570  else
2571    r->options |= Sy_bit(OPT_REDTAIL);
2572}
2573
2574BOOLEAN rComplete(ring r, int force)
2575{
2576  if (r->VarOffset!=NULL && force == 0) return FALSE;
2577  nInitChar(r);
2578  rSetOutParams(r);
2579  int n=rBlocks(r)-1;
2580  int i;
2581  int bits;
2582  r->bitmask=rGetExpSize(r->bitmask,bits,r->N);
2583  r->BitsPerExp = bits;
2584  r->ExpPerLong = BIT_SIZEOF_LONG / bits;
2585  r->divmask=rGetDivMask(bits);
2586
2587  // will be used for ordsgn:
2588  long *tmp_ordsgn=(long *)omAlloc0(2*(n+r->N)*sizeof(long));
2589  // will be used for VarOffset:
2590  int *v=(int *)omAlloc((r->N+1)*sizeof(int));
2591  for(i=r->N; i>=0 ; i--)
2592  {
2593    v[i]=-1;
2594  }
2595  sro_ord *tmp_typ=(sro_ord *)omAlloc0(2*(n+r->N)*sizeof(sro_ord));
2596  int typ_i=0;
2597  int prev_ordsgn=0;
2598
2599  // fill in v, tmp_typ, tmp_ordsgn, determine typ_i (== ordSize)
2600  int j=0;
2601  int j_bits=BITS_PER_LONG;
2602  BOOLEAN need_to_add_comp=FALSE;
2603  for(i=0;i<n;i++)
2604  {
2605    tmp_typ[typ_i].order_index=i;
2606    switch (r->order[i])
2607    {
2608      case ringorder_a:
2609      case ringorder_aa:
2610        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
2611                   r->wvhdl[i]);
2612        typ_i++;
2613        break;
2614
2615      case ringorder_c:
2616        rO_Align(j, j_bits);
2617        rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
2618        break;
2619
2620      case ringorder_C:
2621        rO_Align(j, j_bits);
2622        rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
2623        break;
2624
2625      case ringorder_M:
2626        {
2627          int k,l;
2628          k=r->block1[i]-r->block0[i]+1; // number of vars
2629          for(l=0;l<k;l++)
2630          {
2631            rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2632                       tmp_typ[typ_i],
2633                       r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
2634            typ_i++;
2635          }
2636          break;
2637        }
2638
2639      case ringorder_lp:
2640        rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2641                   tmp_ordsgn,v,bits, -1);
2642        break;
2643
2644      case ringorder_ls:
2645        rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
2646                       tmp_ordsgn,v, bits, -1);
2647        break;
2648
2649      case ringorder_rp:
2650        rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
2651                       tmp_ordsgn,v, bits, -1);
2652        break;
2653
2654      case ringorder_dp:
2655        if (r->block0[i]==r->block1[i])
2656        {
2657          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
2658                     tmp_ordsgn,v, bits, -1);
2659        }
2660        else
2661        {
2662          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2663                     tmp_typ[typ_i]);
2664          typ_i++;
2665          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
2666                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
2667        }
2668        break;
2669
2670      case ringorder_Dp:
2671        if (r->block0[i]==r->block1[i])
2672        {
2673          rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
2674                     tmp_ordsgn,v, bits, -1);
2675        }
2676        else
2677        {
2678          rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2679                     tmp_typ[typ_i]);
2680          typ_i++;
2681          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
2682                     tmp_ordsgn,v, bits, r->block1[i]);
2683        }
2684        break;
2685
2686      case ringorder_ds:
2687        if (r->block0[i]==r->block1[i])
2688        {
2689          rO_LexVars_neg(j, j_bits,r->block0[i],r->block1[i],prev_ordsgn,
2690                         tmp_ordsgn,v,bits, -1);
2691        }
2692        else
2693        {
2694          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2695                         tmp_typ[typ_i]);
2696          typ_i++;
2697          rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
2698                         prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
2699        }
2700        break;
2701
2702      case ringorder_Ds:
2703        if (r->block0[i]==r->block1[i])
2704        {
2705          rO_LexVars_neg(j, j_bits, r->block0[i],r->block0[i],prev_ordsgn,
2706                         tmp_ordsgn,v, bits, -1);
2707        }
2708        else
2709        {
2710          rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2711                         tmp_typ[typ_i]);
2712          typ_i++;
2713          rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
2714                     tmp_ordsgn,v, bits, r->block1[i]);
2715        }
2716        break;
2717
2718      case ringorder_wp:
2719        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2720                   tmp_typ[typ_i], r->wvhdl[i]);
2721        typ_i++;
2722        if (r->block1[i]!=r->block0[i])
2723        {
2724          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
2725                         tmp_ordsgn, v,bits, r->block0[i]);
2726        }
2727        break;
2728
2729      case ringorder_Wp:
2730        rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2731                   tmp_typ[typ_i], r->wvhdl[i]);
2732        typ_i++;
2733        if (r->block1[i]!=r->block0[i])
2734        {
2735          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
2736                     tmp_ordsgn,v, bits, r->block1[i]);
2737        }
2738        break;
2739
2740      case ringorder_ws:
2741        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2742                       tmp_typ[typ_i], r->wvhdl[i]);
2743        typ_i++;
2744        if (r->block1[i]!=r->block0[i])
2745        {
2746          rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
2747                         tmp_ordsgn, v,bits, r->block0[i]);
2748        }
2749        break;
2750
2751      case ringorder_Ws:
2752        rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
2753                       tmp_typ[typ_i], r->wvhdl[i]);
2754        typ_i++;
2755        if (r->block1[i]!=r->block0[i])
2756        {
2757          rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
2758                     tmp_ordsgn,v, bits, r->block1[i]);
2759        }
2760        break;
2761
2762      case ringorder_S:
2763        rO_Syzcomp(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2764        need_to_add_comp=TRUE;
2765        typ_i++;
2766        break;
2767
2768      case ringorder_s:
2769        rO_Syz(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
2770        need_to_add_comp=TRUE;
2771        typ_i++;
2772        break;
2773
2774      case ringorder_unspec:
2775      case ringorder_no:
2776      default:
2777        dReportError("undef. ringorder used\n");
2778        break;
2779    }
2780  }
2781
2782  int j0=j; // save j
2783  int j_bits0=j_bits; // save jbits
2784  rO_Align(j,j_bits);
2785  r->CmpL_Size = j;
2786
2787  j_bits=j_bits0; j=j0;
2788
2789  // fill in some empty slots with variables not already covered
2790  // v0 is special, is therefore normally already covered
2791  // now we do have rings without comp...
2792  if((need_to_add_comp) && (v[0]== -1))
2793  {
2794    if (prev_ordsgn==1)
2795    {
2796      rO_Align(j, j_bits);
2797      rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
2798    }
2799    else
2800    {
2801      rO_Align(j, j_bits);
2802      rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
2803    }
2804  }
2805  // the variables
2806  for(i=1 ; i<r->N+1 ; i++)
2807  {
2808    if(v[i]==(-1))
2809    {
2810      if (prev_ordsgn==1)
2811      {
2812        rO_LexVars(j, j_bits, i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
2813      }
2814      else
2815      {
2816        rO_LexVars_neg(j,j_bits,i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
2817      }
2818    }
2819  }
2820
2821  rO_Align(j,j_bits);
2822  // ----------------------------
2823  // finished with constructing the monomial, computing sizes:
2824
2825  r->ExpL_Size=j;
2826  r->PolyBin = omGetSpecBin(POLYSIZE + (r->ExpL_Size)*sizeof(long));
2827  assume(r->PolyBin != NULL);
2828
2829  // ----------------------------
2830  // indices and ordsgn vector for comparison
2831  //
2832  // r->pCompHighIndex already set
2833  r->ordsgn=(long *)omAlloc0(r->ExpL_Size*sizeof(long));
2834
2835  for(j=0;j<r->CmpL_Size;j++)
2836  {
2837    r->ordsgn[j] = tmp_ordsgn[j];
2838  }
2839
2840  omFreeSize((ADDRESS)tmp_ordsgn,(2*(n+r->N)*sizeof(long)));
2841
2842  // ----------------------------
2843  // description of orderings for setm:
2844  //
2845  r->OrdSize=typ_i;
2846  if (typ_i==0) r->typ=NULL;
2847  else
2848  {
2849    r->typ=(sro_ord*)omAlloc(typ_i*sizeof(sro_ord));
2850    memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
2851  }
2852  omFreeSize((ADDRESS)tmp_typ,(2*(n+r->N)*sizeof(sro_ord)));
2853
2854  // ----------------------------
2855  // indices for (first copy of ) variable entries in exp.e vector (VarOffset):
2856  r->VarOffset=v;
2857
2858  // ----------------------------
2859  // other indicies
2860  r->pCompIndex=(r->VarOffset[0] & 0xffff); //r->VarOffset[0];
2861  i=0; // position
2862  j=0; // index in r->typ
2863  if (i==r->pCompIndex) i++;
2864  while ((j < r->OrdSize)
2865         && ((r->typ[j].ord_typ==ro_syzcomp) ||
2866             (r->typ[j].ord_typ==ro_syz) ||
2867             (r->order[r->typ[j].order_index] == ringorder_aa)))
2868  {
2869    i++; j++;
2870  }
2871  if (i==r->pCompIndex) i++;
2872  r->pOrdIndex=i;
2873
2874  // ----------------------------
2875  rSetDegStuff(r);
2876  rSetOption(r);
2877  // ----------------------------
2878  // r->p_Setm
2879  r->p_Setm = p_GetSetmProc(r);
2880
2881  // ----------------------------
2882  // set VarL_*
2883  rSetVarL(r);
2884
2885  //  ----------------------------
2886  // right-adjust VarOffset
2887  rRightAdjustVarOffset(r);
2888
2889  // ----------------------------
2890  // set NegWeightL*
2891  rSetNegWeight(r);
2892
2893  // ----------------------------
2894  // p_Procs: call AFTER NegWeightL
2895  r->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
2896  p_ProcsSet(r, r->p_Procs);
2897
2898  return FALSE;
2899}
2900
2901void rUnComplete(ring r)
2902{
2903  if (r == NULL) return;
2904  if (r->VarOffset != NULL)
2905  {
2906    if (r->PolyBin != NULL)
2907      omUnGetSpecBin(&(r->PolyBin));
2908
2909    omFreeSize((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
2910    if (r->order != NULL)
2911    {
2912      if (r->order[0] == ringorder_s && r->typ[0].data.syz.limit > 0)
2913      {
2914        omFreeSize(r->typ[0].data.syz.syz_index,
2915             (r->typ[0].data.syz.limit +1)*sizeof(int));
2916      }
2917    }
2918    if (r->OrdSize!=0 && r->typ != NULL)
2919    {
2920      omFreeSize((ADDRESS)r->typ,r->OrdSize*sizeof(sro_ord));
2921    }
2922    if (r->ordsgn != NULL && r->CmpL_Size != 0)
2923      omFreeSize((ADDRESS)r->ordsgn,r->ExpL_Size*sizeof(long));
2924    if (r->p_Procs != NULL)
2925      omFreeSize(r->p_Procs, sizeof(p_Procs_s));
2926    omfreeSize(r->VarL_Offset, r->VarL_Size*sizeof(int));
2927  }
2928  if (r->NegWeightL_Offset!=NULL)
2929  {
2930    omFreeSize(r->NegWeightL_Offset, r->NegWeightL_Size*sizeof(int));
2931    r->NegWeightL_Offset=NULL;
2932  }
2933}
2934
2935// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
2936static void rSetVarL(ring r)
2937{
2938  int  min = INT_MAX, min_j = -1;
2939  int* VarL_Number = (int*) omAlloc0(r->ExpL_Size*sizeof(int));
2940
2941  int i,j;
2942
2943  // count how often a var long is occupied by an exponent
2944  for (i=1; i<=r->N; i++)
2945  {
2946    VarL_Number[r->VarOffset[i] & 0xffffff]++;
2947  }
2948
2949  // determine how many and min
2950  for (i=0, j=0; i<r->ExpL_Size; i++)
2951  {
2952    if (VarL_Number[i] != 0)
2953    {
2954      if (min > VarL_Number[i])
2955      {
2956        min = VarL_Number[i];
2957        min_j = j;
2958      }
2959      j++;
2960    }
2961  }
2962
2963  r->VarL_Size = j;
2964  r->VarL_Offset = (int*) omAlloc(r->VarL_Size*sizeof(int));
2965  r->VarL_LowIndex = 0;
2966
2967  // set VarL_Offset
2968  for (i=0, j=0; i<r->ExpL_Size; i++)
2969  {
2970    if (VarL_Number[i] != 0)
2971    {
2972      r->VarL_Offset[j] = i;
2973      if (j > 0 && r->VarL_Offset[j-1] != r->VarL_Offset[j] - 1)
2974        r->VarL_LowIndex = -1;
2975      j++;
2976    }
2977  }
2978  if (r->VarL_LowIndex >= 0)
2979    r->VarL_LowIndex = r->VarL_Offset[0];
2980
2981  r->MinExpPerLong = min;
2982  if (min_j != 0)
2983  {
2984    j = r->VarL_Offset[min_j];
2985    r->VarL_Offset[min_j] = r->VarL_Offset[0];
2986    r->VarL_Offset[0] = j;
2987  }
2988  omFree(VarL_Number);
2989}
2990
2991static void rRightAdjustVarOffset(ring r)
2992{
2993  int* shifts = (int*) omAlloc(r->ExpL_Size*sizeof(int));
2994  int i;
2995  // initialize shifts
2996  for (i=0;i<r->ExpL_Size;i++)
2997    shifts[i] = BIT_SIZEOF_LONG;
2998
2999  // find minimal bit in each long var
3000  for (i=1;i<=r->N;i++)
3001  {
3002    if (shifts[r->VarOffset[i] & 0xffffff] > r->VarOffset[i] >> 24)
3003      shifts[r->VarOffset[i] & 0xffffff] = r->VarOffset[i] >> 24;
3004  }
3005  // reset r->VarOffset
3006  for (i=1;i<=r->N;i++)
3007  {
3008    if (shifts[r->VarOffset[i] & 0xffffff] != 0)
3009      r->VarOffset[i]
3010        = (r->VarOffset[i] & 0xffffff) |
3011        (((r->VarOffset[i] >> 24) - shifts[r->VarOffset[i] & 0xffffff]) << 24);
3012  }
3013  omFree(shifts);
3014}
3015
3016// get r->divmask depending on bits per exponent
3017static unsigned long rGetDivMask(int bits)
3018{
3019  unsigned long divmask = 1;
3020  int i = bits;
3021
3022  while (i < BIT_SIZEOF_LONG)
3023  {
3024    divmask |= (((unsigned long) 1) << (unsigned long) i);
3025    i += bits;
3026  }
3027  return divmask;
3028}
3029
3030#ifdef RDEBUG
3031void rDebugPrint(ring r)
3032{
3033  if (r==NULL)
3034  {
3035    PrintS("NULL ?\n");
3036    return;
3037  }
3038  char *TYP[]={"ro_dp","ro_wp","ro_wp_neg","ro_cp",
3039               "ro_syzcomp", "ro_syz", "ro_none"};
3040  int i,j;
3041
3042  Print("ExpL_Size:%d ",r->ExpL_Size);
3043  Print("CmpL_Size:%d ",r->CmpL_Size);
3044  Print("VarL_Size:%d\n",r->VarL_Size);
3045  Print("bitmask=0x%x (expbound=%d) \n",r->bitmask, r->bitmask);
3046  Print("BitsPerExp=%d ExpPerLong=%d MinExpPerLong=%d at L[%d]\n", r->BitsPerExp, r->ExpPerLong, r->MinExpPerLong, r->VarL_Offset[0]);
3047  PrintS("varoffset:\n");
3048  if (r->VarOffset==NULL) PrintS(" NULL\n");
3049  else
3050    for(j=0;j<=r->N;j++)
3051      Print("  v%d at e-pos %d, bit %d\n",
3052            j,r->VarOffset[j] & 0xffffff, r->VarOffset[j] >>24);
3053  Print("divmask=%p\n", r->divmask);
3054  PrintS("ordsgn:\n");
3055  for(j=0;j<r->CmpL_Size;j++)
3056    Print("  ordsgn %d at pos %d\n",r->ordsgn[j],j);
3057  Print("OrdSgn:%d\n",r->OrdSgn);
3058  PrintS("ordrec:\n");
3059  for(j=0;j<r->OrdSize;j++)
3060  {
3061    Print("  typ %s",TYP[r->typ[j].ord_typ]);
3062    Print("  place %d",r->typ[j].data.dp.place);
3063    if (r->typ[j].ord_typ!=ro_syzcomp)
3064    {
3065      Print("  start %d",r->typ[j].data.dp.start);
3066      Print("  end %d",r->typ[j].data.dp.end);
3067      if ((r->typ[j].ord_typ==ro_wp)
3068      || (r->typ[j].ord_typ==ro_wp_neg))
3069      {
3070        Print(" w:");
3071        int l;
3072        for(l=r->typ[j].data.wp.start;l<=r->typ[j].data.wp.end;l++)
3073          Print(" %d",r->typ[j].data.wp.weights[l-r->typ[j].data.wp.start]);
3074      }
3075    }
3076    PrintLn();
3077  }
3078  Print("pOrdIndex:%d pCompIndex:%d\n", r->pOrdIndex, r->pCompIndex);
3079  Print("OrdSize:%d\n",r->OrdSize);
3080  PrintS("--------------------\n");
3081  for(j=0;j<r->ExpL_Size;j++)
3082  {
3083    Print("L[%d]: ",j);
3084    if (j< r->CmpL_Size)
3085      Print("ordsgn %d ", r->ordsgn[j]);
3086    else
3087      PrintS("no comp ");
3088    i=1;
3089    for(;i<=r->N;i++)
3090    {
3091      if( (r->VarOffset[i] & 0xffffff) == j )
3092      {  Print("v%d at e[%d], bit %d; ", i,r->VarOffset[i] & 0xffffff,
3093                                         r->VarOffset[i] >>24 ); }
3094    }
3095    if( r->pCompIndex==j ) PrintS("v0; ");
3096    for(i=0;i<r->OrdSize;i++)
3097    {
3098      if (r->typ[i].data.dp.place == j)
3099      {
3100        Print("ordrec:%s (start:%d, end:%d) ",TYP[r->typ[i].ord_typ],
3101          r->typ[i].data.dp.start, r->typ[i].data.dp.end);
3102      }
3103    }
3104
3105    if (j==r->pOrdIndex)
3106      PrintS("pOrdIndex\n");
3107    else
3108      PrintLn();
3109  }
3110
3111  // p_Procs stuff
3112  p_Procs_s proc_names;
3113  char* field;
3114  char* length;
3115  char* ord;
3116  p_Debug_GetProcNames(r, &proc_names);
3117  p_Debug_GetSpecNames(r, field, length, ord);
3118
3119  Print("p_Spec  : %s, %s, %s\n", field, length, ord);
3120  PrintS("p_Procs :\n");
3121  for (i=0; i<(int) (sizeof(p_Procs_s)/sizeof(void*)); i++)
3122  {
3123    Print(" %s,\n", ((char**) &proc_names)[i]);
3124  }
3125}
3126
3127void pDebugPrintR(poly p, ring r)
3128{
3129  int i,j;
3130  pWrite(p);
3131  j=2;
3132  while(p!=NULL)
3133  {
3134    Print("\nexp[0..%d]\n",r->ExpL_Size-1);
3135    for(i=0;i<r->ExpL_Size;i++)
3136      Print("%d ",p->exp[i]);
3137    PrintLn();
3138    Print("v0:%d ",p_GetComp(p, r));
3139    for(i=1;i<=r->N;i++) Print(" v%d:%d",i,p_GetExp(p,i, r));
3140    PrintLn();
3141    pIter(p);
3142    j--;
3143    if (j==0) { PrintS("...\n"); break; }
3144  }
3145}
3146
3147void pDebugPrint(poly p)
3148{
3149  pDebugPrintR(p, currRing);
3150}
3151#endif // RDEBUG
3152
3153
3154/*2
3155* asssume that rComplete was called with r
3156* assume that the first block ist ringorder_S
3157* change the block to reflect the sequence given by appending v
3158*/
3159
3160#ifdef PDEBUG
3161void rDBChangeSComps(int* currComponents,
3162                     long* currShiftedComponents,
3163                     int length,
3164                     ring r)
3165{
3166  r->typ[1].data.syzcomp.length = length;
3167  rNChangeSComps( currComponents, currShiftedComponents, r);
3168}
3169void rDBGetSComps(int** currComponents,
3170                 long** currShiftedComponents,
3171                 int *length,
3172                 ring r)
3173{
3174  *length = r->typ[1].data.syzcomp.length;
3175  rNGetSComps( currComponents, currShiftedComponents, r);
3176}
3177#endif
3178
3179void rNChangeSComps(int* currComponents, long* currShiftedComponents, ring r)
3180{
3181  assume(r->order[1]==ringorder_S);
3182
3183  r->typ[1].data.syzcomp.ShiftedComponents = currShiftedComponents;
3184  r->typ[1].data.syzcomp.Components = currComponents;
3185}
3186
3187void rNGetSComps(int** currComponents, long** currShiftedComponents, ring r)
3188{
3189  assume(r->order[1]==ringorder_S);
3190
3191  *currShiftedComponents = r->typ[1].data.syzcomp.ShiftedComponents;
3192  *currComponents =   r->typ[1].data.syzcomp.Components;
3193}
3194
3195/////////////////////////////////////////////////////////////////////////////
3196//
3197// The following routines all take as input a ring r, and return R
3198// where R has a certain property. P might be equal r in which case r
3199// had already this property
3200//
3201// Without argument, these functions work on currRing and change it,
3202// if necessary
3203
3204// for the time being, this is still here
3205static ring rAssure_SyzComp(ring r, BOOLEAN complete = TRUE);
3206
3207ring rCurrRingAssure_SyzComp()
3208{
3209  ring r = rAssure_SyzComp(currRing);
3210  if (r != currRing)
3211  {
3212    ring old_ring = currRing;
3213    rChangeCurrRing(r);
3214    if (old_ring->qideal != NULL)
3215    {
3216      r->qideal = idrCopyR_NoSort(old_ring->qideal, old_ring);
3217      assume(idRankFreeModule(r->qideal) == 0);
3218      currQuotient = r->qideal;
3219    }
3220  }
3221  return r;
3222}
3223
3224static ring rAssure_SyzComp(ring r, BOOLEAN complete)
3225{
3226  if (r->order[0] == ringorder_s) return r;
3227  ring res=rCopy0(r, FALSE, FALSE);
3228  int i=rBlocks(r);
3229  int j;
3230
3231  res->order=(int *)omAlloc0((i+1)*sizeof(int));
3232  for(j=i;j>0;j--) res->order[j]=r->order[j-1];
3233  res->order[0]=ringorder_s;
3234
3235  res->block0=(int *)omAlloc0((i+1)*sizeof(int));
3236  for(j=i;j>0;j--) res->block0[j]=r->block0[j-1];
3237
3238  res->block1=(int *)omAlloc0((i+1)*sizeof(int));
3239  for(j=i;j>0;j--) res->block1[j]=r->block1[j-1];
3240
3241  int ** wvhdl =(int **)omAlloc0((i+1)*sizeof(int**));
3242  for(j=i;j>0;j--)
3243  {
3244    if (r->wvhdl[j-1] != NULL)
3245    {
3246      wvhdl[j] = (int*) omMemDup(r->wvhdl[j-1]);
3247    }
3248  }
3249  res->wvhdl = wvhdl;
3250
3251  if (complete) rComplete(res, 1);
3252  return res;
3253}
3254
3255static ring rAssure_CompLastBlock(ring r, BOOLEAN complete = TRUE)
3256{
3257  int last_block = rBlocks(r) - 2;
3258  if (r->order[last_block] != ringorder_c &&
3259      r->order[last_block] != ringorder_C)
3260  {
3261    int c_pos = 0;
3262    int i;
3263
3264    for (i=0; i< last_block; i++)
3265    {
3266      if (r->order[i] == ringorder_c || r->order[i] == ringorder_C)
3267      {
3268        c_pos = i;
3269        break;
3270      }
3271    }
3272    if (c_pos != -1)
3273    {
3274      ring new_r = rCopy0(r, FALSE, TRUE);
3275      for (i=c_pos+1; i<=last_block; i++)
3276      {
3277        new_r->order[i-1] = new_r->order[i];
3278        new_r->block0[i-1] = new_r->block0[i];
3279        new_r->block1[i-1] = new_r->block1[i];
3280        new_r->wvhdl[i-1] = new_r->wvhdl[i];
3281      }
3282      new_r->order[last_block] = r->order[c_pos];
3283      new_r->block0[last_block] = r->block0[c_pos];
3284      new_r->block1[last_block] = r->block1[c_pos];
3285      new_r->wvhdl[last_block] = r->wvhdl[c_pos];
3286      if (complete) rComplete(new_r, 1);
3287      return new_r;
3288    }
3289  }
3290  return r;
3291}
3292
3293ring rCurrRingAssure_CompLastBlock()
3294{
3295  ring new_r = rAssure_CompLastBlock(currRing);
3296  if (currRing != new_r)
3297  {
3298    ring old_r = currRing;
3299    rChangeCurrRing(new_r);
3300    if (old_r->qideal != NULL)
3301    {
3302      new_r->qideal = idrCopyR(old_r->qideal, old_r);
3303      currQuotient = new_r->qideal;
3304    }
3305  }
3306  return new_r;
3307}
3308
3309ring rCurrRingAssure_SyzComp_CompLastBlock()
3310{
3311  ring new_r_1 = rAssure_CompLastBlock(currRing, FALSE);
3312  ring new_r = rAssure_SyzComp(new_r_1, FALSE);
3313
3314  if (new_r != currRing)
3315  {
3316    ring old_r = currRing;
3317    if (new_r_1 != new_r && new_r_1 != old_r) rDelete(new_r_1);
3318    rComplete(new_r, 1);
3319    rChangeCurrRing(new_r);
3320    if (old_r->qideal != NULL)
3321    {
3322      new_r->qideal = idrCopyR(old_r->qideal, old_r);
3323      currQuotient = new_r->qideal;
3324    }
3325    rTest(new_r);
3326    rTest(old_r);
3327  }
3328  return new_r;
3329}
3330
3331// use this for global orderings consisting of two blocks
3332static ring rCurrRingAssure_Global(rRingOrder_t b1, rRingOrder_t b2)
3333{
3334  int r_blocks = rBlocks(currRing);
3335  int i;
3336
3337  assume(b1 == ringorder_c || b1 == ringorder_C ||
3338         b2 == ringorder_c || b2 == ringorder_C ||
3339         b2 == ringorder_S);
3340  if ((r_blocks == 3) &&
3341      (currRing->order[0] == b1) &&
3342      (currRing->order[1] == b2) &&
3343      (currRing->order[2] == 0))
3344    return currRing;
3345  ring res = rCopy0(currRing, TRUE, FALSE);
3346  res->order = (int*)omAlloc0(3*sizeof(int));
3347  res->block0 = (int*)omAlloc0(3*sizeof(int));
3348  res->block1 = (int*)omAlloc0(3*sizeof(int));
3349  res->wvhdl = (int**)omAlloc0(3*sizeof(int*));
3350  res->order[0] = b1;
3351  res->order[1] = b2;
3352  if (b1 == ringorder_c || b1 == ringorder_C)
3353  {
3354    res->block0[1] = 1;
3355    res->block1[1] = currRing->N;
3356  }
3357  else
3358  {
3359    res->block0[0] = 1;
3360    res->block1[0] = currRing->N;
3361  }
3362  // HANNES: This sould be set in rComplete
3363  res->OrdSgn = 1;
3364  rComplete(res, 1);
3365  rChangeCurrRing(res);
3366  return res;
3367}
3368
3369
3370ring rCurrRingAssure_dp_S()
3371{
3372  return rCurrRingAssure_Global(ringorder_dp, ringorder_S);
3373}
3374
3375ring rCurrRingAssure_dp_C()
3376{
3377  return rCurrRingAssure_Global(ringorder_dp, ringorder_C);
3378}
3379
3380ring rCurrRingAssure_C_dp()
3381{
3382  return rCurrRingAssure_Global(ringorder_C, ringorder_dp);
3383}
3384
3385
3386void rSetSyzComp(int k)
3387{
3388  if (TEST_OPT_PROT) Print("{%d}", k);
3389  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz))
3390  {
3391    assume(k > currRing->typ[0].data.syz.limit);
3392    int i;
3393    if (currRing->typ[0].data.syz.limit == 0)
3394    {
3395      currRing->typ[0].data.syz.syz_index = (int*) omAlloc0((k+1)*sizeof(int));
3396      currRing->typ[0].data.syz.syz_index[0] = 0;
3397      currRing->typ[0].data.syz.curr_index = 1;
3398    }
3399    else
3400    {
3401      currRing->typ[0].data.syz.syz_index = (int*)
3402        omReallocSize(currRing->typ[0].data.syz.syz_index,
3403                (currRing->typ[0].data.syz.limit+1)*sizeof(int),
3404                (k+1)*sizeof(int));
3405    }
3406    for (i=currRing->typ[0].data.syz.limit + 1; i<= k; i++)
3407    {
3408      currRing->typ[0].data.syz.syz_index[i] =
3409        currRing->typ[0].data.syz.curr_index;
3410    }
3411    currRing->typ[0].data.syz.limit = k;
3412    currRing->typ[0].data.syz.curr_index++;
3413  }
3414  else if ((currRing->order[0]!=ringorder_c) && (k!=0))
3415  {
3416    dReportError("syzcomp in incompatible ring");
3417  }
3418#ifdef PDEBUG
3419  extern int pDBsyzComp;
3420  pDBsyzComp=k;
3421#endif
3422}
3423
3424// return the max-comonent wchich has syzIndex i
3425int rGetMaxSyzComp(int i)
3426{
3427  if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz) &&
3428      currRing->typ[0].data.syz.limit > 0 && i > 0)
3429  {
3430    assume(i <= currRing->typ[0].data.syz.limit);
3431    int j;
3432    for (j=0; j<currRing->typ[0].data.syz.limit; j++)
3433    {
3434      if (currRing->typ[0].data.syz.syz_index[j] == i  &&
3435          currRing->typ[0].data.syz.syz_index[j+1] != i)
3436      {
3437        assume(currRing->typ[0].data.syz.syz_index[j+1] == i+1);
3438        return j;
3439      }
3440    }
3441    return currRing->typ[0].data.syz.limit;
3442  }
3443  else
3444  {
3445    return 0;
3446  }
3447}
3448
3449BOOLEAN rRing_is_Homog(ring r)
3450{
3451  if (r == NULL) return FALSE;
3452  int i, j, nb = rBlocks(r);
3453  for (i=0; i<nb; i++)
3454  {
3455    if (r->wvhdl[i] != NULL)
3456    {
3457      int length = r->block1[i] - r->block0[i];
3458      int* wvhdl = r->wvhdl[i];
3459      if (r->order[i] == ringorder_M) length *= length;
3460      assume(omSizeOfAddr(wvhdl) >= length*sizeof(int));
3461
3462      for (j=0; j< length; j++)
3463      {
3464        if (wvhdl[j] != 0 && wvhdl[j] != 1) return FALSE;
3465      }
3466    }
3467  }
3468  return TRUE;
3469}
3470
3471BOOLEAN rRing_has_CompLastBlock(ring r)
3472{
3473  assume(r != NULL);
3474  int lb = rBlocks(r) - 2;
3475  return (r->order[lb] == ringorder_c || r->order[lb] == ringorder_C);
3476}
3477
3478n_coeffType rFieldType(ring r)
3479{
3480  if (rField_is_Zp(r))     return n_Zp;
3481  if (rField_is_Q(r))      return n_Q;
3482  if (rField_is_R(r))      return n_R;
3483  if (rField_is_GF(r))     return n_GF;
3484  if (rField_is_long_R(r)) return n_long_R;
3485  if (rField_is_Zp_a(r))   return n_Zp_a;
3486  if (rField_is_Q_a(r))    return n_Q_a;
3487  if (rField_is_long_C(r)) return n_long_C;
3488  return n_unknown;
3489}
3490
3491int * rGetWeightVec(ring r)
3492{
3493  assume(r!=NULL);
3494  assume(r->OrdSize>0);
3495  assume(r->typ[0].ord_typ==ro_wp);
3496  return (r->typ[0].data.wp.weights);
3497}
3498
3499void rSetWeightVec(ring r, int *wv)
3500{
3501  assume(r!=NULL);
3502  assume(r->OrdSize>0);
3503  assume(r->typ[0].ord_typ==ro_wp);
3504  memcpy(r->typ[0].data.wp.weights,wv,r->N*sizeof(int));
3505}
3506
3507#include <ctype.h>
3508
3509static int rRealloc1(ring r, ring src, int size, int pos)
3510{
3511  r->order=(int*)omReallocSize(r->order, size*sizeof(int), (size+1)*sizeof(int));
3512  r->block0=(int*)omReallocSize(r->block0, size*sizeof(int), (size+1)*sizeof(int));
3513  r->block1=(int*)omReallocSize(r->block1, size*sizeof(int), (size+1)*sizeof(int));
3514  r->wvhdl=(int_ptr*)omReallocSize(r->wvhdl,size*sizeof(int_ptr), (size+1)*sizeof(int_ptr));
3515  for(int k=size; k>pos; k--) r->wvhdl[k]=r->wvhdl[k-1];
3516  r->order[size]=0;
3517  size++;
3518  return size;
3519}
3520static int rReallocM1(ring r, ring src, int size, int pos)
3521{
3522  r->order=(int*)omReallocSize(r->order, size*sizeof(int), (size-1)*sizeof(int));
3523  r->block0=(int*)omReallocSize(r->block0, size*sizeof(int), (size-1)*sizeof(int));
3524  r->block1=(int*)omReallocSize(r->block1, size*sizeof(int), (size-1)*sizeof(int));
3525  r->wvhdl=(int_ptr*)omReallocSize(r->wvhdl,size*sizeof(int_ptr), (size-1)*sizeof(int_ptr));
3526  for(int k=pos+1; k<size; k++) r->wvhdl[k]=r->wvhdl[k+1];
3527  size--;
3528  return size;
3529}
3530static void rOppWeight(int *w, int l)
3531{
3532  int i2=(l+1)/2;
3533  for(int j=0; j<=i2; j++)
3534  {
3535    int t=w[j];
3536    w[j]=w[l-j]; 
3537    w[l-j]=t; 
3538  }
3539}
3540
3541#define rOppVar(R,I) (rVar(R)+1-I)
3542
3543ring rOpposite(ring src)
3544  /* creates an opposite algebra of R */
3545  /* that is R^opp, where f (*^opp) g = g*f  */
3546  /* ignores the case of qring -> done in iparith.cc */
3547{
3548  ring save = currRing; 
3549  ring    r = rCopy0(src,TRUE); /* TRUE for copy the qideal */
3550  // change vars v1..vN -> vN..v1
3551  int i;
3552  int i2 = (rVar(r)-1)/2;
3553  for(i=i2; i>=0; i--)
3554  {
3555    // index: 0..N-1
3556    //Print("ex var names: %d <-> %d\n",i,rOppVar(r,i));
3557    // exchange names
3558    char *p;
3559    p = r->names[rVar(r)-1-i];
3560    r->names[rVar(r)-1-i] = r->names[i];
3561    r->names[i] = p;
3562  }
3563//  i2=(rVar(r)+1)/2;
3564//  for(int i=i2; i>0; i--)
3565//  {
3566//    // index: 1..N
3567//    //Print("ex var places: %d <-> %d\n",i,rVar(r)+1-i);
3568//    // exchange VarOffset
3569//    int t;
3570//    t=r->VarOffset[i];
3571//    r->VarOffset[i]=r->VarOffset[rOppVar(r,i)];
3572//    r->VarOffset[rOppVar(r,i)]=t;
3573//  }
3574  // change names:
3575  for (i=rVar(r)-1; i>=0; i--)
3576  {
3577    char *p=r->names[i];
3578    if(isupper(*p)) *p = tolower(*p);
3579    else            *p = toupper(*p);
3580  }
3581  // change ordering: listing
3582  // change ordering: compare
3583//  for(i=0; i<r->OrdSize; i++)
3584//  {
3585//    int t,tt;
3586//    switch(r->typ[i].ord_typ)
3587//    {
3588//      case ro_dp:
3589//      //
3590//        t=r->typ[i].data.dp.start;
3591//        r->typ[i].data.dp.start=rOppVar(r,r->typ[i].data.dp.end);
3592//        r->typ[i].data.dp.end=rOppVar(r,t);
3593//        break;
3594//      case ro_wp:
3595//      case ro_wp_neg:
3596//      {
3597//        t=r->typ[i].data.wp.start;
3598//        r->typ[i].data.wp.start=rOppVar(r,r->typ[i].data.wp.end);
3599//        r->typ[i].data.wp.end=rOppVar(r,t);
3600//        // invert r->typ[i].data.wp.weights
3601//        rOppWeight(r->typ[i].data.wp.weights,
3602//                   r->typ[i].data.wp.end-r->typ[i].data.wp.start);
3603//        break;
3604//      }
3605//      //case ro_wp64:
3606//      case ro_syzcomp:
3607//      case ro_syz:
3608//         WerrorS("not implemented in rOpposite");
3609//         // should not happen
3610//         break;
3611//
3612//      case ro_cp:
3613//        t=r->typ[i].data.cp.start;
3614//        r->typ[i].data.cp.start=rOppVar(r,r->typ[i].data.cp.end);
3615//        r->typ[i].data.cp.end=rOppVar(r,t);
3616//        break;
3617//      case ro_none:
3618//      default:
3619//       Werror("unknown type in rOpposite(%d)",r->typ[i].ord_typ);
3620//       break;
3621//    }
3622//  }
3623  // Change order/block structures (needed for rPrint, rAdd etc.)
3624  int j=0;
3625  int l=rBlocks(src);
3626  for(i=0; src->order[i]!=0; i++)
3627  {
3628    switch (src->order[i])
3629    {
3630      case ringorder_c: /* c-> c */
3631      case ringorder_C: /* C-> C */
3632      case ringorder_no /*=0*/: /* end-of-block */
3633        r->order[j]=src->order[i];
3634        j++; break;
3635      case ringorder_lp: /* lp -> rp */
3636        r->order[j]=ringorder_rp;
3637        r->block0[j]=rOppVar(r, src->block1[i]);
3638        r->block1[j]=rOppVar(r, src->block0[i]);
3639        break;
3640      case ringorder_rp: /* rp -> lp */
3641        r->order[j]=ringorder_lp;
3642        r->block0[j]=rOppVar(r, src->block1[i]);
3643        r->block1[j]=rOppVar(r, src->block0[i]);
3644        break;
3645      case ringorder_dp: /* dp -> a(1..1),ls */
3646      { 
3647        l=rRealloc1(r,src,l,j);
3648        r->order[j]=ringorder_a;
3649        r->block0[j]=rOppVar(r, src->block1[i]);
3650        r->block1[j]=rOppVar(r, src->block0[i]);
3651        r->wvhdl[j]=(int*)omAlloc((r->block1[j]-r->block0[j]+1)*sizeof(int));
3652        for(int k=r->block0[j]; k<=r->block1[j]; k++)
3653          r->wvhdl[j][k-r->block0[j]]=1;
3654        j++;
3655        r->order[j]=ringorder_ls;
3656        r->block0[j]=rOppVar(r, src->block1[i]);
3657        r->block1[j]=rOppVar(r, src->block0[i]);
3658        j++;
3659        break;
3660      } 
3661      case ringorder_Dp: /* Dp -> a(1..1),rp */
3662      { 
3663        l=rRealloc1(r,src,l,j);
3664        r->order[j]=ringorder_a;
3665        r->block0[j]=rOppVar(r, src->block1[i]);
3666        r->block1[j]=rOppVar(r, src->block0[i]);
3667        r->wvhdl[j]=(int*)omAlloc((r->block1[j]-r->block0[j]+1)*sizeof(int));
3668        for(int k=r->block0[j]; k<=r->block1[j]; k++)
3669          r->wvhdl[j][k-r->block0[j]]=1;
3670        j++;
3671        r->order[j]=ringorder_rp;
3672        r->block0[j]=rOppVar(r, src->block1[i]);
3673        r->block1[j]=rOppVar(r, src->block0[i]);
3674        j++;
3675        break;
3676      } 
3677      case ringorder_wp: /* wp -> a(...),ls */
3678      { 
3679        l=rRealloc1(r,src,l,j);
3680        r->order[j]=ringorder_a;
3681        r->block0[j]=rOppVar(r, src->block1[i]);
3682        r->block1[j]=rOppVar(r, src->block0[i]);
3683        r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=r->wvhdl[j+1]=NULL;
3684        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
3685        j++;
3686        r->order[j]=ringorder_ls;
3687        r->block0[j]=rOppVar(r, src->block1[i]);
3688        r->block1[j]=rOppVar(r, src->block0[i]);
3689        j++;
3690        break;
3691      } 
3692      case ringorder_Wp: /* Wp -> a(...),rp */
3693      { 
3694        l=rRealloc1(r,src,l,j);
3695        r->order[j]=ringorder_a;
3696        r->block0[j]=rOppVar(r, src->block1[i]);
3697        r->block1[j]=rOppVar(r, src->block0[i]);
3698        r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=r->wvhdl[j+1]=NULL;
3699        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
3700        j++;
3701        r->order[j]=ringorder_rp;
3702        r->block0[j]=rOppVar(r, src->block1[i]);
3703        r->block1[j]=rOppVar(r, src->block0[i]);
3704        j++;
3705        break;
3706      } 
3707      case ringorder_M: /* M -> M */
3708      { 
3709        r->order[j]=ringorder_M;
3710        r->block0[j]=rOppVar(r, src->block1[i]);
3711        r->block1[j]=rOppVar(r, src->block0[i]);
3712        int n=r->block1[j]-r->block0[j];
3713        /* M is a (n+1)x(n+1) matrix */
3714        for (int nn=0; nn<=n; nn++)
3715        {
3716          rOppWeight(&(r->wvhdl[j][nn*(n+1)]), n /*r->block1[j]-r->block0[j]*/);
3717        }
3718        j++;
3719        break;
3720      }
3721      case ringorder_a: /*  a(...),ls -> wp/dp */
3722      { 
3723        r->block0[j]=rOppVar(r, src->block1[i]);
3724        r->block1[j]=rOppVar(r, src->block0[i]);
3725        rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
3726        if (src->order[i+1]==ringorder_ls)
3727        {
3728          r->order[j]=ringorder_wp;
3729          i++;
3730          l=rReallocM1(r,src,l,j);
3731        }
3732        else
3733        {
3734          r->order[j]=ringorder_a;
3735        }
3736        j++;
3737        break;
3738      }
3739      // not yet done:
3740      case ringorder_ls:
3741      case ringorder_ds:
3742      case ringorder_Ds:
3743      case ringorder_ws:
3744      case ringorder_Ws:
3745      // should not occur:
3746      case ringorder_S:
3747      case ringorder_s:
3748      case ringorder_aa:
3749      case ringorder_L:
3750      case ringorder_unspec:
3751        Werror("order %s not (yet) supported", rSimpleOrdStr(src->order[i]));
3752        break;
3753    }
3754  } 
3755  rComplete(r);
3756#ifdef RDEBUG
3757  //   rDebugPrint(r);
3758#endif
3759  rTest(r);
3760#ifdef HAVE_PLURAL
3761  /* now, we initialize a non-comm structure on r */
3762  if (!rIsPluralRing(src))
3763  {
3764    return r;
3765  }
3766  {
3767  rChangeCurrRing(r); 
3768  /* basic nc constructions  */
3769  r->nc           = (nc_struct *)omAlloc0(sizeof(nc_struct));
3770  r->nc->ref      = 1; /* in spite of rCopy(src)? */
3771  r->nc->basering = r;
3772  r->nc->type     =  src->nc->type;
3773  int *perm       = (int *)omAlloc0((rVar(r)+1)*sizeof(int));
3774  int *par_perm   = NULL;
3775  nMapFunc nMap   = nSetMap(src);
3776  int j;
3777  int ni,nj;
3778  for(i=1; i<=r->N; i++)
3779  {
3780    perm[i] = rOppVar(r,i);
3781  }
3782  matrix C = mpNew(rVar(r),rVar(r));
3783  matrix D = mpNew(rVar(r),rVar(r));
3784  for (i=1; i< rVar(r); i++)
3785  {
3786    for (j=i+1; j<=rVar(r); j++)
3787    {
3788      ni = r->N +1 - i;
3789      nj = r->N +1 - j; /* i<j ==>   nj < ni */
3790      MATELEM(C,nj,ni) = pPermPoly(MATELEM(src->nc->C,i,j),perm,src,nMap,par_perm,src->P);
3791      MATELEM(D,nj,ni) = pPermPoly(MATELEM(src->nc->D,i,j),perm,src,nMap,par_perm,src->P);
3792    }
3793  }
3794  idTest((ideal)C);
3795  idTest((ideal)D);
3796  r->nc->C = C;
3797  r->nc->D = D;
3798  if (nc_InitMultiplication(r))
3799    WarnS("Error initializing multiplication!");
3800  r->nc->IsSkewConstant =   src->nc->IsSkewConstant;
3801  omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
3802  /* now oppose the qideal for qrings */
3803//   if (r->qideal != NULL)
3804//   {
3805//     idDelete(&(r->qideal));
3806//     r->qideal = idOppose(src, qideal);
3807//   }
3808//   rTest(r);
3809  rChangeCurrRing(save);
3810  }
3811#endif
3812  return r;
3813}
3814
3815ring rEnvelope(ring R)
3816  /* creates an enveloping algebra of R */
3817  /* that is R^e = R \tensor_K R^opp */
3818{
3819  ring Ropp = rOpposite(R);
3820  ring Renv = NULL;
3821  int stat = rSum(R, Ropp, Renv); /* should ignore qideals */
3822  if ( stat <=0 )
3823    WarnS("Error in rEnvelope at rSum");
3824  /* now create the qideal for qrings */
3825//   if (R->qideal != NULL)
3826//   {
3827//     ring save = currRing;
3828//     rChangeCurrRing(Ropp);
3829//     ideal Q = idCopy(R->qideal);
3830//     ideal Qop = idOppose(R,Q);
3831//     rChangeCurrRing(Renv);
3832//     ideal Qenv = idInit(Q->ncols+Qop->ncols,1);
3833//     int i;
3834//     for (i=0; i<= Q->ncols; i++)
3835//     {
3836//       Qenv->m[i] = maIMap(R,Q->m[i]);
3837//     }
3838//     for (i=0; i<= Qop->ncols; i++)
3839//     {
3840//       Qenv->m[Q->ncols+i] = maIMap(Ropp,Qop->m[i]);
3841//     }
3842//     /* should we run twostd on the result? */
3843//     Renv->qideal = Qenv;
3844//     rChangeCurrRing(save);
3845//   }
3846  rTest(Renv);
3847  return Renv;
3848}
Note: See TracBrowser for help on using the repository browser.