source: git/Singular/ring.cc @ 82716e

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