source: git/Singular/ring.cc @ 82ac59

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