source: git/Singular/ring.cc @ 194f5e5

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