source: git/Singular/ring.cc @ 12bb45

fieker-DuValspielwiese
Last change on this file since 12bb45 was 49eeee, checked in by Hans Schönemann <hannes@…>, 26 years ago
* hannes: fixed bug in maps.cc: size of monom is not pMonomSize but mmGetSpecSize() changed header in tesths.cc changed handling of ring changes (polys*.cc ring.cc) git-svn-id: file:///usr/local/Singular/svn/trunk@1462 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 39.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ring.cc,v 1.23 1998-04-24 16:39:26 Singular Exp $ */
5
6/*
7* ABSTRACT - the interpreter related ring operations
8*/
9
10/* includes */
11#include <math.h>
12#include "mod2.h"
13#include "mmemory.h"
14#include "tok.h"
15#include "polys.h"
16#include "numbers.h"
17#include "febase.h"
18#include "ipid.h"
19#include "ipshell.h"
20#include "ipconv.h"
21#include "intvec.h"
22#include "longalg.h"
23#include "ffields.h"
24#include "spolys.h"
25#include "subexpr.h"
26#include "ideals.h"
27#include "lists.h"
28#include "ring.h"
29
30/* global variables */
31#ifdef RDEBUG
32short rNumber=0;
33#endif
34
35/*0 implementation*/
36int rBlocks(ring r)
37{
38  int i=0;
39  while (r->order[i]!=0) i++;
40  return i+1;
41}
42
43// internally changes the gloabl ring and resets the relevant
44// global variables:
45// complete == FALSE : only delete operations are enabled
46// complete == TRUE  : full reset of all variables
47void rChangeCurrRing(ring r, BOOLEAN complete)
48{
49  /*------------ set global ring vars --------------------------------*/
50  currRing = r;
51  currQuotient=NULL;
52  if (r != NULL)
53  {
54
55    if (complete) 
56    {
57      /*------------ set global ring vars --------------------------------*/
58      currQuotient=r->qideal;
59      /*------------ set redTail, except reset by nSetChar or pChangeRing */
60      test |= Sy_bit(OPT_REDTAIL);
61    }
62
63    /*------------ global variables related to coefficients ------------*/
64    nSetChar(r->ch, complete, r->parameter, r->P);
65
66    /*------------ global variables related to polys -------------------*/
67    pSetGlobals(r, complete);
68
69
70    if (complete) 
71    {
72    /*------------ set naMinimalPoly -----------------------------------*/
73      if (r->minpoly!=NULL)
74      {
75        naMinimalPoly=((lnumber)r->minpoly)->z;
76      }
77
78#ifdef DRING
79      pDRING=FALSE;
80      pSDRING=FALSE;
81      if (hasFlag(h,FLAG_DRING)) rDSet();
82#endif // DRING
83
84#ifdef SRING
85      if ((currRing->partN<=currRing->N)
86#ifdef DRING
87          && (!hasFlag(h,FLAG_DRING))
88#endif
89          )
90      {
91        pAltVars=currRing->partN;
92        pSRING=TRUE;
93        pSDRING=TRUE;
94      }
95      else
96      {
97        pAltVars=currRing->N+1;
98      }
99#endif // SRING
100
101    /*------------ set spolys ------------------------------------------*/
102      spSet(r);
103    }
104  }
105}
106
107void rSetHdl(idhdl h, BOOLEAN complete)
108{
109  int i;
110  ring rg = NULL;
111  if (h!=NULL)
112  {
113    rg = IDRING(h);
114    mmTestP((ADDRESS)h,sizeof(idrec));
115    mmTestLP((ADDRESS)IDID(h));
116    mmTestP(rg,sizeof(ip_sring));
117#ifdef MDEBUG
118    i=rBlocks(rg);
119#endif
120    mmTestP(rg->order,i*sizeof(int));
121    mmTestP(rg->block0,i*sizeof(int));
122    mmTestP(rg->block1,i*sizeof(int));
123    mmTestP(rg->wvhdl,i*sizeof(short *));
124  }
125  else complete=FALSE;
126
127  // clean up history
128    if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
129        || ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
130    {
131      sLastPrinted.CleanUp();
132      memset(&sLastPrinted,0,sizeof(sleftv));
133    }
134
135   /*------------ change the global ring -----------------------*/
136  rChangeCurrRing(rg,complete);
137  currRingHdl = h;
138
139    /*------------ set pShortOut -----------------------*/
140  if (complete /*&&(h!=NULL)*/)
141  {
142    #ifdef HAVE_TCL
143    if (tclmode)
144    {
145      PrintTCLS('R',IDID(h));
146      pShortOut=(int)FALSE;
147    }
148    else
149    #endif
150    {
151      pShortOut=(int)TRUE;
152      if ((rg->parameter!=NULL) && (rg->ch<2))
153      {
154        for (i=0;i<rg->P;i++)
155        {
156          if(strlen(rg->parameter[i])>1)
157          {
158            pShortOut=(int)FALSE;
159            break;
160          }
161        }
162      }
163      if (pShortOut)
164      {
165        for (i=(rg->N-1);i>=0;i--)
166        {
167          if(strlen(rg->names[i])>1)
168          {
169            pShortOut=(int)FALSE;
170            break;
171          }
172        }
173      }
174    }
175  }
176
177}
178
179idhdl rDefault(char *s)
180{
181  idhdl tmp=NULL;
182
183  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &idroot);
184  if (tmp==NULL) return NULL;
185
186  if (ppNoether!=NULL) pDelete(&ppNoether);
187  if ((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
188  {
189    sLastPrinted.CleanUp();
190    memset(&sLastPrinted,0,sizeof(sleftv));
191  }
192
193  currRing = IDRING(tmp);
194
195  currRing->ch    = 32003;
196  currRing->N     = 3;
197  /*currRing->P     = 0; Alloc0 in idhdl::set, ipid.cc*/
198#ifdef RDEBUG
199  rNumber++;
200  currRing->no    =rNumber;
201#endif
202#ifdef SRING
203  currRing->partN = 4;
204#endif
205  /*names*/
206  currRing->names = (char **) Alloc(3 * sizeof(char *));
207  currRing->names[0]  = mstrdup("x");
208  currRing->names[1]  = mstrdup("y");
209  currRing->names[2]  = mstrdup("z");
210  /*weights: entries for 3 blocks: NULL*/
211  currRing->wvhdl = (short **)Alloc0(3 * sizeof(short *));
212  /*order: dp,C,0*/
213  currRing->order = (int *) Alloc(3 * sizeof(int *));
214  currRing->block0 = (int *)Alloc(3 * sizeof(int *));
215  currRing->block1 = (int *)Alloc(3 * sizeof(int *));
216  /* ringorder dp for the first block: var 1..3 */
217  currRing->order[0]  = ringorder_dp;
218  currRing->block0[0] = 1;
219  currRing->block1[0] = 3;
220  /* ringorder C for the second block: no vars */
221  currRing->order[1]  = ringorder_C;
222  currRing->block0[1] = 0;
223  currRing->block1[1] = 0;
224  /* the last block: everything is 0 */
225  currRing->order[2]  = 0;
226  currRing->block0[2] = 0;
227  currRing->block1[2] = 0;
228  /*polynomial ring*/
229  currRing->OrdSgn    = 1;
230
231  /* complete ring intializations */
232  rComplete(currRing);
233  rSetHdl(tmp,TRUE);
234  return currRingHdl;
235}
236
237/*2
238 *check intvec, describing the ordering
239 */
240BOOLEAN rCheckIV(intvec *iv)
241{
242  if ((iv->length()!=2)&&(iv->length()!=3))
243  {
244    WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
245    return TRUE;
246  }
247  return FALSE;
248}
249
250static int rTypeOfMatrixOrder(intvec * order)
251{
252  int i=0,j,typ=1;
253  int sz = (int)sqrt((double)(order->length()-2));
254
255  while ((i<sz) && (typ==1))
256  {
257    j=0;
258    while ((j<sz) && ((*order)[j*sz+i+2]==0)) j++;
259    if (j>=sz)
260    {
261      typ = 0;
262      WerrorS("Matrix order not complete");
263    }
264    else if ((*order)[j*sz+i+2]<0)
265      typ = -1;
266    else
267      i++;
268  }
269  return typ;
270}
271
272/*2
273 * define a new ring from the data:
274 *s: name, chr: ch, parameter names (or NULL): pn,
275 *varnames: rv, ordering: ord, typ: typ
276 */
277idhdl rInit(char *s, sleftv* pn, sleftv* rv, sleftv* ord,
278            BOOLEAN isDRing)
279{
280  int ch;
281  if (pn->Typ()==INT_CMD)
282  {
283    ch=(int)pn->Data();
284  }
285  else if (strcmp(pn->name,"real")==0)
286  {
287    ch=-1;
288  }
289  else
290  {
291    pn->CleanUp();
292    rv->CleanUp();
293    ord->CleanUp();
294    return NULL;
295  }
296  pn=pn->next;
297
298  int l, last;
299  int typ = 1;
300  sleftv * sl;
301  idhdl tmp;
302  ip_sring tmpR;
303  BOOLEAN ffChar=FALSE;
304  /*every entry in the new ring is initialized to 0*/
305
306  /* characteristic -----------------------------------------------*/
307  /* input: 0 ch=0 : Q     parameter=NULL    ffChar=FALSE
308   *         0    1 : Q(a,...)        *names         FALSE
309   *         0   -1 : R               NULL           FALSE
310   *         p    p : Fp              NULL           FALSE
311   *         p   -p : Fp(a)           *names         FALSE
312   *         q    q : GF(q=p^n)       *names         TRUE
313   */
314  if (ch!=-1)
315  {
316    if ((ch!=0) &&((ch<2) || (ch > 32003)))
317    {
318      ch=32003;
319    }
320    l=0;
321    if (pn!=NULL)
322    {
323      while ((ch!=fftable[l]) && (fftable[l])) l++;
324      if (fftable[l]==0)
325      {
326        ch = IsPrime(ch);
327      }
328      else
329      {
330        char *m[1]={(char *)sNoName};
331        nfSetChar(ch,m);
332        if(errorreported)
333        {
334          errorreported=0;
335          ch=IsPrime(ch);
336        }
337        else
338        {
339          ffChar=TRUE;
340        }
341      }
342    }
343    else
344    {
345      ch = IsPrime(ch);
346    }
347  }
348  memset(&tmpR,0,sizeof(tmpR));
349
350  tmpR.ch = ch;
351
352  /* parameter -------------------------------------------------------*/
353  sleftv* hs;
354  const char* h;
355
356  if ((pn!=NULL)&& (ffChar||(ch==-1)))
357  {
358    if((ffChar && (pn->next!=NULL))
359       || (ch==-1))
360    {
361      WarnS("too many parameters");
362      if (ffChar) hs=pn->next;
363      else hs=pn;
364      hs->CleanUp();
365      if (ffChar)
366      {
367        pn->next=NULL;
368        Free((ADDRESS)hs,sizeof(sleftv));
369      }
370      else pn=NULL;
371    }
372  }
373  /* a tempory pointer for typ conversion
374   * and for deallocating sleftv*-lists:
375   *  don't deallocate the first but all other entries*/
376
377  if (pn!=NULL)
378  {
379    tmpR.P=pn->listLength();
380    if((ffChar && (tmpR.P>1))
381       || ((ch==-1) && (tmpR.P>0)))
382    {
383      tmpR.P=ffChar; /* GF(q): 1, R: 0 */
384      WarnS("too many parameters");
385      if (ffChar) hs=pn->next;
386      else hs=pn;
387      hs->CleanUp();
388      Free((ADDRESS)hs,sizeof(sleftv));
389      if (ffChar) pn->next=NULL;
390      else pn=NULL;
391    }
392    tmpR.parameter=(char**)Alloc(tmpR.P*sizeof(char *));
393    sl=pn;
394    char** p=tmpR.parameter;
395    while(sl!=NULL)
396    {
397      hs=NULL;
398      h=sl->Name();
399      if ((h==sNoName)&&(sl->Typ()==POLY_CMD))
400      {
401        hs=(leftv)Alloc(sizeof(sleftv));
402        iiConvert(POLY_CMD,ANY_TYPE,-1,sl,hs);
403        sl->next=hs->next;
404        hs->next=NULL;
405        h=hs->Name();
406      }
407      if (h==sNoName)
408      {
409        WerrorS("parameter expected");
410        pn->CleanUp();
411        rv->CleanUp();
412        ord->CleanUp();
413        return NULL;
414      }
415      *p=mstrdup(h);
416      p++;
417      if (hs!=NULL)
418      {
419        hs->CleanUp();
420        Free((ADDRESS)hs,sizeof(sleftv));
421      }
422      hs=sl;
423      sl=sl->next;
424      hs->next=NULL;
425      hs->CleanUp();
426      if (hs!=pn) Free((ADDRESS)hs,sizeof(sleftv));
427    }
428    if ((ch>1) && /*(pn!=NULL) &&*/ (!ffChar)) tmpR.ch=-tmpR.ch;
429    if (ch==0) tmpR.ch=1;
430  }
431
432  /* names and number of variables-------------------------------------*/
433  {
434    int i, n;
435    sl = rv;
436#ifdef DRING
437    char *tmpname=NULL;
438#endif
439    n=rv->listLength();
440    tmpR.N = n;
441#ifdef SDRING
442    tmpR.partN=n+1-isDRing; // set to N+1 for SRING, N for DRING
443      if (isDRing) n=2*n+1;
444#endif
445    tmpR.N = n;
446    tmpR.names   = (char **)Alloc(n * sizeof(char *));
447    for (sl=rv, i=0; i<n; i++)
448    {
449      hs=NULL;
450#ifdef DRING
451      if (sl==NULL)
452      {
453        if (i==tmpR.N-1)
454          tmpname=mstrdup("");
455        else
456        {
457          tmpname=(char*)AllocL(strlen(tmpR.names[i-tmpR.partN])+2);
458          strcpy(tmpname,"d");
459          strcat(tmpname,tmpR.names[i-tmpR.partN]);
460        }
461        h=tmpname;
462      }
463      else
464#endif
465        h=sl->Name();
466      if ((h==sNoName)&&(sl->Typ()==POLY_CMD))
467      {
468        hs=(leftv)Alloc(sizeof(sleftv));
469        iiConvert(POLY_CMD,ANY_TYPE,-1,sl,hs);
470        sl->next=hs->next;
471        hs->next=NULL;
472        h=hs->Name();
473      }
474      if (h==sNoName)
475      {
476        WerrorS("expected name of ring variable");
477        sl->CleanUp();
478        ord->CleanUp();
479        return NULL;
480      }
481      tmpR.names[i] = mstrdup(h);
482      if (hs!=NULL)
483      {
484        hs->CleanUp();
485        Free((ADDRESS)hs,sizeof(sleftv));
486      }
487      hs=sl;
488#ifdef DRING
489      if (sl!=NULL)
490      {
491#endif
492        sl=sl->next;
493        hs->next=NULL;
494        hs->CleanUp();
495        if (hs!=rv) Free((ADDRESS)hs,sizeof(sleftv));
496#ifdef DRING
497      }
498      if (tmpname!=NULL)
499      {
500        FreeL((ADDRESS)tmpname);
501        tmpname=NULL;
502      }
503#endif
504    }
505
506    /* ordering -------------------------------------------------------------*/
507    sl = ord;
508    /* the number of orderings*/
509    n = 1; i=0;
510    int o=0;
511    while (sl!=NULL)
512    {
513      intvec *iv = (intvec *)(sl->data);
514      if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C)) i++;
515      else if ((*iv)[1]!=ringorder_a) o++;
516      n++;
517      sl=sl->next;
518    }
519    if (o==0)
520    {
521      WerrorS("invalid combination of orderings");
522      ord->CleanUp();
523      return NULL;
524    }
525    if (i==0) n++;
526    else if (i!=1)
527      WarnS("more than one ordering c/C -- ignored");
528
529    /* allocating */
530    tmpR.order=(int *)Alloc0(n*sizeof(int));
531    tmpR.block0=(int *)Alloc0(n*sizeof(int));
532    tmpR.block1=(int *)Alloc0(n*sizeof(int));
533    tmpR.wvhdl=(short**)Alloc0(n*sizeof(short*));
534
535    /* init orders */
536    sl=ord;
537    n=0;
538    last=0;
539    while (sl!=NULL)
540    {
541      intvec *iv;
542      iv = (intvec *)(sl->data);
543
544      /* the format of an ordering:
545       *  iv[0]: factor
546       *  iv[1]: ordering
547       *  iv[2..end]: weights
548       */
549      tmpR.order[n] = (*iv)[1];
550      switch ((*iv)[1])
551      {
552      case ringorder_ws:
553      case ringorder_Ws:
554        typ=-1;
555      case ringorder_wp:
556      case ringorder_Wp:
557        tmpR.wvhdl[n]=(short*)AllocL((iv->length()-1)*sizeof(short));
558        for (l=2;l<iv->length();l++)
559          tmpR.wvhdl[n][l-2]=(short)(*iv)[l];
560        tmpR.block0[n]=last+1;
561        last+=iv->length()-2;
562        tmpR.block1[n]=last;
563        break;
564      case ringorder_ls:
565      case ringorder_ds:
566      case ringorder_Ds:
567        typ=-1;
568      case ringorder_lp:
569      case ringorder_dp:
570      case ringorder_Dp:
571        tmpR.block0[n]=last+1;
572        //last+=(*iv)[0];
573        if (iv->length()==3) last+=(*iv)[2];
574        else last+=(*iv)[0];
575        tmpR.block1[n]=last;
576        if (rCheckIV(iv)) return NULL;
577        break;
578      case ringorder_c:
579      case ringorder_C:
580        if (rCheckIV(iv)) return NULL;
581        break;
582      case ringorder_a:
583        tmpR.block0[n]=last+1;
584        tmpR.block1[n]=last+iv->length()-2;
585        tmpR.wvhdl[n]=(short*)AllocL((iv->length()-1)*sizeof(short));
586        for (l=2;l<iv->length();l++)
587        {
588          tmpR.wvhdl[n][l-2]=(short)(*iv)[l];
589          if ((*iv)[l]<0) typ=-1;
590        }
591        break;
592      case ringorder_M:
593        {
594          int Mtyp=rTypeOfMatrixOrder(iv);
595          if (Mtyp==0) return NULL;
596          if (Mtyp==-1) typ=-1;
597          tmpR.wvhdl[n]=(short*)AllocL((iv->length()-1)*sizeof(short));
598          for (l=2;l<iv->length();l++)
599            tmpR.wvhdl[n][l-2]=(short)(*iv)[l];
600          tmpR.block0[n]=last+1;
601          last+=(int)sqrt((double)(iv->length()-2));
602          tmpR.block1[n]=last;
603          break;
604        }
605#ifdef TEST
606      default:
607        Print("order ??? %d\n",(*iv)[1]);
608        break;
609#endif
610      }
611      sl=sl->next;
612      n++;
613    }
614    ord->CleanUp();
615    if (i==0)
616    {
617      /*there is no c/C-ordering, so append it at the end*/
618      tmpR.order[n]=ringorder_C;
619    }
620    else n--;
621    while ((tmpR.order[n]==ringorder_c)
622           ||(tmpR.order[n]==ringorder_C))
623      n--;
624    if (tmpR.block1[n]!=tmpR.N)
625    {
626      if ((tmpR.order[n]==ringorder_dp) ||
627          (tmpR.order[n]==ringorder_ds) ||
628          (tmpR.order[n]==ringorder_Dp) ||
629          (tmpR.order[n]==ringorder_Ds) ||
630          (tmpR.order[n]==ringorder_lp) ||
631          (tmpR.order[n]==ringorder_ls))
632      {
633        tmpR.block1[n]=tmpR.N;
634        if (tmpR.block0[n]>tmpR.N/*tmpR.block1[n]*/)
635        {
636          tmpR.block1[n]=tmpR.block0[n];
637          goto ord_mismatch;
638          //Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
639          //  tmpR.N,tmpR.block0[n]);
640          //return NULL;
641        }
642      }
643      else
644      {
645      ord_mismatch:
646        Werror("mismatch of number of vars (%d) and ordering (%d vars)",
647               tmpR.N,tmpR.block1[n]);
648        return NULL;
649      }
650    }
651  }
652  tmpR.OrdSgn = typ;
653  // Complete the initialization
654  rComplete(&tmpR);
655  /* try to enter the ring into the name list*/
656  if ((tmp = enterid(s, myynest, RING_CMD, &idroot))==NULL)
657  {
658    return NULL;
659  }
660
661  memcpy(IDRING(tmp),&tmpR,sizeof(tmpR));
662  rSetHdl(tmp,TRUE);
663
664#ifdef RDEBUG
665  rNumber++;
666  currRing->no    =rNumber;
667#endif
668
669  return currRingHdl;
670}
671
672// set those fields of the ring, which can be computed from other fields:
673// More particularly, sets r->VarOffset
674
675void rComplete(ring r)
676{
677  int VarCompIndex, VarOffset, dummy;
678  pGetVarIndicies(r, VarOffset, VarCompIndex, dummy, dummy);
679  r->VarOffset = (short) VarOffset;
680  r->VarCompIndex = (short) VarCompIndex;
681}
682
683/*2
684 * set a new ring from the data:
685 s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
686 */
687#ifdef DRING
688void rDSet()
689{
690  pDRING=TRUE;
691  pSDRING=TRUE;
692  pdN=currRing->partN;
693  pdK=pVariables-pdN*2-1;
694}
695#endif
696
697int rIsRingVar(char *n)
698{
699  if ((currRing!=NULL) && (currRing->names!=NULL))
700  {
701    for (int i=0; i<currRing->N; i++)
702    {
703      if (currRing->names[i]==NULL) return -1;
704      if (strcmp(n,currRing->names[i]) == 0) return (int)i;
705    }
706  }
707  return -1;
708}
709
710char* RingVar(short i)
711{
712  return currRing->names[i];
713}
714
715void rWrite(ring r)
716{
717  if ((r==NULL)||(r->order==NULL))
718    return; /*to avoid printing after errors....*/
719
720  int nblocks=rBlocks(r);
721
722  mmTestP(r,sizeof(ip_sring));
723  mmTestP(r->order,nblocks*sizeof(int));
724  mmTestP(r->block0,nblocks*sizeof(int));
725  mmTestP(r->block1,nblocks*sizeof(int));
726  mmTestP(r->wvhdl,nblocks*sizeof(short *));
727  mmTestP(r->names,r->N*sizeof(char *));
728
729  nblocks--;
730
731
732  if ((r->parameter!=NULL)&&(r->ch>1))
733    PrintS("//   # ground field : ");
734  else
735    PrintS("//   characteristic : ");
736  if (r->ch==-1)     Print ("0 (real)\n");  /* R */
737  else if (r->ch<0)  Print ("%d\n",-r->ch); /* Fp(a) */
738  else if (r->ch==1) PrintS("0\n");         /* Q(a)  */
739  else               Print ("%d\n",r->ch);  /* Fq, Fp, Q */
740  if (r->parameter!=NULL)
741  {
742    if (r->ch<2)
743    {
744      Print ("//   %d parameter    : ",rPar(r));
745      char **sp=r->parameter;
746      int nop=0;
747      while (nop<r->P)
748      {
749        PrintS(*sp);
750        PrintS(" ");
751        sp++; nop++;
752      }
753      PrintS("\n//   minpoly        : ");
754      if (r==currRing)
755      {
756        StringSetS(""); nWrite(r->minpoly); PrintS(StringAppendS("\n"));
757      }
758      else if (r->minpoly==NULL)
759      {
760        PrintS("0\n");
761      }
762      else
763      {
764        PrintS("...\n");
765      }
766    }
767    else
768    {
769      Print("//   primitive element : %s\n", r->parameter[0]);
770      if (r==currRing)
771      {
772        StringSetS("//   minpoly        : ");
773        nfShowMipo();PrintS(StringAppend("\n"));
774      }
775    }
776  }
777  Print("//   number of vars : %d",r->N);
778
779  //for (nblocks=0; r->order[nblocks]; nblocks++);
780  nblocks=rBlocks(r)-1;
781
782  for (int l=0, nlen=0 ; l<nblocks; l++)
783  {
784    int i;
785    Print("\n//        block %3d : ",l+1);
786
787    Print("ordering %c", (" acCMldDwWldDwWu")[r->order[l]]);
788    if ((r->order[l]>=ringorder_lp)&&(r->order[l]!=ringorder_unspec))
789    {
790      if (r->order[l]>=ringorder_ls)
791        PrintS("s");
792      else
793        PrintS("p");
794    }
795
796    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
797    {
798      PrintS("\n//                  : names    ");
799      for (i = r->block0[l]-1; i<r->block1[l]; i++)
800      {
801        nlen = strlen(r->names[i]);
802        Print("%s ",r->names[i]);
803      }
804    }
805
806    if (r->wvhdl[l]!=NULL)
807    {
808      for (int j= 0;
809           j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
810           j+=i)
811      {
812        PrintS("\n//                  : weights  ");
813        for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
814        {
815          Print("%*d " ,nlen,r->wvhdl[l][i+j],i+j);
816        }
817        if (r->order[l]!=ringorder_M) break;
818      }
819    }
820  }
821  if (r->qideal!=NULL)
822  {
823    PrintS("\n// quotient ring from ideal");
824    if (r==currRing)
825    {
826      PrintLn();
827      iiWriteMatrix((matrix)r->qideal,"_",1);
828    }
829    else PrintS(" ...");
830  }
831}
832
833void rKill(ring r)
834{
835  if ((r->ref<=0)&&(r->order!=NULL))
836  {
837#ifdef RDEBUG
838    if (traceit &TRACE_SHOW_RINGS) Print("kill ring %d\n",r->no);
839#endif
840    if (r==currRing)
841    {
842      if (r->qideal!=NULL)
843      {
844        idDelete(&r->qideal);
845        r->qideal=NULL;
846        currQuotient=NULL;
847      }
848      if (ppNoether!=NULL) pDelete(&ppNoether);
849      if ((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
850      {
851        sLastPrinted.CleanUp();
852        memset(&sLastPrinted,0,sizeof(sleftv));
853      }
854      currRing=NULL;
855      currRingHdl=NULL;
856    }
857    else if (r->qideal!=NULL)
858    {
859      ring savecurrRing = currRing;
860      rChangeCurrRing((ring)r,FALSE);
861      idDelete(&r->qideal);
862      r->qideal=NULL;
863      rChangeCurrRing(savecurrRing,FALSE);
864    }
865    int i=1;
866    int j;
867    int *pi=r->order;
868    for (j=0;j<iiRETURNEXPR_len;j++)
869    {
870      if (iiLocalRing[j]==r)
871      {
872        if (j<myynest) Warn("killing the basering for level %d",j);
873        iiLocalRing[j]=NULL;
874      }
875    }
876    if (pi!=NULL)
877    {
878      //while(*pi!=0) { pi++;i++; }
879      i=rBlocks(r);
880      Free((ADDRESS)r->order,i*sizeof(int));
881      Free((ADDRESS)r->block0,i*sizeof(int));
882      Free((ADDRESS)r->block1,i*sizeof(int));
883      for (j=0; j<i; j++)
884      {
885        if (r->wvhdl[j]!=NULL)
886          FreeL(r->wvhdl[j]);
887      }
888      Free((ADDRESS)r->wvhdl,i*sizeof(short *));
889      if(r->names!=NULL)
890      {
891        for (i=0; i<r->N; i++)
892        {
893          FreeL((ADDRESS)r->names[i]);
894        }
895        Free((ADDRESS)r->names,r->N*sizeof(char *));
896      }
897      if (r->parameter!=NULL)
898      {
899        int len=0;
900        char **s=r->parameter;
901        while (len<r->P)
902        {
903          FreeL((ADDRESS)*s);
904          s++;
905          len++;
906        }
907        Free((ADDRESS)r->parameter,r->P*sizeof(char *));
908      }
909    }
910#ifdef TEST
911    else
912      PrintS("internal error: ring structure destroyed\n");
913    memset(r,0,sizeof(ip_sring));
914#endif
915    Free((ADDRESS)r,sizeof(ip_sring));
916    return;
917  }
918  r->ref--;
919}
920
921void rKill(idhdl h)
922{
923  ring r = IDRING(h);
924  if (r!=NULL) rKill(r);
925  if (h==currRingHdl)
926  {
927    currRingHdl=idroot;
928    while (currRingHdl!=NULL)
929    {
930      if ((currRingHdl!=h)
931          && (IDTYP(currRingHdl)==IDTYP(h))
932          && (h->data.uring==currRingHdl->data.uring))
933        break;
934      currRingHdl=IDNEXT(currRingHdl);
935    }
936  }
937}
938
939idhdl rFindHdl(ring r, idhdl n)
940{
941  idhdl h=idroot;
942  while (h!=NULL)
943  {
944    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
945        && (h->data.uring==r)
946        && (h!=n))
947      return h;
948    h=IDNEXT(h);
949  }
950  return NULL;
951}
952
953int rOrderName(char * ordername)
954{
955  int order=0;
956
957  switch (*ordername)
958  {
959  case 'l':
960    if (*(ordername+1)=='p') order = ringorder_lp;
961    else if (*(ordername+1)=='s') order = ringorder_ls;
962    break;
963  case 'd':
964    if (*(ordername+1)=='p') order = ringorder_dp;
965    else if (*(ordername+1)=='s') order = ringorder_ds;
966    break;
967  case 'w':
968    if (*(ordername+1)=='p') order = ringorder_wp;
969    else if (*(ordername+1)=='s') order = ringorder_ws;
970    break;
971  case 'D':
972    if (*(ordername+1)=='p') order = ringorder_Dp;
973    else if (*(ordername+1)=='s') order = ringorder_Ds;
974    break;
975  case 'W':
976    if (*(ordername+1)=='p') order = ringorder_Wp;
977    else if (*(ordername+1)=='s') order = ringorder_Ws;
978    break;
979  case 'c': order = ringorder_c; break;
980  case 'C': order = ringorder_C; break;
981  case 'a': order = ringorder_a; break;
982  case 'M': order = ringorder_M; break;
983  default: break;
984  }
985  if (order==0) Werror("wrong ring order `%s`",ordername);
986  FreeL((ADDRESS)ordername);
987  return order;
988}
989
990char * rOrdStr(ring r)
991{
992  int nblocks,l,i;
993
994  for (nblocks=0; r->order[nblocks]; nblocks++);
995  nblocks--;
996
997  StringSetS("");
998  for (l=0; ; l++)
999  {
1000    StringAppend("%c",(" acCMldDwWldDwW")[r->order[l]]);
1001    if (r->order[l]>=ringorder_lp)
1002    {
1003      if (r->order[l]>=ringorder_ls)
1004        StringAppendS("s");
1005      else
1006        StringAppendS("p");
1007    }
1008    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
1009    {
1010      if (r->wvhdl[l]!=NULL)
1011      {
1012        StringAppendS("(");
1013        for (int j= 0;
1014             j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
1015             j+=i+1)
1016        {
1017          char c=',';
1018          for (i = 0; i<r->block1[l]-r->block0[l]; i++)
1019          {
1020            StringAppend("%d," ,r->wvhdl[l][i+j]);
1021          }
1022          if (r->order[l]!=ringorder_M)
1023          {
1024            StringAppend("%d)" ,r->wvhdl[l][i+j]);
1025            break;
1026          }
1027          if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
1028            c=')';
1029          StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
1030        }
1031      }
1032      else
1033        StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
1034    }
1035    if (l==nblocks) return mstrdup(StringAppendS(""));
1036    StringAppendS(",");
1037  }
1038}
1039
1040char * rVarStr(ring r)
1041{
1042  int i;
1043  int l=2;
1044  char *s;
1045
1046  for (i=0; i<r->N; i++)
1047  {
1048    l+=strlen(r->names[i])+1;
1049  }
1050  s=(char *)AllocL(l);
1051  s[0]='\0';
1052  for (i=0; i<r->N-1; i++)
1053  {
1054    strcat(s,r->names[i]);
1055    strcat(s,",");
1056  }
1057  strcat(s,r->names[i]);
1058  return s;
1059}
1060
1061char * rCharStr(ring r)
1062{
1063  char *s;
1064  int i;
1065
1066  if (r->parameter==NULL)
1067  {
1068    i=r->ch;
1069    if(i==-1)
1070      s=mstrdup("real");                    /* R */
1071    else
1072    {
1073      s=(char *)AllocL(6);
1074      sprintf(s,"%d",i);                   /* Q, Z/p */
1075    }
1076    return s;
1077  }
1078  int l=0;
1079  for(i=0; i<r->P;i++)
1080  {
1081    l+=(strlen(r->parameter[i])+1);
1082  }
1083  s=(char *)AllocL(l+6);
1084  s[0]='\0';
1085  if (r->ch<0)       sprintf(s,"%d",-r->ch); /* Fp(a) */
1086  else if (r->ch==1) sprintf(s,"0");         /* Q(a)  */
1087  else
1088  {
1089    sprintf(s,"%d,%s",r->ch,r->parameter[0]); /* Fq  */
1090    return s;
1091  }
1092  char tt[2];
1093  tt[0]=',';
1094  tt[1]='\0';
1095  for(i=0; i<r->P;i++)
1096  {
1097    strcat(s,tt);
1098    strcat(s,r->parameter[i]);
1099  }
1100  return s;
1101}
1102
1103char * rParStr(ring r)
1104{
1105  if (r->parameter==NULL) return mstrdup("");
1106
1107  int i;
1108  int l=2;
1109
1110  for (i=0; i<r->P; i++)
1111  {
1112    l+=strlen(r->parameter[i])+1;
1113  }
1114  char *s=(char *)AllocL(l);
1115  s[0]='\0';
1116  for (i=0; i<r->P-1; i++)
1117  {
1118    strcat(s,r->parameter[i]);
1119    strcat(s,",");
1120  }
1121  strcat(s,r->parameter[i]);
1122  return s;
1123}
1124
1125char * rString(ring r)
1126{
1127  char *ch=rCharStr(r);
1128  char *var=rVarStr(r);
1129  char *ord=rOrdStr(r);
1130  char *res=(char *)AllocL(strlen(ch)+strlen(var)+strlen(ord)+9);
1131  sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
1132  FreeL((ADDRESS)ch);
1133  FreeL((ADDRESS)var);
1134  FreeL((ADDRESS)ord);
1135  return res;
1136}
1137
1138int rChar(ring r)
1139{
1140  if (r->ch==-1)
1141    return 0;
1142  if (r->parameter==NULL) /* Q, Fp */
1143    return r->ch;
1144  if (r->ch<0)           /* Fp(a)  */
1145    return -r->ch;
1146  if (r->ch==1)          /* Q(a)  */
1147    return 0;
1148  /*else*/               /* GF(p,n) */
1149  {
1150    if ((r->ch & 1)==0) return 2;
1151    int i=3;
1152    while ((r->ch % i)!=0) i+=2;
1153    return i;
1154  }
1155}
1156
1157int    rIsExtension(ring r)
1158{
1159  if (r->parameter==NULL) /* Q, Fp */
1160    return FALSE;
1161  else
1162    return TRUE;
1163}
1164
1165int    rIsExtension()
1166{
1167  return rIsExtension( currRing );
1168}
1169
1170/*2
1171 *returns -1 for not compatible, (sum is undefined)
1172 *         0 for equal, (and sum)
1173 *         1 for compatible (and sum)
1174 */
1175int rSum(ring r1, ring r2, ring &sum)
1176{
1177  if (r1==r2)
1178  {
1179    sum=r1;
1180    r1->ref++;
1181    return 0;
1182  }
1183  ip_sring tmpR;
1184  memset(&tmpR,0,sizeof(tmpR));
1185  /* check coeff. field =====================================================*/
1186  if (r1->ch==r2->ch)
1187  {
1188    tmpR.ch=r1->ch;
1189    if ((r1->ch==0)||(r1->ch>=2)) /* Q, Z/p, GF(p,n) */
1190    {
1191      if (r1->parameter!=NULL)
1192      {
1193        if (strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1194        {
1195          tmpR.parameter=(char **)Alloc(sizeof(char *));
1196          tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1197          tmpR.P=1;
1198        }
1199        else
1200        {
1201          WerrorS("GF(p,n)+GF(p,n)");
1202          return -1;
1203        }
1204      }
1205    }
1206    else if ((r1->ch==1)||(r1->ch<-1)) /* Q(a),Z/p(a) */
1207    {
1208      if (r1->minpoly!=NULL)
1209      {
1210        if (r2->minpoly!=NULL)
1211        {
1212          nSetChar(r1->ch,TRUE,r1->parameter,r1->P);
1213          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1214              && naEqual(r1->minpoly,r2->minpoly))
1215          {
1216            tmpR.parameter=(char **)Alloc(sizeof(char *));
1217            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1218            tmpR.minpoly=naCopy(r1->minpoly);
1219            tmpR.P=1;
1220            nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1221          }
1222          else
1223          {
1224            nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1225            WerrorS("different minpolys");
1226            return -1;
1227          }
1228        }
1229        else
1230        {
1231          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1232              && (r2->P==1))
1233          {
1234            tmpR.parameter=(char **)Alloc0(sizeof(char *));
1235            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1236            tmpR.P=1;
1237            nSetChar(r1->ch,TRUE,r1->parameter,r1->P);
1238            tmpR.minpoly=naCopy(r1->minpoly);
1239            nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1240          }
1241          else
1242          {
1243            WerrorS("different parameters and minpoly!=0");
1244            return -1;
1245          }
1246        }
1247      }
1248      else /* r1->minpoly==NULL */
1249      {
1250        if (r2->minpoly!=NULL)
1251        {
1252          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1253              && (r1->P==1))
1254          {
1255            tmpR.parameter=(char **)Alloc(sizeof(char *));
1256            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1257            tmpR.P=1;
1258            nSetChar(r2->ch,TRUE,r2->parameter,r2->P);
1259            tmpR.minpoly=naCopy(r2->minpoly);
1260            nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1261          }
1262          else
1263          {
1264            WerrorS("different parameters and minpoly!=0");
1265            return -1;
1266          }
1267        }
1268        else
1269        {
1270          int len=rPar(r1)+rPar(r2);
1271          tmpR.parameter=(char **)Alloc(len*sizeof(char *));
1272          int i;
1273          for (i=0;i<r1->P;i++)
1274          {
1275            tmpR.parameter[i]=mstrdup(r1->parameter[i]);
1276          }
1277          int j,l;
1278          for(j=0;j<r2->P;j++)
1279          {
1280            for(l=0;l<i;l++)
1281            {
1282              if(strcmp(tmpR.parameter[l],r2->parameter[j])==0)
1283                break;
1284            }
1285            if (l==i)
1286            {
1287              tmpR.parameter[i]=mstrdup(r2->parameter[j]);
1288              i++;
1289            }
1290          }
1291          if (i!=len)
1292          {
1293            ReAlloc(tmpR.parameter,len*sizeof(char *),i*sizeof(char *));
1294          }
1295        }
1296      }
1297    }
1298  }
1299  else /* r1->ch!=r2->ch */
1300  {
1301    if (r1->ch<-1) /* Z/p(a) */
1302    {
1303      if ((r2->ch==0) /* Q */
1304          || (r2->ch==-r1->ch)) /* Z/p */
1305      {
1306        tmpR.ch=r1->ch;
1307        tmpR.parameter=(char **)Alloc(rPar(r1)*sizeof(char *));
1308        tmpR.P=r1->P;
1309        memcpy(tmpR.parameter,r1->parameter,rPar(r1)*sizeof(char *));
1310        if (r1->minpoly!=NULL)
1311        {
1312          nSetChar(r1->ch,TRUE,r1->parameter,r1->P);
1313          tmpR.minpoly=naCopy(r1->minpoly);
1314          nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1315        }
1316      }
1317      else  /* R, Q(a),Z/q,Z/p(a),GF(p,n) */
1318      {
1319        WerrorS("Z/p(a)+(R,Q(a),Z/q(a),GF(q,n))");
1320        return -1;
1321      }
1322    }
1323    else if (r1->ch==-1) /* R */
1324    {
1325      WerrorS("R+..");
1326      return -1;
1327    }
1328    else if (r1->ch==0) /* Q */
1329    {
1330      if ((r2->ch<-1)||(r2->ch==1)) /* Z/p(a),Q(a) */
1331      {
1332        tmpR.ch=r2->ch;
1333        tmpR.P=r2->P;
1334        tmpR.parameter=(char **)Alloc(rPar(r2)*sizeof(char *));
1335        memcpy(tmpR.parameter,r2->parameter,rPar(r2)*sizeof(char *));
1336        if (r2->minpoly!=NULL)
1337        {
1338          nSetChar(r1->ch,TRUE,r1->parameter,r1->P);
1339          tmpR.minpoly=naCopy(r2->minpoly);
1340          nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1341        }
1342      }
1343      else if (r2->ch>1) /* Z/p,GF(p,n) */
1344      {
1345        tmpR.ch=r2->ch;
1346        if (r2->parameter!=NULL)
1347        {
1348          tmpR.parameter=(char **)Alloc(sizeof(char *));
1349          tmpR.P=1;
1350          tmpR.parameter[0]=mstrdup(r2->parameter[0]);
1351        }
1352      }
1353      else
1354      {
1355        WerrorS("Q+R");
1356        return -1; /* R */
1357      }
1358    }
1359    else if (r1->ch==1) /* Q(a) */
1360    {
1361      if (r2->ch==0) /* Q */
1362      {
1363        tmpR.ch=r1->ch;
1364        tmpR.P=rPar(r1);
1365        tmpR.parameter=(char **)Alloc0(rPar(r1)*sizeof(char *));
1366        int i;
1367        for(i=0;i<r1->P;i++)
1368        {
1369          tmpR.parameter[i]=mstrdup(r1->parameter[i]);
1370        }
1371        if (r1->minpoly!=NULL)
1372        {
1373          nSetChar(r1->ch,TRUE,r1->parameter,r1->P);
1374          tmpR.minpoly=naCopy(r1->minpoly);
1375          nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1376        }
1377      }
1378      else  /* R, Z/p,GF(p,n) */
1379      {
1380        WerrorS("Q(a)+(R,Z/p,GF(p,n))");
1381        return -1;
1382      }
1383    }
1384    else /* r1->ch >=2 , Z/p */
1385    {
1386      if (r2->ch==0) /* Q */
1387      {
1388        tmpR.ch=r1->ch;
1389      }
1390      else if (r2->ch==-r1->ch) /* Z/p(a) */
1391      {
1392        tmpR.ch=r2->ch;
1393        tmpR.P=rPar(r2);
1394        tmpR.parameter=(char **)Alloc(rPar(r2)*sizeof(char *));
1395        int i;
1396        for(i=0;i<r2->P;i++)
1397        {
1398          tmpR.parameter[i]=mstrdup(r2->parameter[i]);
1399        }
1400        if (r2->minpoly!=NULL)
1401        {
1402          nSetChar(r2->ch,TRUE,r2->parameter,r2->P);
1403          tmpR.minpoly=naCopy(r2->minpoly);
1404          nSetChar(currRing->ch,TRUE,currRing->parameter,currRing->P);
1405        }
1406      }
1407      else
1408      {
1409        WerrorS("Z/p+(GF(q,n),Z/q(a),R,Q(a))");
1410        return -1; /* GF(p,n),Z/q(a),R,Q(a) */
1411      }
1412    }
1413  }
1414  /* variable names ========================================================*/
1415  int i,j,k;
1416  int l=r1->N+r2->N;
1417  char **names=(char **)Alloc0(l*sizeof(char*));
1418  k=0;
1419
1420  // collect all varnames from r1, except those which are parameters
1421  // of r2, or those which are the empty string
1422  for (i=0;i<r1->N;i++)
1423  {
1424    BOOLEAN b=TRUE;
1425
1426    if (*(r1->names[i]) == '\0')
1427      b = FALSE;
1428    else if ((r2->parameter!=NULL) && (strlen(r1->names[i])==1))
1429    {
1430      for(j=0;j<r2->P;j++)
1431      {
1432        if (strcmp(r1->names[i],r2->parameter[j])==0)
1433        {
1434          b=FALSE;
1435          break;
1436        }
1437      }
1438    }
1439
1440    if (b)
1441    {
1442      //Print("name : %d: %s\n",k,r1->names[i]);
1443      names[k]=mstrdup(r1->names[i]);
1444      k++;
1445    }
1446    //else
1447    //  Print("no name (par1) %s\n",r1->names[i]);
1448  }
1449  // Add variables from r2, except those which are parameters of r1
1450  // those which are empty strings, and those which equal a var of r1
1451  for(i=0;i<r2->N;i++)
1452  {
1453    BOOLEAN b=TRUE;
1454
1455    if (*(r2->names[i]) == '\0')
1456      b = FALSE;
1457    else if ((r1->parameter!=NULL) && (strlen(r2->names[i])==1))
1458    {
1459      for(j=0;j<r1->P;j++)
1460      {
1461        if (strcmp(r2->names[i],r1->parameter[j])==0)
1462        {
1463          b=FALSE;
1464          break;
1465        }
1466      }
1467    }
1468
1469    if (b)
1470    {
1471      for(j=0;j<r1->N;j++)
1472      {
1473        if (strcmp(r1->names[j],r2->names[i])==0)
1474        {
1475          b=FALSE;
1476          break;
1477        }
1478      }
1479      if (b)
1480      {
1481        names[k]=mstrdup(r2->names[i]);
1482        //Print("name : %d : %s\n",k,r2->names[i]);
1483        k++;
1484      }
1485      //else
1486      //  Print("no name (var): %s\n",r2->names[i]);
1487    }
1488    //else
1489    //  Print("no name (par): %s\n",r2->names[i]);
1490  }
1491  // check whether we found any vars at all
1492  if (k == 0)
1493  {
1494    names[k]=mstrdup("");
1495    k=1;
1496  }
1497  tmpR.N=k;
1498  tmpR.names=names;
1499  /* ordering *======================================================== */
1500  tmpR.OrdSgn=1;
1501  if ((r1->order[0]==ringorder_unspec)
1502      && (r2->order[0]==ringorder_unspec))
1503  {
1504    tmpR.order=(int*)Alloc(3*sizeof(int));
1505    tmpR.block0=(int*)Alloc(3*sizeof(int));
1506    tmpR.block1=(int*)Alloc(3*sizeof(int));
1507    tmpR.wvhdl=(short**)Alloc0(3*sizeof(short*));
1508    tmpR.order[0]=ringorder_unspec;
1509    tmpR.order[1]=ringorder_C;
1510    tmpR.order[2]=0;
1511    tmpR.block0[0]=1;
1512    tmpR.block1[0]=tmpR.N;
1513  }
1514  else if (l==k) /* r3=r1+r2 */
1515  {
1516    int b;
1517    ring rb;
1518    if (r1->order[0]==ringorder_unspec)
1519    {
1520      /* extend order of r2 to r3 */
1521      b=rBlocks(r2);
1522      rb=r2;
1523      tmpR.OrdSgn=r2->OrdSgn;
1524    }
1525    else if (r2->order[0]==ringorder_unspec)
1526    {
1527      /* extend order of r1 to r3 */
1528      b=rBlocks(r1);
1529      rb=r1;
1530      tmpR.OrdSgn=r1->OrdSgn;
1531    }
1532    else
1533    {
1534      b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
1535      rb=NULL;
1536    }
1537    tmpR.order=(int*)Alloc0(b*sizeof(int));
1538    tmpR.block0=(int*)Alloc0(b*sizeof(int));
1539    tmpR.block1=(int*)Alloc0(b*sizeof(int));
1540    tmpR.wvhdl=(short**)Alloc0(b*sizeof(short*));
1541    /* weights not implemented yet ...*/
1542    if (rb!=NULL)
1543    {
1544      for (i=0;i<b;i++)
1545      {
1546        tmpR.order[i]=rb->order[i];
1547        tmpR.block0[i]=rb->block0[i];
1548        tmpR.block1[i]=rb->block1[i];
1549      }
1550      tmpR.block0[0]=1;
1551    }
1552    else /* ring sum for complete rings */
1553    {
1554      for (i=0;r1->order[i]!=0;i++)
1555      {
1556        tmpR.order[i]=r1->order[i];
1557        tmpR.block0[i]=r1->block0[i];
1558        tmpR.block1[i]=r1->block1[i];
1559      }
1560      j=i;
1561      i--;
1562      if ((r1->order[i]==ringorder_c)
1563          ||(r1->order[i]==ringorder_C))
1564      {
1565        j--;
1566        tmpR.order[b-2]=r1->order[i];
1567      }
1568      for (i=0;r2->order[i]!=0;i++,j++)
1569      {
1570        if ((r2->order[i]!=ringorder_c)
1571            &&(r2->order[i]!=ringorder_C))
1572        {
1573          tmpR.order[j]=r2->order[i];
1574          tmpR.block0[j]=r2->block0[i]+r1->N;
1575          tmpR.block1[j]=r2->block1[i]+r1->N;
1576        }
1577      }
1578      if((r1->OrdSgn==-1)||(r2->OrdSgn==-1))
1579        tmpR.OrdSgn=-1;
1580    }
1581  }
1582  else if ((k==r1->N) && (k==r2->N)) /* r1 and r2 are "quite" the same ring */
1583    /* copy r1, because we have the variables from r1 */
1584  {
1585    int b=rBlocks(r1);
1586
1587    tmpR.order=(int*)Alloc0(b*sizeof(int));
1588    tmpR.block0=(int*)Alloc0(b*sizeof(int));
1589    tmpR.block1=(int*)Alloc0(b*sizeof(int));
1590    tmpR.wvhdl=(short**)Alloc0(b*sizeof(short*));
1591    /* weights not implemented yet ...*/
1592    for (i=0;i<b;i++)
1593    {
1594      tmpR.order[i]=r1->order[i];
1595      tmpR.block0[i]=r1->block0[i];
1596      tmpR.block1[i]=r1->block1[i];
1597    }
1598    tmpR.OrdSgn=r1->OrdSgn;
1599  }
1600  else
1601  {
1602    for(i=0;i<k;i++) FreeL((ADDRESS)tmpR.names[i]);
1603    Free((ADDRESS)names,tmpR.N*sizeof(char *));
1604    Werror("difficulties with variables: %d,%d -> %d",r1->N,r2->N,k);
1605    return -1;
1606  }
1607  sum=(ring)Alloc(sizeof(ip_sring));
1608  memcpy(sum,&tmpR,sizeof(ip_sring));
1609  rComplete(sum);
1610  return 1;
1611}
1612
1613/*2
1614 * create a copy of the ring r, which must be equivalent to currRing
1615 * used for qring definition,..
1616 * (i.e.: normal rings: same nCopy as currRing;
1617 *        qring:        same nCopy, same idCopy as currRing)
1618 */
1619ring rCopy(ring r)
1620{
1621  int i,j;
1622  int *pi;
1623  ring res=(ring)Alloc(sizeof(ip_sring));
1624
1625  memcpy4(res,r,sizeof(ip_sring));
1626  if (r->parameter!=NULL)
1627  {
1628    res->minpoly=nCopy(r->minpoly);
1629    int l=rPar(r);
1630    res->parameter=(char **)Alloc(l*sizeof(char *));
1631    int i;
1632    for(i=0;i<r->P;i++)
1633    {
1634      res->parameter[i]=mstrdup(r->parameter[i]);
1635    }
1636  }
1637  res->names   = (char **)Alloc(r->N * sizeof(char *));
1638  i=1;
1639  pi=r->order;
1640  while ((*pi)!=0) { i++;pi++; }
1641  res->wvhdl   = (short **)Alloc(i * sizeof(short *));
1642  res->order   = (int *)   Alloc(i * sizeof(int));
1643  res->block0  = (int *)   Alloc(i * sizeof(int));
1644  res->block1  = (int *)   Alloc(i * sizeof(int));
1645  for (j=0; j<i; j++)
1646  {
1647    if (r->wvhdl[j]!=NULL)
1648    {
1649      res->wvhdl[j]=(short*)AllocL(mmSizeL((ADDRESS)r->wvhdl[j]));
1650      memcpy(res->wvhdl[j],r->wvhdl[j],mmSizeL((ADDRESS)r->wvhdl[j]));
1651    }
1652    else
1653      res->wvhdl[j]=NULL;
1654  }
1655  memcpy4(res->order,r->order,i * sizeof(int));
1656  memcpy4(res->block0,r->block0,i * sizeof(int));
1657  memcpy4(res->block1,r->block1,i * sizeof(int));
1658  for (i=0; i<res->N; i++)
1659  {
1660    res->names[i] = mstrdup(r->names[i]);
1661  }
1662  res->idroot = NULL;
1663  if (r->qideal!=NULL) res->qideal= idCopy(r->qideal);
1664
1665#ifdef RDEBUG
1666  rNumber++;
1667  res->no=rNumber;
1668#endif
1669
1670  return res;
1671}
1672
1673rOrderType_t rGetOrderType(ring r)
1674{
1675  // check for simple ordering
1676  if (rHasSimpleOrder(r))
1677  {
1678    if ((r->order[1] == ringorder_c) || (r->order[1] == ringorder_C))
1679    {
1680      switch(r->order[0])
1681      {
1682          case ringorder_dp:
1683          case ringorder_wp:
1684          case ringorder_ds:
1685          case ringorder_ws:
1686          case ringorder_ls:
1687          case ringorder_unspec:
1688            if (r->order[1] == ringorder_C ||  r->order[0] == ringorder_unspec)
1689              return rOrderType_ExpComp;
1690            return rOrderType_Exp;
1691
1692          default:
1693            assume(r->order[0] == ringorder_lp ||
1694                   r->order[0] == ringorder_Dp ||
1695                   r->order[0] == ringorder_Wp ||
1696                   r->order[0] == ringorder_Ds ||
1697                   r->order[0] == ringorder_Ws);
1698
1699            if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1700            return rOrderType_Exp;
1701      }
1702    }
1703    else
1704    {
1705      assume((r->order[0]==ringorder_c)||(r->order[0]==ringorder_C));
1706      return rOrderType_CompExp;
1707    }
1708  }
1709  else
1710    return rOrderType_General;
1711}
1712
1713BOOLEAN rHasSimpleOrder(ring r)
1714{
1715  return
1716    (r->order[0] == ringorder_unspec) ||
1717    ((r->order[2] == 0) &&
1718     (r->order[1] != ringorder_M &&
1719      r->order[0] != ringorder_M));
1720}
1721
1722// returns TRUE, if simple lp or ls ordering
1723BOOLEAN rHasSimpleLexOrder(ring r)
1724{
1725  return rHasSimpleOrder(r) &&
1726    (r->order[0] == ringorder_ls ||
1727     r->order[0] == ringorder_lp ||
1728     r->order[1] == ringorder_ls ||
1729     r->order[1] == ringorder_lp);
1730}
1731
1732
Note: See TracBrowser for help on using the repository browser.