source: git/Singular/ring.cc @ 18255d

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