source: git/Singular/ring.cc @ 17e692

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