source: git/Singular/ring.cc @ d27c18

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