source: git/Singular/ring.cc @ f99917f

spielwiese
Last change on this file since f99917f was f99917f, checked in by Hans Schönemann <hannes@…>, 25 years ago
* hannes: added "highcorner" for modules (iparith, ipshell) fixed rWrite (ring.cc) fixed mpCoef (matpol.cc) git-svn-id: file:///usr/local/Singular/svn/trunk@2904 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 45.6 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: ring.cc,v 1.45 1999-03-11 15:58:09 Singular Exp $ */
5
6/*
7* ABSTRACT - the interpreter related ring operations
8*/
9
10/* includes */
11#include <math.h>
12#include "mod2.h"
13#include "mmemory.h"
14#include "tok.h"
15#include "polys.h"
16#include "numbers.h"
17#include "febase.h"
18#include "ipid.h"
19#include "ipshell.h"
20#include "ipconv.h"
21#include "intvec.h"
22#include "longalg.h"
23#include "ffields.h"
24#include "spolys.h"
25#include "subexpr.h"
26#include "ideals.h"
27#include "lists.h"
28#include "ring.h"
29
30/* global variables */
31#ifdef RDEBUG
32short rNumber=0;
33#endif
34
35/*0 implementation*/
36int rBlocks(ring r)
37{
38  int i=0;
39  while (r->order[i]!=0) i++;
40  return i+1;
41}
42
43// internally changes the gloabl ring and resets the relevant
44// global variables:
45// complete == FALSE : only delete operations are enabled
46// complete == TRUE  : full reset of all variables
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, rPar(r));
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<rPar(rg);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  if (isDRing) setFlag(tmp,FLAG_DRING);
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, int force)
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 (rField_is_GF(r))
734  {
735    Print("//   # ground field : %d\n",rInternalChar(r));
736    Print("//   primitive element : %s\n", r->parameter[0]);
737    if (r==currRing)
738    {
739      StringSetS("//   minpoly        : ");
740      nfShowMipo();PrintS(StringAppend("\n"));
741    }
742  }
743  else
744  {
745    PrintS("//   characteristic : ");
746    if ( rField_is_R(r) )        PrintS("0 (real)\n");  /* R */
747    else Print ("%d\n",rChar(r)); /* Fp(a) */
748    if (r->parameter!=NULL)
749    {
750      Print ("//   %d parameter    : ",rPar(r));
751      char **sp=r->parameter;
752      int nop=0;
753      while (nop<rPar(r))
754      {
755        PrintS(*sp);
756        PrintS(" ");
757        sp++; nop++;
758      }
759      PrintS("\n//   minpoly        : ");
760      if (r==currRing)
761      {
762        StringSetS(""); nWrite(r->minpoly); PrintS(StringAppendS("\n"));
763      }
764      else if (r->minpoly==NULL)
765      {
766        PrintS("0\n");
767      }
768      else
769      {
770        PrintS("...\n");
771      }
772    }
773  }
774  Print("//   number of vars : %d",r->N);
775
776  //for (nblocks=0; r->order[nblocks]; nblocks++);
777  nblocks=rBlocks(r)-1;
778
779  for (int l=0, nlen=0 ; l<nblocks; l++)
780  {
781    int i;
782    Print("\n//        block %3d : ",l+1);
783
784    Print("ordering %c", (" acCMldDwWldDwWu")[r->order[l]]);
785    if ((r->order[l]>=ringorder_lp)&&(r->order[l]!=ringorder_unspec))
786    {
787      if (r->order[l]>=ringorder_ls)
788        PrintS("s");
789      else
790        PrintS("p");
791    }
792
793    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
794    {
795      PrintS("\n//                  : names    ");
796      for (i = r->block0[l]-1; i<r->block1[l]; i++)
797      {
798        nlen = strlen(r->names[i]);
799        Print("%s ",r->names[i]);
800      }
801    }
802
803    if (r->wvhdl[l]!=NULL)
804    {
805      for (int j= 0;
806           j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
807           j+=i)
808      {
809        PrintS("\n//                  : weights  ");
810        for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
811        {
812          Print("%*d " ,nlen,r->wvhdl[l][i+j],i+j);
813        }
814        if (r->order[l]!=ringorder_M) break;
815      }
816    }
817  }
818  if (r->qideal!=NULL)
819  {
820    PrintS("\n// quotient ring from ideal");
821    if (r==currRing)
822    {
823      PrintLn();
824      iiWriteMatrix((matrix)r->qideal,"_",1);
825    }
826    else PrintS(" ...");
827  }
828}
829
830void rKill(ring r)
831{
832  rTest(r);
833  if ((r->ref<=0)&&(r->order!=NULL))
834  {
835#ifdef RDEBUG
836    if (traceit &TRACE_SHOW_RINGS) Print("kill ring %d\n",r->no);
837#endif
838    if (r==currRing)
839    {
840      if (r->qideal!=NULL)
841      {
842        idDelete(&r->qideal);
843        r->qideal=NULL;
844        currQuotient=NULL;
845      }
846      if (ppNoether!=NULL) pDelete(&ppNoether);
847      if ((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING))
848      {
849        sLastPrinted.CleanUp();
850        memset(&sLastPrinted,0,sizeof(sleftv));
851      }
852      currRing=NULL;
853      currRingHdl=NULL;
854    }
855    else if (r->qideal!=NULL)
856    {
857      ring savecurrRing = currRing;
858      rChangeCurrRing((ring)r,FALSE);
859      idDelete(&r->qideal);
860      r->qideal=NULL;
861      rChangeCurrRing(savecurrRing,FALSE);
862    }
863    int i=1;
864    int j;
865    int *pi=r->order;
866#ifdef USE_IILOCALRING
867    for (j=0;j<iiRETURNEXPR_len;j++)
868    {
869      if (iiLocalRing[j]==r)
870      {
871        if (j<myynest) Warn("killing the basering for level %d",j);
872        iiLocalRing[j]=NULL;
873      }
874    }
875#else /* USE_IILOCALRING */
876    {
877      namehdl nshdl = namespaceroot;
878
879      for(nshdl=namespaceroot; nshdl->isroot != TRUE; nshdl = nshdl->next) {
880        //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
881        if (nshdl->currRing==r)
882        {
883          if (nshdl->myynest<myynest)
884//            Warn("killing the basering for level %d/%d",nshdl->lev,nshdl->myynest);
885          Warn("killing the basering for level %d",nshdl->myynest);
886          nshdl->currRing=NULL;
887        }
888      }
889      if (nshdl->currRing==r)
890      {
891        //Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
892        if (nshdl->myynest<myynest)
893//          Warn("killing the basering for level %d/%d",nshdl->lev,nshdl->myynest);
894          Warn("killing the basering for level %d",nshdl->myynest);
895        nshdl->currRing=NULL;
896      }
897    }
898#endif /* USE_IILOCALRING */
899    if (pi!=NULL)
900    {
901      //while(*pi!=0) { pi++;i++; }
902      i=rBlocks(r);
903      Free((ADDRESS)r->order,i*sizeof(int));
904      Free((ADDRESS)r->block0,i*sizeof(int));
905      Free((ADDRESS)r->block1,i*sizeof(int));
906      for (j=0; j<i; j++)
907      {
908        if (r->wvhdl[j]!=NULL)
909          FreeL(r->wvhdl[j]);
910      }
911      Free((ADDRESS)r->wvhdl,i*sizeof(short *));
912      if(r->names!=NULL)
913      {
914        for (i=0; i<r->N; i++)
915        {
916          FreeL((ADDRESS)r->names[i]);
917        }
918        Free((ADDRESS)r->names,r->N*sizeof(char *));
919      }
920      if (r->parameter!=NULL)
921      {
922        int len=0;
923        char **s=r->parameter;
924        while (len<rPar(r))
925        {
926          FreeL((ADDRESS)*s);
927          s++;
928          len++;
929        }
930        Free((ADDRESS)r->parameter,rPar(r)*sizeof(char *));
931      }
932      Free((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
933    }
934#ifdef TEST
935    else
936      PrintS("internal error: ring structure destroyed\n");
937    memset(r,0,sizeof(ip_sring));
938#endif
939    Free((ADDRESS)r,sizeof(ip_sring));
940    return;
941  }
942  r->ref--;
943}
944
945void rKill(idhdl h)
946{
947#ifndef HAVE_NAMESPACES1
948  ring r = IDRING(h);
949  if (r!=NULL) rKill(r);
950  if (h==currRingHdl)
951  {
952#ifdef HAVE_NAMESPACES
953    namehdl nsHdl = namespaceroot;
954    while(nsHdl!=NULL) {
955      currRingHdl=NSROOT(nsHdl);
956#else /* HAVE_NAMESPACES */
957      currRingHdl=IDROOT;
958#endif /* HAVE_NAMESPACES */
959      while (currRingHdl!=NULL)
960      {
961        if ((currRingHdl!=h)
962            && (IDTYP(currRingHdl)==IDTYP(h))
963            && (h->data.uring==currRingHdl->data.uring))
964          break;
965        currRingHdl=IDNEXT(currRingHdl);
966      }
967#ifdef HAVE_NAMESPACES
968      if ((currRingHdl != NULL) && (currRingHdl!=h)
969          && (IDTYP(currRingHdl)==IDTYP(h))
970          && (h->data.uring==currRingHdl->data.uring))
971        break;
972      nsHdl = nsHdl->next;
973    }
974#endif /* HAVE_NAMESPACES */
975  }
976#else
977    if(currRingHdl==NULL) {
978      namehdl ns = namespaceroot;
979      BOOLEAN found=FALSE;
980
981      while(!ns->isroot) {
982        currRingHdl=NSROOT(namespaceroot->next);
983        while (currRingHdl!=NULL)
984        {
985          if ((currRingHdl!=h)
986              && (IDTYP(currRingHdl)==IDTYP(h))
987              && (h->data.uring==currRingHdl->data.uring))
988          { found=TRUE; break; }
989
990          currRingHdl=IDNEXT(currRingHdl);
991        }
992        if(found) break;
993        ns=IDNEXT(ns);
994      }
995    }
996    if(currRingHdl == NULL || IDRING(h) != IDRING(currRingHdl)) {
997      currRingHdl = namespaceroot->currRingHdl;
998
999/*      PrintS("Running rFind()\n");
1000      currRingHdl = rFindHdl(IDRING(h), NULL, NULL);
1001      if(currRingHdl == NULL)
1002      {
1003        PrintS("rFind()return 0\n");
1004      }
1005      else
1006      {
1007        PrintS("Huppi rfind return an currRingHDL\n");
1008        Print("%x, %x\n", IDRING(h),IDRING(currRingHdl) );
1009      }
1010*/
1011    }
1012    else
1013    {
1014      //PrintS("Huppi found an currRingHDL\n");
1015      //Print("%x, %x\n", IDRING(h),IDRING(currRingHdl) );
1016
1017    }
1018#endif /* HAVE_NAMESPACES */
1019}
1020
1021idhdl rFindHdl(ring r, idhdl n, idhdl w)
1022{
1023#ifdef HAVE_NAMESPACES
1024  idhdl h;
1025  namehdl ns = namespaceroot;
1026
1027  while(!ns->isroot) {
1028    h = NSROOT(ns);
1029    if(w != NULL) h = w;
1030    while (h!=NULL)
1031    {
1032      if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1033          && (h->data.uring==r)
1034          && (h!=n))
1035        return h;
1036      h=IDNEXT(h);
1037    }
1038    ns = ns->next;
1039  }
1040  h = NSROOT(ns);
1041  if(w != NULL) h = w;
1042  while (h!=NULL)
1043  {
1044    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1045        && (h->data.uring==r)
1046        && (h!=n))
1047      return h;
1048    h=IDNEXT(h);
1049  }
1050#if 0
1051  if(namespaceroot->isroot) h = IDROOT;
1052  else h = NSROOT(namespaceroot->next);
1053  if(w != NULL) h = w;
1054  while (h!=NULL)
1055  {
1056    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1057        && (h->data.uring==r)
1058        && (h!=n))
1059      return h;
1060    h=IDNEXT(h);
1061  }
1062#endif
1063#else
1064  idhdl h=IDROOT;
1065  if(w != NULL) h = w;
1066  while (h!=NULL)
1067  {
1068    if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1069        && (h->data.uring==r)
1070        && (h!=n))
1071      return h;
1072    h=IDNEXT(h);
1073  }
1074#endif
1075  return NULL;
1076}
1077
1078int rOrderName(char * ordername)
1079{
1080  int order=0;
1081
1082  switch (*ordername)
1083  {
1084  case 'l':
1085    if (*(ordername+1)=='p') order = ringorder_lp;
1086    else if (*(ordername+1)=='s') order = ringorder_ls;
1087    break;
1088  case 'd':
1089    if (*(ordername+1)=='p') order = ringorder_dp;
1090    else if (*(ordername+1)=='s') order = ringorder_ds;
1091    break;
1092  case 'w':
1093    if (*(ordername+1)=='p') order = ringorder_wp;
1094    else if (*(ordername+1)=='s') order = ringorder_ws;
1095    break;
1096  case 'D':
1097    if (*(ordername+1)=='p') order = ringorder_Dp;
1098    else if (*(ordername+1)=='s') order = ringorder_Ds;
1099    break;
1100  case 'W':
1101    if (*(ordername+1)=='p') order = ringorder_Wp;
1102    else if (*(ordername+1)=='s') order = ringorder_Ws;
1103    break;
1104  case 'c': order = ringorder_c; break;
1105  case 'C': order = ringorder_C; break;
1106  case 'a': order = ringorder_a; break;
1107  case 'M': order = ringorder_M; break;
1108  default: break;
1109  }
1110  if (order==0) Werror("wrong ring order `%s`",ordername);
1111  FreeL((ADDRESS)ordername);
1112  return order;
1113}
1114
1115char * rOrdStr(ring r)
1116{
1117  int nblocks,l,i;
1118
1119  for (nblocks=0; r->order[nblocks]; nblocks++);
1120  nblocks--;
1121
1122  StringSetS("");
1123  for (l=0; ; l++)
1124  {
1125    StringAppend("%c",(" acCMldDwWldDwW")[r->order[l]]);
1126    if (r->order[l]>=ringorder_lp)
1127    {
1128      if (r->order[l]>=ringorder_ls)
1129        StringAppendS("s");
1130      else
1131        StringAppendS("p");
1132    }
1133    if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
1134    {
1135      if (r->wvhdl[l]!=NULL)
1136      {
1137        StringAppendS("(");
1138        for (int j= 0;
1139             j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
1140             j+=i+1)
1141        {
1142          char c=',';
1143          for (i = 0; i<r->block1[l]-r->block0[l]; i++)
1144          {
1145            StringAppend("%d," ,r->wvhdl[l][i+j]);
1146          }
1147          if (r->order[l]!=ringorder_M)
1148          {
1149            StringAppend("%d)" ,r->wvhdl[l][i+j]);
1150            break;
1151          }
1152          if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
1153            c=')';
1154          StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
1155        }
1156      }
1157      else
1158        StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
1159    }
1160    if (l==nblocks) return mstrdup(StringAppendS(""));
1161    StringAppendS(",");
1162  }
1163}
1164
1165char * rVarStr(ring r)
1166{
1167  int i;
1168  int l=2;
1169  char *s;
1170
1171  for (i=0; i<r->N; i++)
1172  {
1173    l+=strlen(r->names[i])+1;
1174  }
1175  s=(char *)AllocL(l);
1176  s[0]='\0';
1177  for (i=0; i<r->N-1; i++)
1178  {
1179    strcat(s,r->names[i]);
1180    strcat(s,",");
1181  }
1182  strcat(s,r->names[i]);
1183  return s;
1184}
1185
1186char * rCharStr(ring r)
1187{
1188  char *s;
1189  int i;
1190
1191  if (r->parameter==NULL)
1192  {
1193    i=r->ch;
1194    if(i==-1)
1195      s=mstrdup("real");                    /* R */
1196    else
1197    {
1198      s=(char *)AllocL(6);
1199      sprintf(s,"%d",i);                   /* Q, Z/p */
1200    }
1201    return s;
1202  }
1203  int l=0;
1204  for(i=0; i<rPar(r);i++)
1205  {
1206    l+=(strlen(r->parameter[i])+1);
1207  }
1208  s=(char *)AllocL(l+6);
1209  s[0]='\0';
1210  if (r->ch<0)       sprintf(s,"%d",-r->ch); /* Fp(a) */
1211  else if (r->ch==1) sprintf(s,"0");         /* Q(a)  */
1212  else
1213  {
1214    sprintf(s,"%d,%s",r->ch,r->parameter[0]); /* Fq  */
1215    return s;
1216  }
1217  char tt[2];
1218  tt[0]=',';
1219  tt[1]='\0';
1220  for(i=0; i<rPar(r);i++)
1221  {
1222    strcat(s,tt);
1223    strcat(s,r->parameter[i]);
1224  }
1225  return s;
1226}
1227
1228char * rParStr(ring r)
1229{
1230  if (r->parameter==NULL) return mstrdup("");
1231
1232  int i;
1233  int l=2;
1234
1235  for (i=0; i<rPar(r); i++)
1236  {
1237    l+=strlen(r->parameter[i])+1;
1238  }
1239  char *s=(char *)AllocL(l);
1240  s[0]='\0';
1241  for (i=0; i<rPar(r)-1; i++)
1242  {
1243    strcat(s,r->parameter[i]);
1244    strcat(s,",");
1245  }
1246  strcat(s,r->parameter[i]);
1247  return s;
1248}
1249
1250char * rString(ring r)
1251{
1252  char *ch=rCharStr(r);
1253  char *var=rVarStr(r);
1254  char *ord=rOrdStr(r);
1255  char *res=(char *)AllocL(strlen(ch)+strlen(var)+strlen(ord)+9);
1256  sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
1257  FreeL((ADDRESS)ch);
1258  FreeL((ADDRESS)var);
1259  FreeL((ADDRESS)ord);
1260  return res;
1261}
1262
1263int rChar(ring r)
1264{
1265  if (r->ch==-1)
1266    return 0;
1267  if (r->parameter==NULL) /* Q, Fp */
1268    return r->ch;
1269  if (r->ch<0)           /* Fp(a)  */
1270    return -r->ch;
1271  if (r->ch==1)          /* Q(a)  */
1272    return 0;
1273  /*else*/               /* GF(p,n) */
1274  {
1275    if ((r->ch & 1)==0) return 2;
1276    int i=3;
1277    while ((r->ch % i)!=0) i+=2;
1278    return i;
1279  }
1280}
1281
1282int    rIsExtension(ring r)
1283{
1284  if (r->parameter==NULL) /* Q, Fp */
1285    return FALSE;
1286  else
1287    return TRUE;
1288}
1289
1290int    rIsExtension()
1291{
1292  return rIsExtension( currRing );
1293}
1294
1295/*2
1296 *returns -1 for not compatible, (sum is undefined)
1297 *         0 for equal, (and sum)
1298 *         1 for compatible (and sum)
1299 */
1300int rSum(ring r1, ring r2, ring &sum)
1301{
1302  if (r1==r2)
1303  {
1304    sum=r1;
1305    r1->ref++;
1306    return 0;
1307  }
1308  ip_sring tmpR;
1309  memset(&tmpR,0,sizeof(tmpR));
1310  /* check coeff. field =====================================================*/
1311  if (rInternalChar(r1)==rInternalChar(r2))
1312  {
1313    tmpR.ch=rInternalChar(r1);
1314    if (rField_is_Q(r1)||rField_is_Zp(r1)||rField_is_GF(r1)) /*Q, Z/p, GF(p,n)*/
1315    {
1316      if (r1->parameter!=NULL)
1317      {
1318        if (strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1319        {
1320          tmpR.parameter=(char **)Alloc(sizeof(char *));
1321          tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1322          tmpR.P=1;
1323        }
1324        else
1325        {
1326          WerrorS("GF(p,n)+GF(p,n)");
1327          return -1;
1328        }
1329      }
1330    }
1331    else if ((r1->ch==1)||(r1->ch<-1)) /* Q(a),Z/p(a) */
1332    {
1333      if (r1->minpoly!=NULL)
1334      {
1335        if (r2->minpoly!=NULL)
1336        {
1337          nSetChar(rInternalChar(r1),TRUE,r1->parameter,rPar(r1));
1338          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1339              && naEqual(r1->minpoly,r2->minpoly))
1340          {
1341            tmpR.parameter=(char **)Alloc(sizeof(char *));
1342            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1343            tmpR.minpoly=naCopy(r1->minpoly);
1344            tmpR.P=1;
1345            nSetChar(rInternalChar(currRing),TRUE,currRing->parameter,
1346              rPar(currRing));
1347          }
1348          else
1349          {
1350            nSetChar(rInternalChar(currRing),TRUE,currRing->parameter,
1351              rPar(currRing));
1352            WerrorS("different minpolys");
1353            return -1;
1354          }
1355        }
1356        else
1357        {
1358          if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1359              && (rPar(r2)==1))
1360          {
1361            tmpR.parameter=(char **)Alloc0(sizeof(char *));
1362            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1363            tmpR.P=1;
1364            nSetChar(rInternalChar(r1),TRUE,r1->parameter,rPar(r1));
1365            tmpR.minpoly=naCopy(r1->minpoly);
1366            nSetChar(rInternalChar(currRing),TRUE,currRing->parameter,
1367              rPar(currRing));
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              && (rPar(r1)==1))
1382          {
1383            tmpR.parameter=(char **)Alloc(sizeof(char *));
1384            tmpR.parameter[0]=mstrdup(r1->parameter[0]);
1385            tmpR.P=1;
1386            nSetChar(rInternalChar(r2),TRUE,r2->parameter,rPar(r2));
1387            tmpR.minpoly=naCopy(r2->minpoly);
1388            nSetChar(rInternalChar(currRing),TRUE,currRing->parameter,
1389              rPar(currRing));
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<rPar(r1);i++)
1403          {
1404            tmpR.parameter[i]=mstrdup(r1->parameter[i]);
1405          }
1406          int j,l;
1407          for(j=0;j<rPar(r2);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=rInternalChar(r1);
1436        tmpR.parameter=(char **)Alloc(rPar(r1)*sizeof(char *));
1437        tmpR.P=rPar(r1);
1438        memcpy(tmpR.parameter,r1->parameter,rPar(r1)*sizeof(char *));
1439        if (r1->minpoly!=NULL)
1440        {
1441          nSetChar(rInternalChar(r1),TRUE,r1->parameter,rPar(r1));
1442          tmpR.minpoly=naCopy(r1->minpoly);
1443          nSetChar(rInternalChar(currRing),TRUE,currRing->parameter,
1444            rPar(currRing));
1445        }
1446      }
1447      else  /* R, Q(a),Z/q,Z/p(a),GF(p,n) */
1448      {
1449        WerrorS("Z/p(a)+(R,Q(a),Z/q(a),GF(q,n))");
1450        return -1;
1451      }
1452    }
1453    else if (r1->ch==-1) /* R */
1454    {
1455      WerrorS("R+..");
1456      return -1;
1457    }
1458    else if (r1->ch==0) /* Q */
1459    {
1460      if ((r2->ch<-1)||(r2->ch==1)) /* Z/p(a),Q(a) */
1461      {
1462        tmpR.ch=rInternalChar(r2);
1463        tmpR.P=rPar(r2);
1464        tmpR.parameter=(char **)Alloc(rPar(r2)*sizeof(char *));
1465        memcpy(tmpR.parameter,r2->parameter,rPar(r2)*sizeof(char *));
1466        if (r2->minpoly!=NULL)
1467        {
1468          nSetChar(rInternalChar(r1),TRUE,r1->parameter,rPar(r1));
1469          tmpR.minpoly=naCopy(r2->minpoly);
1470          nSetChar(rInternalChar(currRing),TRUE,currRing->parameter,
1471            rPar(currRing));
1472        }
1473      }
1474      else if (r2->ch>1) /* Z/p,GF(p,n) */
1475      {
1476        tmpR.ch=r2->ch;
1477        if (r2->parameter!=NULL)
1478        {
1479          tmpR.parameter=(char **)Alloc(sizeof(char *));
1480          tmpR.P=1;
1481          tmpR.parameter[0]=mstrdup(r2->parameter[0]);
1482        }
1483      }
1484      else
1485      {
1486        WerrorS("Q+R");
1487        return -1; /* R */
1488      }
1489    }
1490    else if (r1->ch==1) /* Q(a) */
1491    {
1492      if (r2->ch==0) /* Q */
1493      {
1494        tmpR.ch=rInternalChar(r1);
1495        tmpR.P=rPar(r1);
1496        tmpR.parameter=(char **)Alloc0(rPar(r1)*sizeof(char *));
1497        int i;
1498        for(i=0;i<rPar(r1);i++)
1499        {
1500          tmpR.parameter[i]=mstrdup(r1->parameter[i]);
1501        }
1502        if (r1->minpoly!=NULL)
1503        {
1504          nSetChar(rInternalChar(r1),TRUE,r1->parameter,rPar(r1));
1505          tmpR.minpoly=naCopy(r1->minpoly);
1506          nSetChar(rInternalChar(currRing),TRUE,currRing->parameter,
1507            rPar(currRing));
1508        }
1509      }
1510      else  /* R, Z/p,GF(p,n) */
1511      {
1512        WerrorS("Q(a)+(R,Z/p,GF(p,n))");
1513        return -1;
1514      }
1515    }
1516    else /* r1->ch >=2 , Z/p */
1517    {
1518      if (r2->ch==0) /* Q */
1519      {
1520        tmpR.ch=r1->ch;
1521      }
1522      else if (r2->ch==-r1->ch) /* Z/p(a) */
1523      {
1524        tmpR.ch=rInternalChar(r2);
1525        tmpR.P=rPar(r2);
1526        tmpR.parameter=(char **)Alloc(rPar(r2)*sizeof(char *));
1527        int i;
1528        for(i=0;i<rPar(r2);i++)
1529        {
1530          tmpR.parameter[i]=mstrdup(r2->parameter[i]);
1531        }
1532        if (r2->minpoly!=NULL)
1533        {
1534          nSetChar(rInternalChar(r2),TRUE,r2->parameter,rPar(r2));
1535          tmpR.minpoly=naCopy(r2->minpoly);
1536          nSetChar(rInternalChar(currRing),TRUE,currRing->parameter,
1537            rPar(currRing));
1538        }
1539      }
1540      else
1541      {
1542        WerrorS("Z/p+(GF(q,n),Z/q(a),R,Q(a))");
1543        return -1; /* GF(p,n),Z/q(a),R,Q(a) */
1544      }
1545    }
1546  }
1547  /* variable names ========================================================*/
1548  int i,j,k;
1549  int l=r1->N+r2->N;
1550  char **names=(char **)Alloc0(l*sizeof(char*));
1551  k=0;
1552
1553  // collect all varnames from r1, except those which are parameters
1554  // of r2, or those which are the empty string
1555  for (i=0;i<r1->N;i++)
1556  {
1557    BOOLEAN b=TRUE;
1558
1559    if (*(r1->names[i]) == '\0')
1560      b = FALSE;
1561    else if ((r2->parameter!=NULL) && (strlen(r1->names[i])==1))
1562    {
1563      for(j=0;j<rPar(r2);j++)
1564      {
1565        if (strcmp(r1->names[i],r2->parameter[j])==0)
1566        {
1567          b=FALSE;
1568          break;
1569        }
1570      }
1571    }
1572
1573    if (b)
1574    {
1575      //Print("name : %d: %s\n",k,r1->names[i]);
1576      names[k]=mstrdup(r1->names[i]);
1577      k++;
1578    }
1579    //else
1580    //  Print("no name (par1) %s\n",r1->names[i]);
1581  }
1582  // Add variables from r2, except those which are parameters of r1
1583  // those which are empty strings, and those which equal a var of r1
1584  for(i=0;i<r2->N;i++)
1585  {
1586    BOOLEAN b=TRUE;
1587
1588    if (*(r2->names[i]) == '\0')
1589      b = FALSE;
1590    else if ((r1->parameter!=NULL) && (strlen(r2->names[i])==1))
1591    {
1592      for(j=0;j<rPar(r1);j++)
1593      {
1594        if (strcmp(r2->names[i],r1->parameter[j])==0)
1595        {
1596          b=FALSE;
1597          break;
1598        }
1599      }
1600    }
1601
1602    if (b)
1603    {
1604      for(j=0;j<r1->N;j++)
1605      {
1606        if (strcmp(r1->names[j],r2->names[i])==0)
1607        {
1608          b=FALSE;
1609          break;
1610        }
1611      }
1612      if (b)
1613      {
1614        names[k]=mstrdup(r2->names[i]);
1615        //Print("name : %d : %s\n",k,r2->names[i]);
1616        k++;
1617      }
1618      //else
1619      //  Print("no name (var): %s\n",r2->names[i]);
1620    }
1621    //else
1622    //  Print("no name (par): %s\n",r2->names[i]);
1623  }
1624  // check whether we found any vars at all
1625  if (k == 0)
1626  {
1627    names[k]=mstrdup("");
1628    k=1;
1629  }
1630  tmpR.N=k;
1631  tmpR.names=names;
1632  /* ordering *======================================================== */
1633  tmpR.OrdSgn=1;
1634  if ((r1->order[0]==ringorder_unspec)
1635      && (r2->order[0]==ringorder_unspec))
1636  {
1637    tmpR.order=(int*)Alloc(3*sizeof(int));
1638    tmpR.block0=(int*)Alloc(3*sizeof(int));
1639    tmpR.block1=(int*)Alloc(3*sizeof(int));
1640    tmpR.wvhdl=(short**)Alloc0(3*sizeof(short*));
1641    tmpR.order[0]=ringorder_unspec;
1642    tmpR.order[1]=ringorder_C;
1643    tmpR.order[2]=0;
1644    tmpR.block0[0]=1;
1645    tmpR.block1[0]=tmpR.N;
1646  }
1647  else if (l==k) /* r3=r1+r2 */
1648  {
1649    int b;
1650    ring rb;
1651    if (r1->order[0]==ringorder_unspec)
1652    {
1653      /* extend order of r2 to r3 */
1654      b=rBlocks(r2);
1655      rb=r2;
1656      tmpR.OrdSgn=r2->OrdSgn;
1657    }
1658    else if (r2->order[0]==ringorder_unspec)
1659    {
1660      /* extend order of r1 to r3 */
1661      b=rBlocks(r1);
1662      rb=r1;
1663      tmpR.OrdSgn=r1->OrdSgn;
1664    }
1665    else
1666    {
1667      b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
1668      rb=NULL;
1669    }
1670    tmpR.order=(int*)Alloc0(b*sizeof(int));
1671    tmpR.block0=(int*)Alloc0(b*sizeof(int));
1672    tmpR.block1=(int*)Alloc0(b*sizeof(int));
1673    tmpR.wvhdl=(short**)Alloc0(b*sizeof(short*));
1674    /* weights not implemented yet ...*/
1675    if (rb!=NULL)
1676    {
1677      for (i=0;i<b;i++)
1678      {
1679        tmpR.order[i]=rb->order[i];
1680        tmpR.block0[i]=rb->block0[i];
1681        tmpR.block1[i]=rb->block1[i];
1682      }
1683      tmpR.block0[0]=1;
1684    }
1685    else /* ring sum for complete rings */
1686    {
1687      for (i=0;r1->order[i]!=0;i++)
1688      {
1689        tmpR.order[i]=r1->order[i];
1690        tmpR.block0[i]=r1->block0[i];
1691        tmpR.block1[i]=r1->block1[i];
1692      }
1693      j=i;
1694      i--;
1695      if ((r1->order[i]==ringorder_c)
1696          ||(r1->order[i]==ringorder_C))
1697      {
1698        j--;
1699        tmpR.order[b-2]=r1->order[i];
1700      }
1701      for (i=0;r2->order[i]!=0;i++,j++)
1702      {
1703        if ((r2->order[i]!=ringorder_c)
1704            &&(r2->order[i]!=ringorder_C))
1705        {
1706          tmpR.order[j]=r2->order[i];
1707          tmpR.block0[j]=r2->block0[i]+r1->N;
1708          tmpR.block1[j]=r2->block1[i]+r1->N;
1709        }
1710      }
1711      if((r1->OrdSgn==-1)||(r2->OrdSgn==-1))
1712        tmpR.OrdSgn=-1;
1713    }
1714  }
1715  else if ((k==r1->N) && (k==r2->N)) /* r1 and r2 are "quite" the same ring */
1716    /* copy r1, because we have the variables from r1 */
1717  {
1718    int b=rBlocks(r1);
1719
1720    tmpR.order=(int*)Alloc0(b*sizeof(int));
1721    tmpR.block0=(int*)Alloc0(b*sizeof(int));
1722    tmpR.block1=(int*)Alloc0(b*sizeof(int));
1723    tmpR.wvhdl=(short**)Alloc0(b*sizeof(short*));
1724    /* weights not implemented yet ...*/
1725    for (i=0;i<b;i++)
1726    {
1727      tmpR.order[i]=r1->order[i];
1728      tmpR.block0[i]=r1->block0[i];
1729      tmpR.block1[i]=r1->block1[i];
1730    }
1731    tmpR.OrdSgn=r1->OrdSgn;
1732  }
1733  else
1734  {
1735    for(i=0;i<k;i++) FreeL((ADDRESS)tmpR.names[i]);
1736    Free((ADDRESS)names,tmpR.N*sizeof(char *));
1737    Werror("difficulties with variables: %d,%d -> %d",r1->N,r2->N,k);
1738    return -1;
1739  }
1740  sum=(ring)Alloc(sizeof(ip_sring));
1741  memcpy(sum,&tmpR,sizeof(ip_sring));
1742  rComplete(sum);
1743  return 1;
1744}
1745
1746/*2
1747 * create a copy of the ring r, which must be equivalent to currRing
1748 * used for qring definition,..
1749 * (i.e.: normal rings: same nCopy as currRing;
1750 *        qring:        same nCopy, same idCopy as currRing)
1751 */
1752ring rCopy(ring r)
1753{
1754  int i,j;
1755  int *pi;
1756  ring res=(ring)Alloc(sizeof(ip_sring));
1757
1758  memcpy4(res,r,sizeof(ip_sring));
1759  res->ref=0;
1760  if (r->parameter!=NULL)
1761  {
1762    res->minpoly=nCopy(r->minpoly);
1763    int l=rPar(r);
1764    res->parameter=(char **)Alloc(l*sizeof(char *));
1765    int i;
1766    for(i=0;i<rPar(r);i++)
1767    {
1768      res->parameter[i]=mstrdup(r->parameter[i]);
1769    }
1770  }
1771  res->names   = (char **)Alloc(r->N * sizeof(char *));
1772  i=1;
1773  pi=r->order;
1774  while ((*pi)!=0) { i++;pi++; }
1775  res->wvhdl   = (short **)Alloc(i * sizeof(short *));
1776  res->order   = (int *)   Alloc(i * sizeof(int));
1777  res->block0  = (int *)   Alloc(i * sizeof(int));
1778  res->block1  = (int *)   Alloc(i * sizeof(int));
1779  for (j=0; j<i; j++)
1780  {
1781    if (r->wvhdl[j]!=NULL)
1782    {
1783      res->wvhdl[j]=(short*)AllocL(mmSizeL((ADDRESS)r->wvhdl[j]));
1784      memcpy(res->wvhdl[j],r->wvhdl[j],mmSizeL((ADDRESS)r->wvhdl[j]));
1785    }
1786    else
1787      res->wvhdl[j]=NULL;
1788  }
1789  memcpy4(res->order,r->order,i * sizeof(int));
1790  memcpy4(res->block0,r->block0,i * sizeof(int));
1791  memcpy4(res->block1,r->block1,i * sizeof(int));
1792  for (i=0; i<res->N; i++)
1793  {
1794    res->names[i] = mstrdup(r->names[i]);
1795  }
1796  res->idroot = NULL;
1797  if (r->qideal!=NULL) res->qideal= idCopy(r->qideal);
1798  res->VarOffset = (int*) Alloc((r->N + 1)*sizeof(int));
1799  memcpy4(res->VarOffset, r->VarOffset, (r->N + 1)*sizeof(int));
1800
1801#ifdef RDEBUG
1802  rNumber++;
1803  res->no=rNumber;
1804#endif
1805
1806  return res;
1807}
1808
1809rOrderType_t rGetOrderType(ring r)
1810{
1811  // check for simple ordering
1812  if (rHasSimpleOrder(r))
1813  {
1814    if ((r->order[1] == ringorder_c) || (r->order[1] == ringorder_C))
1815    {
1816      switch(r->order[0])
1817      {
1818          case ringorder_dp:
1819          case ringorder_wp:
1820          case ringorder_ds:
1821          case ringorder_ws:
1822          case ringorder_ls:
1823          case ringorder_unspec:
1824            if (r->order[1] == ringorder_C ||  r->order[0] == ringorder_unspec)
1825              return rOrderType_ExpComp;
1826            return rOrderType_Exp;
1827
1828          default:
1829            assume(r->order[0] == ringorder_lp ||
1830                   r->order[0] == ringorder_Dp ||
1831                   r->order[0] == ringorder_Wp ||
1832                   r->order[0] == ringorder_Ds ||
1833                   r->order[0] == ringorder_Ws);
1834
1835            if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1836            return rOrderType_Exp;
1837      }
1838    }
1839    else
1840    {
1841      assume((r->order[0]==ringorder_c)||(r->order[0]==ringorder_C));
1842      return rOrderType_CompExp;
1843    }
1844  }
1845  else
1846    return rOrderType_General;
1847}
1848
1849BOOLEAN rHasSimpleOrder(ring r)
1850{
1851  return
1852    (r->order[0] == ringorder_unspec) ||
1853    ((r->order[2] == 0) &&
1854     (r->order[1] != ringorder_M &&
1855      r->order[0] != ringorder_M));
1856}
1857
1858// returns TRUE, if simple lp or ls ordering
1859BOOLEAN rHasSimpleLexOrder(ring r)
1860{
1861  return rHasSimpleOrder(r) &&
1862    (r->order[0] == ringorder_ls ||
1863     r->order[0] == ringorder_lp ||
1864     r->order[1] == ringorder_ls ||
1865     r->order[1] == ringorder_lp);
1866}
1867
1868BOOLEAN rIsPolyVar(int v)
1869{
1870  int  i=0;
1871  while(currRing->order[i]!=0)
1872  {
1873    if((currRing->block0[i]<=v)
1874    && (currRing->block1[i]>=v))
1875    {
1876      switch(currRing->order[i])
1877      {
1878        case ringorder_a:
1879          return (currRing->wvhdl[i][v-currRing->block0[i]]>0);
1880        case ringorder_M:
1881          return 2; /*don't know*/
1882        case ringorder_lp:
1883        case ringorder_dp:
1884        case ringorder_Dp:
1885        case ringorder_wp:
1886        case ringorder_Wp:
1887          return TRUE;
1888        case ringorder_ls:
1889        case ringorder_ds:
1890        case ringorder_Ds:
1891        case ringorder_ws:
1892        case ringorder_Ws:
1893          return FALSE;
1894        default:
1895          break;
1896      }
1897    }
1898    i++;
1899  }
1900  return 3; /* could not find var v*/
1901}
1902
1903void rUnComplete(ring r)
1904{
1905  Free((ADDRESS)r->VarOffset,(r->N + 1)*sizeof(int));
1906  r->VarOffset=NULL;
1907}
1908
1909#ifdef RDEBUG
1910// This should eventually become a full-fledge ring check, like pTest
1911BOOLEAN rDBTest(ring r, char* fn, int l)
1912{
1913  if (r == NULL)
1914  {
1915    Werror("Null ring in %s:%l\n", fn, l);
1916    return false;
1917  }
1918
1919  if (r->N == 0) return true;
1920
1921  if (r->VarOffset == NULL)
1922  {
1923    Werror("Null ring VarOffset -- no rComplete (?) in n %s:%d\n", fn, l);
1924    assume(0);
1925    return false;
1926  }
1927
1928  int
1929    VarCompIndex = r->VarCompIndex,
1930    VarLowIndex  = r->VarLowIndex,
1931    VarHighIndex = r->VarHighIndex,
1932    i;
1933  BOOLEAN ok = false;
1934  int* VarOffset = r->VarOffset;
1935
1936  rComplete(r);
1937
1938  if (   VarCompIndex != r->VarCompIndex ||
1939         VarLowIndex  != r->VarLowIndex ||
1940         VarHighIndex != r->VarHighIndex)
1941  {
1942    Werror("Wrong ring VarIndicies -- no rComplete (?) in n %s:%d\n", fn, l);
1943    assume(0);
1944    ok = FALSE;
1945  }
1946
1947  for (i=0; i<=r->N; i++)
1948  {
1949    if (VarOffset[i] != r->VarOffset[i])
1950    {
1951      Werror("Wrong VarOffset value at %d in %s:%d\n", i, fn, l);
1952      assume(0);
1953      ok = FALSE;
1954    }
1955  }
1956  Free(r->VarOffset, (r->N + 1)*sizeof(int));
1957  r->VarOffset = VarOffset;
1958  return ok;
1959}
1960#endif
Note: See TracBrowser for help on using the repository browser.