source: git/Singular/ring.cc @ e06ef94

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