source: git/Singular/ring.cc @ 053925

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