My Project
ipshell.cc
Go to the documentation of this file.
1 /****************************************
2 * Computer Algebra System SINGULAR *
3 ****************************************/
4 /*
5 * ABSTRACT:
6 */
7 
8 #include "kernel/mod2.h"
9 
10 #include "factory/factory.h"
11 
12 #include "misc/options.h"
13 #include "misc/mylimits.h"
14 #include "misc/intvec.h"
15 #include "misc/prime.h"
16 
17 #include "coeffs/numbers.h"
18 #include "coeffs/coeffs.h"
19 
20 #include "coeffs/rmodulon.h"
21 #include "coeffs/longrat.h"
22 
24 #include "polys/monomials/ring.h"
25 #include "polys/monomials/maps.h"
26 
27 #include "polys/prCopy.h"
28 #include "polys/matpol.h"
29 
30 #include "polys/shiftop.h"
31 #include "polys/weight.h"
32 #include "polys/clapsing.h"
33 
34 
37 
38 #include "kernel/polys.h"
39 #include "kernel/ideals.h"
40 
43 
44 #include "kernel/GBEngine/syz.h"
45 #include "kernel/GBEngine/kstd1.h"
46 #include "kernel/GBEngine/kutil.h" // denominator_list
47 
50 
51 #include "kernel/spectrum/semic.h"
52 #include "kernel/spectrum/splist.h"
54 
56 
57 #include "Singular/lists.h"
58 #include "Singular/attrib.h"
59 #include "Singular/ipconv.h"
60 #include "Singular/links/silink.h"
61 #include "Singular/ipshell.h"
62 #include "Singular/maps_ip.h"
63 #include "Singular/tok.h"
64 #include "Singular/ipid.h"
65 #include "Singular/subexpr.h"
66 #include "Singular/fevoices.h"
67 #include "Singular/sdb.h"
68 
69 #include <cmath>
70 #include <ctype.h>
71 
72 #include "kernel/maps/gen_maps.h"
73 
74 #include "polys/clapsing.h"
75 
76 #ifdef SINGULAR_4_2
77 #include "Singular/number2.h"
78 #include "coeffs/bigintmat.h"
79 #endif
82 const char *lastreserved=NULL;
83 
85 
86 /*0 implementation*/
87 
88 const char * iiTwoOps(int t)
89 {
90  if (t<127)
91  {
92  STATIC_VAR char ch[2];
93  switch (t)
94  {
95  case '&':
96  return "and";
97  case '|':
98  return "or";
99  default:
100  ch[0]=t;
101  ch[1]='\0';
102  return ch;
103  }
104  }
105  switch (t)
106  {
107  case COLONCOLON: return "::";
108  case DOTDOT: return "..";
109  //case PLUSEQUAL: return "+=";
110  //case MINUSEQUAL: return "-=";
111  case MINUSMINUS: return "--";
112  case PLUSPLUS: return "++";
113  case EQUAL_EQUAL: return "==";
114  case LE: return "<=";
115  case GE: return ">=";
116  case NOTEQUAL: return "<>";
117  default: return Tok2Cmdname(t);
118  }
119 }
120 
121 int iiOpsTwoChar(const char *s)
122 {
123 /* not handling: &&, ||, ** */
124  if (s[1]=='\0') return s[0];
125  else if (s[2]!='\0') return 0;
126  switch(s[0])
127  {
128  case '.': if (s[1]=='.') return DOTDOT;
129  else return 0;
130  case ':': if (s[1]==':') return COLONCOLON;
131  else return 0;
132  case '-': if (s[1]=='-') return MINUSMINUS;
133  else return 0;
134  case '+': if (s[1]=='+') return PLUSPLUS;
135  else return 0;
136  case '=': if (s[1]=='=') return EQUAL_EQUAL;
137  else return 0;
138  case '<': if (s[1]=='=') return LE;
139  else if (s[1]=='>') return NOTEQUAL;
140  else return 0;
141  case '>': if (s[1]=='=') return GE;
142  else return 0;
143  case '!': if (s[1]=='=') return NOTEQUAL;
144  else return 0;
145  }
146  return 0;
147 }
148 
149 static void list1(const char* s, idhdl h,BOOLEAN c, BOOLEAN fullname)
150 {
151  char buffer[22];
152  int l;
153  char buf2[128];
154 
155  if(fullname) sprintf(buf2, "%s::%s", "", IDID(h));
156  else sprintf(buf2, "%s", IDID(h));
157 
158  Print("%s%-30.30s [%d] ",s,buf2,IDLEV(h));
159  if (h == currRingHdl) PrintS("*");
160  PrintS(Tok2Cmdname((int)IDTYP(h)));
161 
162  ipListFlag(h);
163  switch(IDTYP(h))
164  {
165  case ALIAS_CMD: Print(" for %s",IDID((idhdl)IDDATA(h))); break;
166  case INT_CMD: Print(" %d",IDINT(h)); break;
167  case INTVEC_CMD:Print(" (%d)",IDINTVEC(h)->length()); break;
168  case INTMAT_CMD:Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
169  break;
170  case POLY_CMD:
171  case VECTOR_CMD:if (c)
172  {
173  PrintS(" ");wrp(IDPOLY(h));
174  if(IDPOLY(h) != NULL)
175  {
176  Print(", %d monomial(s)",pLength(IDPOLY(h)));
177  }
178  }
179  break;
180  case MODUL_CMD: Print(", rk %d", (int)(IDIDEAL(h)->rank));// and continue
181  case IDEAL_CMD: Print(", %u generator(s)",
182  IDELEMS(IDIDEAL(h))); break;
183  case MAP_CMD:
184  Print(" from %s",IDMAP(h)->preimage); break;
185  case MATRIX_CMD:Print(" %u x %u"
186  ,MATROWS(IDMATRIX(h))
187  ,MATCOLS(IDMATRIX(h))
188  );
189  break;
190  case SMATRIX_CMD:Print(" %u x %u"
191  ,(int)(IDIDEAL(h)->rank)
192  ,IDELEMS(IDIDEAL(h))
193  );
194  break;
195  case PACKAGE_CMD:
196  paPrint(IDID(h),IDPACKAGE(h));
197  break;
198  case PROC_CMD: if((IDPROC(h)->libname!=NULL)
199  && (strlen(IDPROC(h)->libname)>0))
200  Print(" from %s",IDPROC(h)->libname);
201  if(IDPROC(h)->language==LANG_C)
202  PrintS(" (C)");
203  if(IDPROC(h)->is_static)
204  PrintS(" (static)");
205  break;
206  case STRING_CMD:
207  {
208  char *s;
209  l=strlen(IDSTRING(h));
210  memset(buffer,0,sizeof(buffer));
211  strncpy(buffer,IDSTRING(h),si_min(l,20));
212  if ((s=strchr(buffer,'\n'))!=NULL)
213  {
214  *s='\0';
215  }
216  PrintS(" ");
217  PrintS(buffer);
218  if((s!=NULL) ||(l>20))
219  {
220  Print("..., %d char(s)",l);
221  }
222  break;
223  }
224  case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
225  break;
226  case RING_CMD:
227  if ((IDRING(h)==currRing) && (currRingHdl!=h))
228  PrintS("(*)"); /* this is an alias to currRing */
229  //Print(" ref:%d",IDRING(h)->ref);
230 #ifdef RDEBUG
232  Print(" <%lx>",(long)(IDRING(h)));
233 #endif
234  break;
235 #ifdef SINGULAR_4_2
236  case CNUMBER_CMD:
237  { number2 n=(number2)IDDATA(h);
238  Print(" (%s)",nCoeffName(n->cf));
239  break;
240  }
241  case CMATRIX_CMD:
242  { bigintmat *b=(bigintmat*)IDDATA(h);
243  Print(" %d x %d (%s)",
244  b->rows(),b->cols(),
245  nCoeffName(b->basecoeffs()));
246  break;
247  }
248 #endif
249  /*default: break;*/
250  }
251  PrintLn();
252 }
253 
255 {
256  BOOLEAN oldShortOut = FALSE;
257 
258  if (currRing != NULL)
259  {
260  oldShortOut = currRing->ShortOut;
261  currRing->ShortOut = 1;
262  }
263  int t=v->Typ();
264  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
265  switch (t)
266  {
267  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
268  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
269  ((intvec*)(v->Data()))->cols()); break;
270  case MATRIX_CMD:Print(" %u x %u\n" ,
271  MATROWS((matrix)(v->Data())),
272  MATCOLS((matrix)(v->Data())));break;
273  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
274  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
275 
276  case PROC_CMD:
277  case RING_CMD:
278  case IDEAL_CMD: PrintLn(); break;
279 
280  //case INT_CMD:
281  //case STRING_CMD:
282  //case INTVEC_CMD:
283  //case POLY_CMD:
284  //case VECTOR_CMD:
285  //case PACKAGE_CMD:
286 
287  default:
288  break;
289  }
290  v->Print();
291  if (currRing != NULL)
292  currRing->ShortOut = oldShortOut;
293 }
294 
295 static void killlocals0(int v, idhdl * localhdl, const ring r)
296 {
297  idhdl h = *localhdl;
298  while (h!=NULL)
299  {
300  int vv;
301  //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
302  if ((vv=IDLEV(h))>0)
303  {
304  if (vv < v)
305  {
306  if (iiNoKeepRing)
307  {
308  //PrintS(" break\n");
309  return;
310  }
311  h = IDNEXT(h);
312  //PrintLn();
313  }
314  else //if (vv >= v)
315  {
316  idhdl nexth = IDNEXT(h);
317  killhdl2(h,localhdl,r);
318  h = nexth;
319  //PrintS("kill\n");
320  }
321  }
322  else
323  {
324  h = IDNEXT(h);
325  //PrintLn();
326  }
327  }
328 }
329 
330 void killlocals_rec(idhdl *root,int v, ring r)
331 {
332  idhdl h=*root;
333  while (h!=NULL)
334  {
335  if (IDLEV(h)>=v)
336  {
337 // Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
338  idhdl n=IDNEXT(h);
339  killhdl2(h,root,r);
340  h=n;
341  }
342  else if (IDTYP(h)==PACKAGE_CMD)
343  {
344  // Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
345  if (IDPACKAGE(h)!=basePack)
346  killlocals_rec(&(IDRING(h)->idroot),v,r);
347  h=IDNEXT(h);
348  }
349  else if (IDTYP(h)==RING_CMD)
350  {
351  if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
352  // we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
353  {
354  // Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
355  killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
356  }
357  h=IDNEXT(h);
358  }
359  else
360  {
361 // Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
362  h=IDNEXT(h);
363  }
364  }
365 }
367 {
368  if (L==NULL) return FALSE;
369  BOOLEAN changed=FALSE;
370  int n=L->nr;
371  for(;n>=0;n--)
372  {
373  leftv h=&(L->m[n]);
374  void *d=h->data;
375  if ((h->rtyp==RING_CMD)
376  && (((ring)d)->idroot!=NULL))
377  {
378  if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
379  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
380  }
381  else if (h->rtyp==LIST_CMD)
382  changed|=killlocals_list(v,(lists)d);
383  }
384  return changed;
385 }
386 void killlocals(int v)
387 {
388  BOOLEAN changed=FALSE;
389  idhdl sh=currRingHdl;
390  ring cr=currRing;
391  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
392  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
393 
394  killlocals_rec(&(basePack->idroot),v,currRing);
395 
397  {
398  int t=iiRETURNEXPR.Typ();
399  if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
400  {
402  if (((ring)h->data)->idroot!=NULL)
403  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
404  }
405  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
406  {
408  changed |=killlocals_list(v,(lists)h->data);
409  }
410  }
411  if (changed)
412  {
414  if (currRingHdl==NULL)
415  currRing=NULL;
416  else if(cr!=currRing)
417  rChangeCurrRing(cr);
418  }
419 
420  if (myynest<=1) iiNoKeepRing=TRUE;
421  //Print("end killlocals >= %d\n",v);
422  //listall();
423 }
424 
425 void list_cmd(int typ, const char* what, const char *prefix,BOOLEAN iterate, BOOLEAN fullname)
426 {
427  package savePack=currPack;
428  idhdl h,start;
429  BOOLEAN all = typ<0;
430  BOOLEAN really_all=FALSE;
431 
432  if ( typ==0 )
433  {
434  if (strcmp(what,"all")==0)
435  {
436  if (currPack!=basePack)
437  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
438  really_all=TRUE;
439  h=basePack->idroot;
440  }
441  else
442  {
443  h = ggetid(what);
444  if (h!=NULL)
445  {
446  if (iterate) list1(prefix,h,TRUE,fullname);
447  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
448  if ((IDTYP(h)==RING_CMD)
449  //|| (IDTYP(h)==PACKAGE_CMD)
450  )
451  {
452  h=IDRING(h)->idroot;
453  }
454  else if(IDTYP(h)==PACKAGE_CMD)
455  {
457  //Print("list_cmd:package\n");
458  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
459  h=IDPACKAGE(h)->idroot;
460  }
461  else
462  {
463  currPack=savePack;
464  return;
465  }
466  }
467  else
468  {
469  Werror("%s is undefined",what);
470  currPack=savePack;
471  return;
472  }
473  }
474  all=TRUE;
475  }
476  else if (RingDependend(typ))
477  {
478  h = currRing->idroot;
479  }
480  else
481  h = IDROOT;
482  start=h;
483  while (h!=NULL)
484  {
485  if ((all
486  && (IDTYP(h)!=PROC_CMD)
487  &&(IDTYP(h)!=PACKAGE_CMD)
488  &&(IDTYP(h)!=CRING_CMD)
489  )
490  || (typ == IDTYP(h))
491  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
492  )
493  {
494  list1(prefix,h,start==currRingHdl, fullname);
495  if ((IDTYP(h)==RING_CMD)
496  && (really_all || (all && (h==currRingHdl)))
497  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
498  {
499  list_cmd(0,IDID(h),"// ",FALSE);
500  }
501  if (IDTYP(h)==PACKAGE_CMD && really_all)
502  {
503  package save_p=currPack;
505  list_cmd(0,IDID(h),"// ",FALSE);
506  currPack=save_p;
507  }
508  }
509  h = IDNEXT(h);
510  }
511  currPack=savePack;
512 }
513 
514 void test_cmd(int i)
515 {
516  int ii;
517 
518  if (i<0)
519  {
520  ii= -i;
521  if (ii < 32)
522  {
523  si_opt_1 &= ~Sy_bit(ii);
524  }
525  else if (ii < 64)
526  {
527  si_opt_2 &= ~Sy_bit(ii-32);
528  }
529  else
530  WerrorS("out of bounds\n");
531  }
532  else if (i<32)
533  {
534  ii=i;
535  if (Sy_bit(ii) & kOptions)
536  {
537  WarnS("Gerhard, use the option command");
538  si_opt_1 |= Sy_bit(ii);
539  }
540  else if (Sy_bit(ii) & validOpts)
541  si_opt_1 |= Sy_bit(ii);
542  }
543  else if (i<64)
544  {
545  ii=i-32;
546  si_opt_2 |= Sy_bit(ii);
547  }
548  else
549  WerrorS("out of bounds\n");
550 }
551 
553 {
554  int rc = 0;
555  while (v!=NULL)
556  {
557  switch (v->Typ())
558  {
559  case INT_CMD:
560  case POLY_CMD:
561  case VECTOR_CMD:
562  case NUMBER_CMD:
563  rc++;
564  break;
565  case INTVEC_CMD:
566  case INTMAT_CMD:
567  rc += ((intvec *)(v->Data()))->length();
568  break;
569  case MATRIX_CMD:
570  case IDEAL_CMD:
571  case MODUL_CMD:
572  {
573  matrix mm = (matrix)(v->Data());
574  rc += mm->rows() * mm->cols();
575  }
576  break;
577  case LIST_CMD:
578  rc+=((lists)v->Data())->nr+1;
579  break;
580  default:
581  rc++;
582  }
583  v = v->next;
584  }
585  return rc;
586 }
587 
589 {
590  sleftv vf;
591  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
592  {
593  WerrorS("link expected");
594  return TRUE;
595  }
596  si_link l=(si_link)vf.Data();
597  if (vf.next == NULL)
598  {
599  WerrorS("write: need at least two arguments");
600  return TRUE;
601  }
602 
603  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
604  if (b)
605  {
606  const char *s;
607  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
608  else s=sNoName_fe;
609  Werror("cannot write to %s",s);
610  }
611  vf.CleanUp();
612  return b;
613 }
614 
615 leftv iiMap(map theMap, const char * what)
616 {
617  idhdl w,r;
618  leftv v;
619  int i;
620  nMapFunc nMap;
621 
622  r=IDROOT->get(theMap->preimage,myynest);
623  if ((currPack!=basePack)
624  &&((r==NULL) || ((r->typ != RING_CMD) )))
625  r=basePack->idroot->get(theMap->preimage,myynest);
626  if ((r==NULL) && (currRingHdl!=NULL)
627  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
628  {
629  r=currRingHdl;
630  }
631  if ((r!=NULL) && (r->typ == RING_CMD))
632  {
633  ring src_ring=IDRING(r);
634  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
635  {
636  Werror("can not map from ground field of %s to current ground field",
637  theMap->preimage);
638  return NULL;
639  }
640  if (IDELEMS(theMap)<src_ring->N)
641  {
642  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
643  IDELEMS(theMap)*sizeof(poly),
644  (src_ring->N)*sizeof(poly));
645 #ifdef HAVE_SHIFTBBA
646  if (rIsLPRing(src_ring))
647  {
648  // src_ring [x,y,z,...]
649  // curr_ring [a,b,c,...]
650  //
651  // map=[a,b,c,d] -> [a,b,c,...]
652  // map=[a,b] -> [a,b,0,...]
653 
654  short src_lV = src_ring->isLPring;
655  short src_ncGenCount = src_ring->LPncGenCount;
656  short src_nVars = src_lV - src_ncGenCount;
657  int src_nblocks = src_ring->N / src_lV;
658 
659  short dest_nVars = currRing->isLPring - currRing->LPncGenCount;
660  short dest_ncGenCount = currRing->LPncGenCount;
661 
662  // add missing NULL generators
663  for(i=IDELEMS(theMap); i < src_lV - src_ncGenCount; i++)
664  {
665  theMap->m[i]=NULL;
666  }
667 
668  // remove superfluous generators
669  for(i = src_nVars; i < IDELEMS(theMap); i++)
670  {
671  if (theMap->m[i] != NULL)
672  {
673  p_Delete(&(theMap->m[i]), currRing);
674  theMap->m[i] = NULL;
675  }
676  }
677 
678  // add ncgen mappings
679  for(i = src_nVars; i < src_lV; i++)
680  {
681  short ncGenIndex = i - src_nVars;
682  if (ncGenIndex < dest_ncGenCount)
683  {
684  poly p = p_One(currRing);
685  p_SetExp(p, dest_nVars + ncGenIndex + 1, 1, currRing);
686  p_Setm(p, currRing);
687  theMap->m[i] = p;
688  }
689  else
690  {
691  theMap->m[i] = NULL;
692  }
693  }
694 
695  // copy the first block to all other blocks
696  for(i = 1; i < src_nblocks; i++)
697  {
698  for(int j = 0; j < src_lV; j++)
699  {
700  theMap->m[(i * src_lV) + j] = p_Copy(theMap->m[j], currRing);
701  }
702  }
703  }
704  else
705  {
706 #endif
707  for(i=IDELEMS(theMap);i<src_ring->N;i++)
708  theMap->m[i]=NULL;
709 #ifdef HAVE_SHIFTBBA
710  }
711 #endif
712  IDELEMS(theMap)=src_ring->N;
713  }
714  if (what==NULL)
715  {
716  WerrorS("argument of a map must have a name");
717  }
718  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
719  {
720  char *save_r=NULL;
722  sleftv tmpW;
723  tmpW.Init();
724  tmpW.rtyp=IDTYP(w);
725  if (tmpW.rtyp==MAP_CMD)
726  {
727  tmpW.rtyp=IDEAL_CMD;
728  save_r=IDMAP(w)->preimage;
729  IDMAP(w)->preimage=0;
730  }
731  tmpW.data=IDDATA(w);
732  // check overflow
733  BOOLEAN overflow=FALSE;
734  if ((tmpW.rtyp==IDEAL_CMD)
735  || (tmpW.rtyp==MODUL_CMD)
736  || (tmpW.rtyp==MAP_CMD))
737  {
738  ideal id=(ideal)tmpW.data;
739  long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
740  for(int i=IDELEMS(id)-1;i>=0;i--)
741  {
742  poly p=id->m[i];
743  if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
744  else degs[i]=0;
745  }
746  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
747  {
748  if (theMap->m[j]!=NULL)
749  {
750  long deg_monexp=pTotaldegree(theMap->m[j]);
751 
752  for(int i=IDELEMS(id)-1;i>=0;i--)
753  {
754  poly p=id->m[i];
755  if ((p!=NULL) && (degs[i]!=0) &&
756  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
757  {
758  overflow=TRUE;
759  break;
760  }
761  }
762  }
763  }
764  omFreeSize(degs,IDELEMS(id)*sizeof(long));
765  }
766  else if (tmpW.rtyp==POLY_CMD)
767  {
768  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
769  {
770  if (theMap->m[j]!=NULL)
771  {
772  long deg_monexp=pTotaldegree(theMap->m[j]);
773  poly p=(poly)tmpW.data;
774  long deg=0;
775  if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
776  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
777  {
778  overflow=TRUE;
779  break;
780  }
781  }
782  }
783  }
784  if (overflow)
785 #ifdef HAVE_SHIFTBBA
786  // in Letterplace rings the exponent is always 0 or 1! ignore this warning.
787  if (!rIsLPRing(currRing))
788  {
789 #endif
790  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
791 #ifdef HAVE_SHIFTBBA
792  }
793 #endif
794 #if 0
795  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
796  {
797  v->rtyp=tmpW.rtyp;
798  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
799  }
800  else
801 #endif
802  {
803  if ((tmpW.rtyp==IDEAL_CMD)
804  ||(tmpW.rtyp==MODUL_CMD)
805  ||(tmpW.rtyp==MATRIX_CMD)
806  ||(tmpW.rtyp==MAP_CMD))
807  {
808  v->rtyp=tmpW.rtyp;
809  char *tmp = theMap->preimage;
810  theMap->preimage=(char*)1L;
811  // map gets 1 as its rank (as an ideal)
812  v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
813  theMap->preimage=tmp; // map gets its preimage back
814  }
815  if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
816  {
817  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
818  {
819  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
821  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
822  return NULL;
823  }
824  }
825  }
826  if (save_r!=NULL)
827  {
828  IDMAP(w)->preimage=save_r;
829  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
830  v->rtyp=MAP_CMD;
831  }
832  return v;
833  }
834  else
835  {
836  Werror("%s undefined in %s",what,theMap->preimage);
837  }
838  }
839  else
840  {
841  Werror("cannot find preimage %s",theMap->preimage);
842  }
843  return NULL;
844 }
845 
846 #ifdef OLD_RES
847 void iiMakeResolv(resolvente r, int length, int rlen, char * name, int typ0,
848  intvec ** weights)
849 {
850  lists L=liMakeResolv(r,length,rlen,typ0,weights);
851  int i=0;
852  idhdl h;
853  char * s=(char *)omAlloc(strlen(name)+5);
854 
855  while (i<=L->nr)
856  {
857  sprintf(s,"%s(%d)",name,i+1);
858  if (i==0)
859  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
860  else
861  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
862  if (h!=NULL)
863  {
864  h->data.uideal=(ideal)L->m[i].data;
865  h->attribute=L->m[i].attribute;
867  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
868  }
869  else
870  {
871  idDelete((ideal *)&(L->m[i].data));
872  Warn("cannot define %s",s);
873  }
874  //L->m[i].data=NULL;
875  //L->m[i].rtyp=0;
876  //L->m[i].attribute=NULL;
877  i++;
878  }
879  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
881  omFreeSize((ADDRESS)s,strlen(name)+5);
882 }
883 #endif
884 
885 //resolvente iiFindRes(char * name, int * len, int *typ0)
886 //{
887 // char *s=(char *)omAlloc(strlen(name)+5);
888 // int i=-1;
889 // resolvente r;
890 // idhdl h;
891 //
892 // do
893 // {
894 // i++;
895 // sprintf(s,"%s(%d)",name,i+1);
896 // h=currRing->idroot->get(s,myynest);
897 // } while (h!=NULL);
898 // *len=i-1;
899 // if (*len<=0)
900 // {
901 // Werror("no objects %s(1),.. found",name);
902 // omFreeSize((ADDRESS)s,strlen(name)+5);
903 // return NULL;
904 // }
905 // r=(ideal *)omAlloc(/*(len+1)*/ i*sizeof(ideal));
906 // memset(r,0,(*len)*sizeof(ideal));
907 // i=-1;
908 // *typ0=MODUL_CMD;
909 // while (i<(*len))
910 // {
911 // i++;
912 // sprintf(s,"%s(%d)",name,i+1);
913 // h=currRing->idroot->get(s,myynest);
914 // if (h->typ != MODUL_CMD)
915 // {
916 // if ((i!=0) || (h->typ!=IDEAL_CMD))
917 // {
918 // Werror("%s is not of type module",s);
919 // omFreeSize((ADDRESS)r,(*len)*sizeof(ideal));
920 // omFreeSize((ADDRESS)s,strlen(name)+5);
921 // return NULL;
922 // }
923 // *typ0=IDEAL_CMD;
924 // }
925 // if ((i>0) && (idIs0(r[i-1])))
926 // {
927 // *len=i-1;
928 // break;
929 // }
930 // r[i]=IDIDEAL(h);
931 // }
932 // omFreeSize((ADDRESS)s,strlen(name)+5);
933 // return r;
934 //}
935 
937 {
938  int i;
939  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
940 
941  for (i=0; i<l; i++)
942  if (r[i]!=NULL) res[i]=idCopy(r[i]);
943  return res;
944 }
945 
947 {
948  int len=0;
949  int typ0;
950  lists L=(lists)v->Data();
951  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
952  int add_row_shift = 0;
953  if (weights==NULL)
954  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
955  if (weights!=NULL) add_row_shift=weights->min_in();
956  resolvente rr=liFindRes(L,&len,&typ0);
957  if (rr==NULL) return TRUE;
958  resolvente r=iiCopyRes(rr,len);
959 
960  syMinimizeResolvente(r,len,0);
961  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
962  len++;
963  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
964  return FALSE;
965 }
966 
968 {
969  sleftv tmp;
970  tmp.Init();
971  tmp.rtyp=INT_CMD;
972  tmp.data=(void *)1;
973  if ((u->Typ()==IDEAL_CMD)
974  || (u->Typ()==MODUL_CMD))
975  return jjBETTI2_ID(res,u,&tmp);
976  else
977  return jjBETTI2(res,u,&tmp);
978 }
979 
981 {
983  l->Init(1);
984  l->m[0].rtyp=u->Typ();
985  l->m[0].data=u->Data();
986  attr *a=u->Attribute();
987  if (a!=NULL)
988  l->m[0].attribute=*a;
989  sleftv tmp2;
990  tmp2.Init();
991  tmp2.rtyp=LIST_CMD;
992  tmp2.data=(void *)l;
993  BOOLEAN r=jjBETTI2(res,&tmp2,v);
994  l->m[0].data=NULL;
995  l->m[0].attribute=NULL;
996  l->m[0].rtyp=DEF_CMD;
997  l->Clean();
998  return r;
999 }
1000 
1002 {
1003  resolvente r;
1004  int len;
1005  int reg,typ0;
1006  lists l=(lists)u->Data();
1007 
1008  intvec *weights=NULL;
1009  int add_row_shift=0;
1010  intvec *ww=NULL;
1011  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
1012  if (ww!=NULL)
1013  {
1014  weights=ivCopy(ww);
1015  add_row_shift = ww->min_in();
1016  (*weights) -= add_row_shift;
1017  }
1018  //Print("attr:%x\n",weights);
1019 
1020  r=liFindRes(l,&len,&typ0);
1021  if (r==NULL) return TRUE;
1022  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
1023  res->data=(void*)res_im;
1024  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
1025  //Print("rowShift: %d ",add_row_shift);
1026  for(int i=1;i<=res_im->rows();i++)
1027  {
1028  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
1029  else break;
1030  }
1031  //Print(" %d\n",add_row_shift);
1032  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
1033  if (weights!=NULL) delete weights;
1034  return FALSE;
1035 }
1036 
1038 {
1039  int len,reg,typ0;
1040 
1041  resolvente r=liFindRes(L,&len,&typ0);
1042 
1043  if (r==NULL)
1044  return -2;
1045  intvec *weights=NULL;
1046  int add_row_shift=0;
1047  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
1048  if (ww!=NULL)
1049  {
1050  weights=ivCopy(ww);
1051  add_row_shift = ww->min_in();
1052  (*weights) -= add_row_shift;
1053  }
1054  //Print("attr:%x\n",weights);
1055 
1056  intvec *dummy=syBetti(r,len,&reg,weights);
1057  if (weights!=NULL) delete weights;
1058  delete dummy;
1059  omFreeSize((ADDRESS)r,len*sizeof(ideal));
1060  return reg+1+add_row_shift;
1061 }
1062 
1064 #define BREAK_LINE_LENGTH 80
1065 void iiDebug()
1066 {
1067 #ifdef HAVE_SDB
1068  sdb_flags=1;
1069 #endif
1070  Print("\n-- break point in %s --\n",VoiceName());
1072  char * s;
1074  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1075  loop
1076  {
1077  memset(s,0,BREAK_LINE_LENGTH+4);
1079  if (s[BREAK_LINE_LENGTH-1]!='\0')
1080  {
1081  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1082  }
1083  else
1084  break;
1085  }
1086  if (*s=='\n')
1087  {
1089  }
1090 #if MDEBUG
1091  else if(strncmp(s,"cont;",5)==0)
1092  {
1094  }
1095 #endif /* MDEBUG */
1096  else
1097  {
1098  strcat( s, "\n;~\n");
1100  }
1101 }
1102 
1103 lists scIndIndset(ideal S, BOOLEAN all, ideal Q)
1104 {
1105  int i;
1106  indset save;
1108 
1109  hexist = hInit(S, Q, &hNexist, currRing);
1110  if (hNexist == 0)
1111  {
1112  intvec *iv=new intvec(rVar(currRing));
1113  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1114  res->Init(1);
1115  res->m[0].rtyp=INTVEC_CMD;
1116  res->m[0].data=(intvec*)iv;
1117  return res;
1118  }
1119  else if (hisModule!=0)
1120  {
1121  res->Init(0);
1122  return res;
1123  }
1124  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1125  hMu = 0;
1126  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1127  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1128  hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1129  hrad = hexist;
1130  hNrad = hNexist;
1131  radmem = hCreate(rVar(currRing) - 1);
1132  hCo = rVar(currRing) + 1;
1133  hNvar = rVar(currRing);
1134  hRadical(hrad, &hNrad, hNvar);
1135  hSupp(hrad, hNrad, hvar, &hNvar);
1136  if (hNvar)
1137  {
1138  hCo = hNvar;
1139  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1140  hLexR(hrad, hNrad, hvar, hNvar);
1142  }
1143  if (hCo && (hCo < rVar(currRing)))
1144  {
1146  }
1147  if (hMu!=0)
1148  {
1149  ISet = save;
1150  hMu2 = 0;
1151  if (all && (hCo+1 < rVar(currRing)))
1152  {
1155  i=hMu+hMu2;
1156  res->Init(i);
1157  if (hMu2 == 0)
1158  {
1160  }
1161  }
1162  else
1163  {
1164  res->Init(hMu);
1165  }
1166  for (i=0;i<hMu;i++)
1167  {
1168  res->m[i].data = (void *)save->set;
1169  res->m[i].rtyp = INTVEC_CMD;
1170  ISet = save;
1171  save = save->nx;
1173  }
1174  omFreeBin((ADDRESS)save, indlist_bin);
1175  if (hMu2 != 0)
1176  {
1177  save = JSet;
1178  for (i=hMu;i<hMu+hMu2;i++)
1179  {
1180  res->m[i].data = (void *)save->set;
1181  res->m[i].rtyp = INTVEC_CMD;
1182  JSet = save;
1183  save = save->nx;
1185  }
1186  omFreeBin((ADDRESS)save, indlist_bin);
1187  }
1188  }
1189  else
1190  {
1191  res->Init(0);
1193  }
1194  hKill(radmem, rVar(currRing) - 1);
1195  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1196  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1197  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1199  return res;
1200 }
1201 
1202 int iiDeclCommand(leftv sy, leftv name, int lev,int t, idhdl* root,BOOLEAN isring, BOOLEAN init_b)
1203 {
1204  BOOLEAN res=FALSE;
1205  BOOLEAN is_qring=FALSE;
1206  const char *id = name->name;
1207 
1208  sy->Init();
1209  if ((name->name==NULL)||(isdigit(name->name[0])))
1210  {
1211  WerrorS("object to declare is not a name");
1212  res=TRUE;
1213  }
1214  else
1215  {
1216  if (root==NULL) return TRUE;
1217  if (*root!=IDROOT)
1218  {
1219  if ((currRing==NULL) || (*root!=currRing->idroot))
1220  {
1221  Werror("can not define `%s` in other package",name->name);
1222  return TRUE;
1223  }
1224  }
1225  if (t==QRING_CMD)
1226  {
1227  t=RING_CMD; // qring is always RING_CMD
1228  is_qring=TRUE;
1229  }
1230 
1231  if (TEST_V_ALLWARN
1232  && (name->rtyp!=0)
1233  && (name->rtyp!=IDHDL)
1234  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1235  {
1236  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1238  }
1239  {
1240  sy->data = (char *)enterid(id,lev,t,root,init_b);
1241  }
1242  if (sy->data!=NULL)
1243  {
1244  sy->rtyp=IDHDL;
1245  currid=sy->name=IDID((idhdl)sy->data);
1246  if (is_qring)
1247  {
1249  }
1250  // name->name=NULL; /* used in enterid */
1251  //sy->e = NULL;
1252  if (name->next!=NULL)
1253  {
1255  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1256  }
1257  }
1258  else res=TRUE;
1259  }
1260  name->CleanUp();
1261  return res;
1262 }
1263 
1265 {
1266  attr at=NULL;
1267  if (iiCurrProc!=NULL)
1268  at=iiCurrProc->attribute->get("default_arg");
1269  if (at==NULL)
1270  return FALSE;
1271  sleftv tmp;
1272  tmp.Init();
1273  tmp.rtyp=at->atyp;
1274  tmp.data=at->CopyA();
1275  return iiAssign(p,&tmp);
1276 }
1278 {
1279  // must be inside a proc, as we simultae an proc_end at the end
1280  if (myynest==0)
1281  {
1282  WerrorS("branchTo can only occur in a proc");
1283  return TRUE;
1284  }
1285  // <string1...stringN>,<proc>
1286  // known: args!=NULL, l>=1
1287  int l=args->listLength();
1288  int ll=0;
1289  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1290  if (ll!=(l-1)) return FALSE;
1291  leftv h=args;
1292  // set up the table for type test:
1293  short *t=(short*)omAlloc(l*sizeof(short));
1294  t[0]=l-1;
1295  int b;
1296  int i;
1297  for(i=1;i<l;i++,h=h->next)
1298  {
1299  if (h->Typ()!=STRING_CMD)
1300  {
1301  omFree(t);
1302  Werror("arg %d is not a string",i);
1303  return TRUE;
1304  }
1305  int tt;
1306  b=IsCmd((char *)h->Data(),tt);
1307  if(b) t[i]=tt;
1308  else
1309  {
1310  omFree(t);
1311  Werror("arg %d is not a type name",i);
1312  return TRUE;
1313  }
1314  }
1315  if (h->Typ()!=PROC_CMD)
1316  {
1317  omFree(t);
1318  Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1319  i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1320  return TRUE;
1321  }
1322  b=iiCheckTypes(iiCurrArgs,t,0);
1323  omFree(t);
1324  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1325  {
1326  // get the proc:
1327  iiCurrProc=(idhdl)h->data;
1328  idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1329  procinfo * pi=IDPROC(currProc);
1330  // already loaded ?
1331  if( pi->data.s.body==NULL )
1332  {
1334  if (pi->data.s.body==NULL) return TRUE;
1335  }
1336  // set currPackHdl/currPack
1337  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1338  {
1339  currPack=pi->pack;
1342  //Print("set pack=%s\n",IDID(currPackHdl));
1343  }
1344  // see iiAllStart:
1345  BITSET save1=si_opt_1;
1346  BITSET save2=si_opt_2;
1347  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1348  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1349  BOOLEAN err=yyparse();
1350  iiCurrProc=NULL;
1351  si_opt_1=save1;
1352  si_opt_2=save2;
1353  // now save the return-expr.
1355  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1356  iiRETURNEXPR.Init();
1357  // warning about args.:
1358  if (iiCurrArgs!=NULL)
1359  {
1360  if (err==0) Warn("too many arguments for %s",IDID(currProc));
1361  iiCurrArgs->CleanUp();
1363  iiCurrArgs=NULL;
1364  }
1365  // similate proc_end:
1366  // - leave input
1367  void myychangebuffer();
1368  myychangebuffer();
1369  // - set the current buffer to its end (this is a pointer in a buffer,
1370  // not a file ptr) "branchTo" is only valid in proc)
1372  // - kill local vars
1374  // - return
1375  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1376  return (err!=0);
1377  }
1378  return FALSE;
1379 }
1381 {
1382  if (iiCurrArgs==NULL)
1383  {
1384  if (strcmp(p->name,"#")==0)
1385  return iiDefaultParameter(p);
1386  Werror("not enough arguments for proc %s",VoiceName());
1387  p->CleanUp();
1388  return TRUE;
1389  }
1390  leftv h=iiCurrArgs;
1391  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1392  BOOLEAN is_default_list=FALSE;
1393  if (strcmp(p->name,"#")==0)
1394  {
1395  is_default_list=TRUE;
1396  rest=NULL;
1397  }
1398  else
1399  {
1400  h->next=NULL;
1401  }
1402  BOOLEAN res=iiAssign(p,h);
1403  if (is_default_list)
1404  {
1405  iiCurrArgs=NULL;
1406  }
1407  else
1408  {
1409  iiCurrArgs=rest;
1410  }
1411  h->CleanUp();
1413  return res;
1414 }
1415 
1416 static BOOLEAN iiInternalExport (leftv v, int toLev)
1417 {
1418  idhdl h=(idhdl)v->data;
1419  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1420  if (IDLEV(h)==0)
1421  {
1422  if ((myynest>0) && (BVERBOSE(V_REDEFINE))) Warn("`%s` is already global",IDID(h));
1423  }
1424  else
1425  {
1426  h=IDROOT->get(v->name,toLev);
1427  idhdl *root=&IDROOT;
1428  if ((h==NULL)&&(currRing!=NULL))
1429  {
1430  h=currRing->idroot->get(v->name,toLev);
1431  root=&currRing->idroot;
1432  }
1433  BOOLEAN keepring=FALSE;
1434  if ((h!=NULL)&&(IDLEV(h)==toLev))
1435  {
1436  if (IDTYP(h)==v->Typ())
1437  {
1438  if ((IDTYP(h)==RING_CMD)
1439  && (v->Data()==IDDATA(h)))
1440  {
1441  rIncRefCnt(IDRING(h));
1442  keepring=TRUE;
1443  IDLEV(h)=toLev;
1444  //WarnS("keepring");
1445  return FALSE;
1446  }
1447  if (BVERBOSE(V_REDEFINE))
1448  {
1449  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1450  }
1451  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1452  killhdl2(h,root,currRing);
1453  }
1454  else
1455  {
1456  WerrorS("object with a different type exists");
1457  return TRUE;
1458  }
1459  }
1460  h=(idhdl)v->data;
1461  IDLEV(h)=toLev;
1462  if (keepring) rDecRefCnt(IDRING(h));
1464  //Print("export %s\n",IDID(h));
1465  }
1466  return FALSE;
1467 }
1468 
1469 BOOLEAN iiInternalExport (leftv v, int toLev, package rootpack)
1470 {
1471  idhdl h=(idhdl)v->data;
1472  if(h==NULL)
1473  {
1474  Warn("'%s': no such identifier\n", v->name);
1475  return FALSE;
1476  }
1477  package frompack=v->req_packhdl;
1478  if (frompack==NULL) frompack=currPack;
1479  if ((RingDependend(IDTYP(h)))
1480  || ((IDTYP(h)==LIST_CMD)
1481  && (lRingDependend(IDLIST(h)))
1482  )
1483  )
1484  {
1485  //Print("// ==> Ringdependent set nesting to 0\n");
1486  return (iiInternalExport(v, toLev));
1487  }
1488  else
1489  {
1490  IDLEV(h)=toLev;
1491  v->req_packhdl=rootpack;
1492  if (h==frompack->idroot)
1493  {
1494  frompack->idroot=h->next;
1495  }
1496  else
1497  {
1498  idhdl hh=frompack->idroot;
1499  while ((hh!=NULL) && (hh->next!=h))
1500  hh=hh->next;
1501  if ((hh!=NULL) && (hh->next==h))
1502  hh->next=h->next;
1503  else
1504  {
1505  Werror("`%s` not found",v->Name());
1506  return TRUE;
1507  }
1508  }
1509  h->next=rootpack->idroot;
1510  rootpack->idroot=h;
1511  }
1512  return FALSE;
1513 }
1514 
1515 BOOLEAN iiExport (leftv v, int toLev)
1516 {
1517  BOOLEAN nok=FALSE;
1518  leftv r=v;
1519  while (v!=NULL)
1520  {
1521  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1522  {
1523  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1524  nok=TRUE;
1525  }
1526  else
1527  {
1528  if(iiInternalExport(v, toLev))
1529  nok=TRUE;
1530  }
1531  v=v->next;
1532  }
1533  r->CleanUp();
1534  return nok;
1535 }
1536 
1537 /*assume root!=idroot*/
1538 BOOLEAN iiExport (leftv v, int toLev, package pack)
1539 {
1540 // if ((pack==basePack)&&(pack!=currPack))
1541 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1542  BOOLEAN nok=FALSE;
1543  leftv rv=v;
1544  while (v!=NULL)
1545  {
1546  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1547  )
1548  {
1549  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1550  nok=TRUE;
1551  }
1552  else
1553  {
1554  idhdl old=pack->idroot->get( v->name,toLev);
1555  if (old!=NULL)
1556  {
1557  if ((pack==currPack) && (old==(idhdl)v->data))
1558  {
1559  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1560  break;
1561  }
1562  else if (IDTYP(old)==v->Typ())
1563  {
1564  if (BVERBOSE(V_REDEFINE))
1565  {
1566  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1567  }
1568  v->name=omStrDup(v->name);
1569  killhdl2(old,&(pack->idroot),currRing);
1570  }
1571  else
1572  {
1573  rv->CleanUp();
1574  return TRUE;
1575  }
1576  }
1577  //Print("iiExport: pack=%s\n",IDID(root));
1578  if(iiInternalExport(v, toLev, pack))
1579  {
1580  rv->CleanUp();
1581  return TRUE;
1582  }
1583  }
1584  v=v->next;
1585  }
1586  rv->CleanUp();
1587  return nok;
1588 }
1589 
1591 {
1592  if (currRing==NULL)
1593  {
1594  #ifdef SIQ
1595  if (siq<=0)
1596  {
1597  #endif
1598  if (RingDependend(i))
1599  {
1600  WerrorS("no ring active (9)");
1601  return TRUE;
1602  }
1603  #ifdef SIQ
1604  }
1605  #endif
1606  }
1607  return FALSE;
1608 }
1609 
1610 poly iiHighCorner(ideal I, int ak)
1611 {
1612  int i;
1613  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1614  poly po=NULL;
1616  {
1617  scComputeHC(I,currRing->qideal,ak,po);
1618  if (po!=NULL)
1619  {
1620  pGetCoeff(po)=nInit(1);
1621  for (i=rVar(currRing); i>0; i--)
1622  {
1623  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1624  }
1625  pSetComp(po,ak);
1626  pSetm(po);
1627  }
1628  }
1629  else
1630  po=pOne();
1631  return po;
1632 }
1633 
1635 {
1636  if (p!=basePack)
1637  {
1638  idhdl t=basePack->idroot;
1639  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1640  if (t==NULL)
1641  {
1642  WarnS("package not found\n");
1643  p=basePack;
1644  }
1645  }
1646 }
1647 
1648 idhdl rDefault(const char *s)
1649 {
1650  idhdl tmp=NULL;
1651 
1652  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1653  if (tmp==NULL) return NULL;
1654 
1655 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1657  {
1659  }
1660 
1661  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1662 
1663  #ifndef TEST_ZN_AS_ZP
1664  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1665  #else
1666  mpz_t modBase;
1667  mpz_init_set_ui(modBase, (long)32003);
1668  ZnmInfo info;
1669  info.base= modBase;
1670  info.exp= 1;
1671  r->cf=nInitChar(n_Zn,(void*) &info);
1672  r->cf->is_field=1;
1673  r->cf->is_domain=1;
1674  r->cf->has_simple_Inverse=1;
1675  #endif
1676  r->N = 3;
1677  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1678  /*names*/
1679  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1680  r->names[0] = omStrDup("x");
1681  r->names[1] = omStrDup("y");
1682  r->names[2] = omStrDup("z");
1683  /*weights: entries for 3 blocks: NULL*/
1684  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1685  /*order: dp,C,0*/
1686  r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1687  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1688  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1689  /* ringorder dp for the first block: var 1..3 */
1690  r->order[0] = ringorder_dp;
1691  r->block0[0] = 1;
1692  r->block1[0] = 3;
1693  /* ringorder C for the second block: no vars */
1694  r->order[1] = ringorder_C;
1695  /* the last block: everything is 0 */
1696  r->order[2] = (rRingOrder_t)0;
1697 
1698  /* complete ring intializations */
1699  rComplete(r);
1700  rSetHdl(tmp);
1701  return currRingHdl;
1702 }
1703 
1704 static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n);
1706 {
1707  if ((r==NULL)||(r->VarOffset==NULL))
1708  return NULL;
1710  if (h!=NULL) return h;
1711  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1712  if (h!=NULL) return h;
1714  while(p!=NULL)
1715  {
1716  if ((p->cPack!=basePack)
1717  && (p->cPack!=currPack))
1718  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1719  if (h!=NULL) return h;
1720  p=p->next;
1721  }
1722  idhdl tmp=basePack->idroot;
1723  while (tmp!=NULL)
1724  {
1725  if (IDTYP(tmp)==PACKAGE_CMD)
1726  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1727  if (h!=NULL) return h;
1728  tmp=IDNEXT(tmp);
1729  }
1730  return NULL;
1731 }
1732 
1733 void rDecomposeCF(leftv h,const ring r,const ring R)
1734 {
1736  L->Init(4);
1737  h->rtyp=LIST_CMD;
1738  h->data=(void *)L;
1739  // 0: char/ cf - ring
1740  // 1: list (var)
1741  // 2: list (ord)
1742  // 3: qideal
1743  // ----------------------------------------
1744  // 0: char/ cf - ring
1745  L->m[0].rtyp=INT_CMD;
1746  L->m[0].data=(void *)(long)r->cf->ch;
1747  // ----------------------------------------
1748  // 1: list (var)
1750  LL->Init(r->N);
1751  int i;
1752  for(i=0; i<r->N; i++)
1753  {
1754  LL->m[i].rtyp=STRING_CMD;
1755  LL->m[i].data=(void *)omStrDup(r->names[i]);
1756  }
1757  L->m[1].rtyp=LIST_CMD;
1758  L->m[1].data=(void *)LL;
1759  // ----------------------------------------
1760  // 2: list (ord)
1762  i=rBlocks(r)-1;
1763  LL->Init(i);
1764  i--;
1765  lists LLL;
1766  for(; i>=0; i--)
1767  {
1768  intvec *iv;
1769  int j;
1770  LL->m[i].rtyp=LIST_CMD;
1772  LLL->Init(2);
1773  LLL->m[0].rtyp=STRING_CMD;
1774  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1775  if (r->block1[i]-r->block0[i] >=0 )
1776  {
1777  j=r->block1[i]-r->block0[i];
1778  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1779  iv=new intvec(j+1);
1780  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1781  {
1782  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1783  }
1784  else switch (r->order[i])
1785  {
1786  case ringorder_dp:
1787  case ringorder_Dp:
1788  case ringorder_ds:
1789  case ringorder_Ds:
1790  case ringorder_lp:
1791  case ringorder_rp:
1792  case ringorder_ls:
1793  for(;j>=0; j--) (*iv)[j]=1;
1794  break;
1795  default: /* do nothing */;
1796  }
1797  }
1798  else
1799  {
1800  iv=new intvec(1);
1801  }
1802  LLL->m[1].rtyp=INTVEC_CMD;
1803  LLL->m[1].data=(void *)iv;
1804  LL->m[i].data=(void *)LLL;
1805  }
1806  L->m[2].rtyp=LIST_CMD;
1807  L->m[2].data=(void *)LL;
1808  // ----------------------------------------
1809  // 3: qideal
1810  L->m[3].rtyp=IDEAL_CMD;
1811  if (nCoeff_is_transExt(R->cf))
1812  L->m[3].data=(void *)idInit(1,1);
1813  else
1814  {
1815  ideal q=idInit(IDELEMS(r->qideal));
1816  q->m[0]=p_Init(R);
1817  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1818  L->m[3].data=(void *)q;
1819 // I->m[0] = pNSet(R->minpoly);
1820  }
1821  // ----------------------------------------
1822 }
1823 static void rDecomposeC_41(leftv h,const coeffs C)
1824 /* field is R or C */
1825 {
1827  if (nCoeff_is_long_C(C)) L->Init(3);
1828  else L->Init(2);
1829  h->rtyp=LIST_CMD;
1830  h->data=(void *)L;
1831  // 0: char/ cf - ring
1832  // 1: list (var)
1833  // 2: list (ord)
1834  // ----------------------------------------
1835  // 0: char/ cf - ring
1836  L->m[0].rtyp=INT_CMD;
1837  L->m[0].data=(void *)0;
1838  // ----------------------------------------
1839  // 1:
1841  LL->Init(2);
1842  LL->m[0].rtyp=INT_CMD;
1843  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1844  LL->m[1].rtyp=INT_CMD;
1845  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1846  L->m[1].rtyp=LIST_CMD;
1847  L->m[1].data=(void *)LL;
1848  // ----------------------------------------
1849  // 2: list (par)
1850  if (nCoeff_is_long_C(C))
1851  {
1852  L->m[2].rtyp=STRING_CMD;
1853  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1854  }
1855  // ----------------------------------------
1856 }
1857 static void rDecomposeC(leftv h,const ring R)
1858 /* field is R or C */
1859 {
1861  if (rField_is_long_C(R)) L->Init(3);
1862  else L->Init(2);
1863  h->rtyp=LIST_CMD;
1864  h->data=(void *)L;
1865  // 0: char/ cf - ring
1866  // 1: list (var)
1867  // 2: list (ord)
1868  // ----------------------------------------
1869  // 0: char/ cf - ring
1870  L->m[0].rtyp=INT_CMD;
1871  L->m[0].data=(void *)0;
1872  // ----------------------------------------
1873  // 1:
1875  LL->Init(2);
1876  LL->m[0].rtyp=INT_CMD;
1877  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1878  LL->m[1].rtyp=INT_CMD;
1879  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1880  L->m[1].rtyp=LIST_CMD;
1881  L->m[1].data=(void *)LL;
1882  // ----------------------------------------
1883  // 2: list (par)
1884  if (rField_is_long_C(R))
1885  {
1886  L->m[2].rtyp=STRING_CMD;
1887  L->m[2].data=(void *)omStrDup(*rParameter(R));
1888  }
1889  // ----------------------------------------
1890 }
1891 
1892 #ifdef HAVE_RINGS
1894 /* field is R or C */
1895 {
1897  if (nCoeff_is_Ring(C)) L->Init(1);
1898  else L->Init(2);
1899  h->rtyp=LIST_CMD;
1900  h->data=(void *)L;
1901  // 0: char/ cf - ring
1902  // 1: list (module)
1903  // ----------------------------------------
1904  // 0: char/ cf - ring
1905  L->m[0].rtyp=STRING_CMD;
1906  L->m[0].data=(void *)omStrDup("integer");
1907  // ----------------------------------------
1908  // 1: modulo
1909  if (nCoeff_is_Z(C)) return;
1911  LL->Init(2);
1912  LL->m[0].rtyp=BIGINT_CMD;
1913  LL->m[0].data=n_InitMPZ( C->modBase, coeffs_BIGINT);
1914  LL->m[1].rtyp=INT_CMD;
1915  LL->m[1].data=(void *) C->modExponent;
1916  L->m[1].rtyp=LIST_CMD;
1917  L->m[1].data=(void *)LL;
1918 }
1919 #endif
1920 
1921 void rDecomposeRing(leftv h,const ring R)
1922 /* field is R or C */
1923 {
1924 #ifdef HAVE_RINGS
1926  if (rField_is_Z(R)) L->Init(1);
1927  else L->Init(2);
1928  h->rtyp=LIST_CMD;
1929  h->data=(void *)L;
1930  // 0: char/ cf - ring
1931  // 1: list (module)
1932  // ----------------------------------------
1933  // 0: char/ cf - ring
1934  L->m[0].rtyp=STRING_CMD;
1935  L->m[0].data=(void *)omStrDup("integer");
1936  // ----------------------------------------
1937  // 1: module
1938  if (rField_is_Z(R)) return;
1940  LL->Init(2);
1941  LL->m[0].rtyp=BIGINT_CMD;
1942  LL->m[0].data=n_InitMPZ( R->cf->modBase, coeffs_BIGINT);
1943  LL->m[1].rtyp=INT_CMD;
1944  LL->m[1].data=(void *) R->cf->modExponent;
1945  L->m[1].rtyp=LIST_CMD;
1946  L->m[1].data=(void *)LL;
1947 #else
1948  WerrorS("rDecomposeRing");
1949 #endif
1950 }
1951 
1952 
1954 {
1955  assume( C != NULL );
1956 
1957  // sanity check: require currRing==r for rings with polynomial data
1958  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1959  {
1960  WerrorS("ring with polynomial data must be the base ring or compatible");
1961  return TRUE;
1962  }
1963  if (nCoeff_is_numeric(C))
1964  {
1965  rDecomposeC_41(res,C);
1966  }
1967 #ifdef HAVE_RINGS
1968  else if (nCoeff_is_Ring(C))
1969  {
1971  }
1972 #endif
1973  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1974  {
1975  rDecomposeCF(res, C->extRing, currRing);
1976  }
1977  else if(nCoeff_is_GF(C))
1978  {
1980  Lc->Init(4);
1981  // char:
1982  Lc->m[0].rtyp=INT_CMD;
1983  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1984  // var:
1986  Lv->Init(1);
1987  Lv->m[0].rtyp=STRING_CMD;
1988  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1989  Lc->m[1].rtyp=LIST_CMD;
1990  Lc->m[1].data=(void*)Lv;
1991  // ord:
1993  Lo->Init(1);
1995  Loo->Init(2);
1996  Loo->m[0].rtyp=STRING_CMD;
1997  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1998 
1999  intvec *iv=new intvec(1); (*iv)[0]=1;
2000  Loo->m[1].rtyp=INTVEC_CMD;
2001  Loo->m[1].data=(void *)iv;
2002 
2003  Lo->m[0].rtyp=LIST_CMD;
2004  Lo->m[0].data=(void*)Loo;
2005 
2006  Lc->m[2].rtyp=LIST_CMD;
2007  Lc->m[2].data=(void*)Lo;
2008  // q-ideal:
2009  Lc->m[3].rtyp=IDEAL_CMD;
2010  Lc->m[3].data=(void *)idInit(1,1);
2011  // ----------------------
2012  res->rtyp=LIST_CMD;
2013  res->data=(void*)Lc;
2014  }
2015  else
2016  {
2017  res->rtyp=INT_CMD;
2018  res->data=(void *)(long)C->ch;
2019  }
2020  // ----------------------------------------
2021  return FALSE;
2022 }
2023 
2024 // common part of rDecompse and rDecompose_list_cf:
2025 static void rDecompose_23456(const ring r, lists L)
2026 {
2027  // ----------------------------------------
2028  // 1: list (var)
2030  LL->Init(r->N);
2031  int i;
2032  for(i=0; i<r->N; i++)
2033  {
2034  LL->m[i].rtyp=STRING_CMD;
2035  LL->m[i].data=(void *)omStrDup(r->names[i]);
2036  }
2037  L->m[1].rtyp=LIST_CMD;
2038  L->m[1].data=(void *)LL;
2039  // ----------------------------------------
2040  // 2: list (ord)
2042  i=rBlocks(r)-1;
2043  LL->Init(i);
2044  i--;
2045  lists LLL;
2046  for(; i>=0; i--)
2047  {
2048  intvec *iv;
2049  int j;
2050  LL->m[i].rtyp=LIST_CMD;
2052  LLL->Init(2);
2053  LLL->m[0].rtyp=STRING_CMD;
2054  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2055 
2056  if((r->order[i] == ringorder_IS)
2057  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2058  {
2059  assume( r->block0[i] == r->block1[i] );
2060  const int s = r->block0[i];
2061  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2062 
2063  iv=new intvec(1);
2064  (*iv)[0] = s;
2065  }
2066  else if (r->block1[i]-r->block0[i] >=0 )
2067  {
2068  int bl=j=r->block1[i]-r->block0[i];
2069  if (r->order[i]==ringorder_M)
2070  {
2071  j=(j+1)*(j+1)-1;
2072  bl=j+1;
2073  }
2074  else if (r->order[i]==ringorder_am)
2075  {
2076  j+=r->wvhdl[i][bl+1];
2077  }
2078  iv=new intvec(j+1);
2079  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2080  {
2081  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2082  }
2083  else switch (r->order[i])
2084  {
2085  case ringorder_dp:
2086  case ringorder_Dp:
2087  case ringorder_ds:
2088  case ringorder_Ds:
2089  case ringorder_lp:
2090  case ringorder_ls:
2091  case ringorder_rp:
2092  for(;j>=0; j--) (*iv)[j]=1;
2093  break;
2094  default: /* do nothing */;
2095  }
2096  }
2097  else
2098  {
2099  iv=new intvec(1);
2100  }
2101  LLL->m[1].rtyp=INTVEC_CMD;
2102  LLL->m[1].data=(void *)iv;
2103  LL->m[i].data=(void *)LLL;
2104  }
2105  L->m[2].rtyp=LIST_CMD;
2106  L->m[2].data=(void *)LL;
2107  // ----------------------------------------
2108  // 3: qideal
2109  L->m[3].rtyp=IDEAL_CMD;
2110  if (r->qideal==NULL)
2111  L->m[3].data=(void *)idInit(1,1);
2112  else
2113  L->m[3].data=(void *)idCopy(r->qideal);
2114  // ----------------------------------------
2115 #ifdef HAVE_PLURAL // NC! in rDecompose
2116  if (rIsPluralRing(r))
2117  {
2118  L->m[4].rtyp=MATRIX_CMD;
2119  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2120  L->m[5].rtyp=MATRIX_CMD;
2121  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2122  }
2123 #endif
2124 }
2125 
2127 {
2128  assume( r != NULL );
2129  const coeffs C = r->cf;
2130  assume( C != NULL );
2131 
2132  // sanity check: require currRing==r for rings with polynomial data
2133  if ( (r!=currRing) && (
2134  (r->qideal != NULL)
2135 #ifdef HAVE_PLURAL
2136  || (rIsPluralRing(r))
2137 #endif
2138  )
2139  )
2140  {
2141  WerrorS("ring with polynomial data must be the base ring or compatible");
2142  return NULL;
2143  }
2144  // 0: char/ cf - ring
2145  // 1: list (var)
2146  // 2: list (ord)
2147  // 3: qideal
2148  // possibly:
2149  // 4: C
2150  // 5: D
2152  if (rIsPluralRing(r))
2153  L->Init(6);
2154  else
2155  L->Init(4);
2156  // ----------------------------------------
2157  // 0: char/ cf - ring
2158  L->m[0].rtyp=CRING_CMD;
2159  L->m[0].data=(char*)r->cf; r->cf->ref++;
2160  // ----------------------------------------
2161  rDecompose_23456(r,L);
2162  return L;
2163 }
2164 
2165 lists rDecompose(const ring r)
2166 {
2167  assume( r != NULL );
2168  const coeffs C = r->cf;
2169  assume( C != NULL );
2170 
2171  // sanity check: require currRing==r for rings with polynomial data
2172  if ( (r!=currRing) && (
2173  (nCoeff_is_algExt(C) && (C != currRing->cf))
2174  || (r->qideal != NULL)
2175 #ifdef HAVE_PLURAL
2176  || (rIsPluralRing(r))
2177 #endif
2178  )
2179  )
2180  {
2181  WerrorS("ring with polynomial data must be the base ring or compatible");
2182  return NULL;
2183  }
2184  // 0: char/ cf - ring
2185  // 1: list (var)
2186  // 2: list (ord)
2187  // 3: qideal
2188  // possibly:
2189  // 4: C
2190  // 5: D
2192  if (rIsPluralRing(r))
2193  L->Init(6);
2194  else
2195  L->Init(4);
2196  // ----------------------------------------
2197  // 0: char/ cf - ring
2198  if (rField_is_numeric(r))
2199  {
2200  rDecomposeC(&(L->m[0]),r);
2201  }
2202  else if (rField_is_Ring(r))
2203  {
2204  rDecomposeRing(&(L->m[0]),r);
2205  }
2206  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2207  {
2208  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2209  }
2210  else if(rField_is_GF(r))
2211  {
2213  Lc->Init(4);
2214  // char:
2215  Lc->m[0].rtyp=INT_CMD;
2216  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2217  // var:
2219  Lv->Init(1);
2220  Lv->m[0].rtyp=STRING_CMD;
2221  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2222  Lc->m[1].rtyp=LIST_CMD;
2223  Lc->m[1].data=(void*)Lv;
2224  // ord:
2226  Lo->Init(1);
2228  Loo->Init(2);
2229  Loo->m[0].rtyp=STRING_CMD;
2230  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2231 
2232  intvec *iv=new intvec(1); (*iv)[0]=1;
2233  Loo->m[1].rtyp=INTVEC_CMD;
2234  Loo->m[1].data=(void *)iv;
2235 
2236  Lo->m[0].rtyp=LIST_CMD;
2237  Lo->m[0].data=(void*)Loo;
2238 
2239  Lc->m[2].rtyp=LIST_CMD;
2240  Lc->m[2].data=(void*)Lo;
2241  // q-ideal:
2242  Lc->m[3].rtyp=IDEAL_CMD;
2243  Lc->m[3].data=(void *)idInit(1,1);
2244  // ----------------------
2245  L->m[0].rtyp=LIST_CMD;
2246  L->m[0].data=(void*)Lc;
2247  }
2248  else if (rField_is_Zp(r) || rField_is_Q(r))
2249  {
2250  L->m[0].rtyp=INT_CMD;
2251  L->m[0].data=(void *)(long)r->cf->ch;
2252  }
2253  else
2254  {
2255  L->m[0].rtyp=CRING_CMD;
2256  L->m[0].data=(void *)r->cf;
2257  r->cf->ref++;
2258  }
2259  // ----------------------------------------
2260  rDecompose_23456(r,L);
2261  return L;
2262 }
2263 
2264 void rComposeC(lists L, ring R)
2265 /* field is R or C */
2266 {
2267  // ----------------------------------------
2268  // 0: char/ cf - ring
2269  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2270  {
2271  WerrorS("invalid coeff. field description, expecting 0");
2272  return;
2273  }
2274 // R->cf->ch=0;
2275  // ----------------------------------------
2276  // 0, (r1,r2) [, "i" ]
2277  if (L->m[1].rtyp!=LIST_CMD)
2278  {
2279  WerrorS("invalid coeff. field description, expecting precision list");
2280  return;
2281  }
2282  lists LL=(lists)L->m[1].data;
2283  if ((LL->nr!=1)
2284  || (LL->m[0].rtyp!=INT_CMD)
2285  || (LL->m[1].rtyp!=INT_CMD))
2286  {
2287  WerrorS("invalid coeff. field description list, expected list(`int`,`int`)");
2288  return;
2289  }
2290  int r1=(int)(long)LL->m[0].data;
2291  int r2=(int)(long)LL->m[1].data;
2292  r1=si_min(r1,32767);
2293  r2=si_min(r2,32767);
2294  LongComplexInfo par; memset(&par, 0, sizeof(par));
2295  par.float_len=r1;
2296  par.float_len2=r2;
2297  if (L->nr==2) // complex
2298  {
2299  if (L->m[2].rtyp!=STRING_CMD)
2300  {
2301  WerrorS("invalid coeff. field description, expecting parameter name");
2302  return;
2303  }
2304  par.par_name=(char*)L->m[2].data;
2305  R->cf = nInitChar(n_long_C, &par);
2306  }
2307  else if ((r1<=SHORT_REAL_LENGTH) && (r2<=SHORT_REAL_LENGTH)) /* && L->nr==1*/
2308  R->cf = nInitChar(n_R, NULL);
2309  else /* && L->nr==1*/
2310  {
2311  R->cf = nInitChar(n_long_R, &par);
2312  }
2313 }
2314 
2315 #ifdef HAVE_RINGS
2316 void rComposeRing(lists L, ring R)
2317 /* field is R or C */
2318 {
2319  // ----------------------------------------
2320  // 0: string: integer
2321  // no further entries --> Z
2322  mpz_t modBase;
2323  unsigned int modExponent = 1;
2324 
2325  if (L->nr == 0)
2326  {
2327  mpz_init_set_ui(modBase,0);
2328  modExponent = 1;
2329  }
2330  // ----------------------------------------
2331  // 1:
2332  else
2333  {
2334  if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
2335  lists LL=(lists)L->m[1].data;
2336  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2337  {
2338  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2339  // assume that tmp is integer, not rational
2340  mpz_init(modBase);
2341  n_MPZ (modBase, tmp, coeffs_BIGINT);
2342  }
2343  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2344  {
2345  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2346  }
2347  else
2348  {
2349  mpz_init_set_ui(modBase,0);
2350  }
2351  if (LL->nr >= 1)
2352  {
2353  modExponent = (unsigned long) LL->m[1].data;
2354  }
2355  else
2356  {
2357  modExponent = 1;
2358  }
2359  }
2360  // ----------------------------------------
2361  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
2362  {
2363  WerrorS("Wrong ground ring specification (module is 1)");
2364  return;
2365  }
2366  if (modExponent < 1)
2367  {
2368  WerrorS("Wrong ground ring specification (exponent smaller than 1)");
2369  return;
2370  }
2371  // module is 0 ---> integers
2372  if (mpz_sgn1(modBase) == 0)
2373  {
2374  R->cf=nInitChar(n_Z,NULL);
2375  }
2376  // we have an exponent
2377  else if (modExponent > 1)
2378  {
2379  //R->cf->ch = R->cf->modExponent;
2380  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2381  {
2382  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2383  depending on the size of a long on the respective platform */
2384  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2385  }
2386  else
2387  {
2388  //ringtype 3
2389  ZnmInfo info;
2390  info.base= modBase;
2391  info.exp= modExponent;
2392  R->cf=nInitChar(n_Znm,(void*) &info);
2393  }
2394  }
2395  // just a module m > 1
2396  else
2397  {
2398  //ringtype = 2;
2399  //const int ch = mpz_get_ui(modBase);
2400  ZnmInfo info;
2401  info.base= modBase;
2402  info.exp= modExponent;
2403  R->cf=nInitChar(n_Zn,(void*) &info);
2404  }
2405  mpz_clear(modBase);
2406 }
2407 #endif
2408 
2409 static void rRenameVars(ring R)
2410 {
2411  int i,j;
2412  BOOLEAN ch;
2413  do
2414  {
2415  ch=0;
2416  for(i=0;i<R->N-1;i++)
2417  {
2418  for(j=i+1;j<R->N;j++)
2419  {
2420  if (strcmp(R->names[i],R->names[j])==0)
2421  {
2422  ch=TRUE;
2423  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`in >>%s<<\nin %s:%d",i+1,j+1,R->names[i],R->names[i],my_yylinebuf,currentVoice->filename,yylineno);
2424  omFree(R->names[j]);
2425  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2426  sprintf(R->names[j],"@%s",R->names[i]);
2427  }
2428  }
2429  }
2430  }
2431  while (ch);
2432  for(i=0;i<rPar(R); i++)
2433  {
2434  for(j=0;j<R->N;j++)
2435  {
2436  if (strcmp(rParameter(R)[i],R->names[j])==0)
2437  {
2438  Warn("name conflict par(%d) and var(%d): `%s`, rename the VARIABLE to `@@(%d)`in >>%s<<\nin %s:%d",i+1,j+1,R->names[j],i+1,my_yylinebuf,currentVoice->filename,yylineno);
2439 // omFree(rParameter(R)[i]);
2440 // rParameter(R)[i]=(char *)omAlloc(10);
2441 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2442  omFree(R->names[j]);
2443  R->names[j]=(char *)omAlloc(10);
2444  sprintf(R->names[j],"@@(%d)",i+1);
2445  }
2446  }
2447  }
2448 }
2449 
2450 static inline BOOLEAN rComposeVar(const lists L, ring R)
2451 {
2452  assume(R!=NULL);
2453  if (L->m[1].Typ()==LIST_CMD)
2454  {
2455  lists v=(lists)L->m[1].Data();
2456  R->N = v->nr+1;
2457  if (R->N<=0)
2458  {
2459  WerrorS("no ring variables");
2460  return TRUE;
2461  }
2462  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2463  int i;
2464  for(i=0;i<R->N;i++)
2465  {
2466  if (v->m[i].Typ()==STRING_CMD)
2467  R->names[i]=omStrDup((char *)v->m[i].Data());
2468  else if (v->m[i].Typ()==POLY_CMD)
2469  {
2470  poly p=(poly)v->m[i].Data();
2471  int nr=pIsPurePower(p);
2472  if (nr>0)
2473  R->names[i]=omStrDup(currRing->names[nr-1]);
2474  else
2475  {
2476  Werror("var name %d must be a string or a ring variable",i+1);
2477  return TRUE;
2478  }
2479  }
2480  else
2481  {
2482  Werror("var name %d must be `string` (not %d)",i+1, v->m[i].Typ());
2483  return TRUE;
2484  }
2485  }
2486  }
2487  else
2488  {
2489  WerrorS("variable must be given as `list`");
2490  return TRUE;
2491  }
2492  return FALSE;
2493 }
2494 
2495 static inline BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
2496 {
2497  assume(R!=NULL);
2498  long bitmask=0L;
2499  if (L->m[2].Typ()==LIST_CMD)
2500  {
2501  lists v=(lists)L->m[2].Data();
2502  int n= v->nr+2;
2503  int j_in_R,j_in_L;
2504  // do we have an entry "L",... ?: set bitmask
2505  for (int j=0; j < n-1; j++)
2506  {
2507  if (v->m[j].Typ()==LIST_CMD)
2508  {
2509  lists vv=(lists)v->m[j].Data();
2510  if ((vv->nr==1)
2511  &&(vv->m[0].Typ()==STRING_CMD)
2512  &&(strcmp((char*)vv->m[0].Data(),"L")==0))
2513  {
2514  number nn=(number)vv->m[1].Data();
2515  if (vv->m[1].Typ()==BIGINT_CMD)
2516  bitmask=n_Int(nn,coeffs_BIGINT);
2517  else if (vv->m[1].Typ()==INT_CMD)
2518  bitmask=(long)nn;
2519  else
2520  {
2521  Werror("illegal argument for pseudo ordering L: %d",vv->m[1].Typ());
2522  return TRUE;
2523  }
2524  break;
2525  }
2526  }
2527  }
2528  if (bitmask!=0) n--;
2529 
2530  // initialize fields of R
2531  R->order=(rRingOrder_t *)omAlloc0((n+1)*sizeof(rRingOrder_t));
2532  R->block0=(int *)omAlloc0((n+1)*sizeof(int));
2533  R->block1=(int *)omAlloc0((n+1)*sizeof(int));
2534  R->wvhdl=(int**)omAlloc0((n+1)*sizeof(int_ptr));
2535  // init order, so that rBlocks works correctly
2536  for (j_in_R= n-2; j_in_R>=0; j_in_R--)
2537  R->order[j_in_R] = ringorder_unspec;
2538  // orderings
2539  for(j_in_R=0,j_in_L=0;j_in_R<n-1;j_in_R++,j_in_L++)
2540  {
2541  // todo: a(..), M
2542  if (v->m[j_in_L].Typ()!=LIST_CMD)
2543  {
2544  WerrorS("ordering must be list of lists");
2545  return TRUE;
2546  }
2547  lists vv=(lists)v->m[j_in_L].Data();
2548  if ((vv->nr==1)
2549  && (vv->m[0].Typ()==STRING_CMD))
2550  {
2551  if (strcmp((char*)vv->m[0].Data(),"L")==0)
2552  {
2553  j_in_R--;
2554  continue;
2555  }
2556  if ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD)
2557  && (vv->m[1].Typ()!=INTMAT_CMD))
2558  {
2559  PrintS(lString(vv));
2560  Werror("ordering name must be a (string,intvec), not (string,%s)",Tok2Cmdname(vv->m[1].Typ()));
2561  return TRUE;
2562  }
2563  R->order[j_in_R]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2564 
2565  if (j_in_R==0) R->block0[0]=1;
2566  else
2567  {
2568  int jj=j_in_R-1;
2569  while((jj>=0)
2570  && ((R->order[jj]== ringorder_a)
2571  || (R->order[jj]== ringorder_aa)
2572  || (R->order[jj]== ringorder_am)
2573  || (R->order[jj]== ringorder_c)
2574  || (R->order[jj]== ringorder_C)
2575  || (R->order[jj]== ringorder_s)
2576  || (R->order[jj]== ringorder_S)
2577  ))
2578  {
2579  //Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2580  jj--;
2581  }
2582  if (jj<0) R->block0[j_in_R]=1;
2583  else R->block0[j_in_R]=R->block1[jj]+1;
2584  }
2585  intvec *iv;
2586  if (vv->m[1].Typ()==INT_CMD)
2587  {
2588  int l=si_max(1,(int)(long)vv->m[1].Data());
2589  iv=new intvec(l);
2590  for(int i=0;i<l;i++) (*iv)[i]=1;
2591  }
2592  else
2593  iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC/INTMAT
2594  int iv_len=iv->length();
2595  if (iv_len==0)
2596  {
2597  Werror("empty intvec for ordering %d (%s)",j_in_R+1,rSimpleOrdStr(R->order[j_in_R]));
2598  return TRUE;
2599  }
2600  if (R->order[j_in_R]==ringorder_M)
2601  {
2602  if (vv->m[1].rtyp==INTMAT_CMD) iv->makeVector();
2603  iv_len=iv->length();
2604  }
2605  if ((R->order[j_in_R]!=ringorder_s)
2606  &&(R->order[j_in_R]!=ringorder_c)
2607  &&(R->order[j_in_R]!=ringorder_C))
2608  {
2609  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+iv_len-1);
2610  if (R->block1[j_in_R]>R->N)
2611  {
2612  if (R->block0[j_in_R]>R->N)
2613  {
2614  Werror("not enough variables for ordering %d (%s)",j_in_R,rSimpleOrdStr(R->order[j_in_R]));
2615  return TRUE;
2616  }
2617  R->block1[j_in_R]=R->N;
2618  iv_len=R->block1[j_in_R]-R->block0[j_in_R]+1;
2619  }
2620  //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2621  }
2622  int i;
2623  switch (R->order[j_in_R])
2624  {
2625  case ringorder_ws:
2626  case ringorder_Ws:
2627  R->OrdSgn=-1; // and continue
2628  case ringorder_aa:
2629  case ringorder_a:
2630  case ringorder_wp:
2631  case ringorder_Wp:
2632  R->wvhdl[j_in_R] =( int *)omAlloc(iv_len*sizeof(int));
2633  for (i=0; i<iv_len;i++)
2634  {
2635  R->wvhdl[j_in_R][i]=(*iv)[i];
2636  }
2637  break;
2638  case ringorder_am:
2639  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2640  for (i=0; i<iv_len;i++)
2641  {
2642  R->wvhdl[j_in_R][i]=(*iv)[i];
2643  }
2644  R->wvhdl[j_in_R][i]=iv->length() - iv_len;
2645  //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2646  for (; i<iv->length(); i++)
2647  {
2648  R->wvhdl[j_in_R][i+1]=(*iv)[i];
2649  }
2650  break;
2651  case ringorder_M:
2652  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length())*sizeof(int));
2653  for (i=0; i<iv->length();i++) R->wvhdl[j_in_R][i]=(*iv)[i];
2654  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+(int)sqrt((double)(iv->length())));
2655  if (R->block1[j_in_R]>R->N)
2656  {
2657  R->block1[j_in_R]=R->N;
2658  }
2659  break;
2660  case ringorder_ls:
2661  case ringorder_ds:
2662  case ringorder_Ds:
2663  case ringorder_rs:
2664  R->OrdSgn=-1;
2665  case ringorder_lp:
2666  case ringorder_dp:
2667  case ringorder_Dp:
2668  case ringorder_rp:
2669  #if 0
2670  for (i=0; i<iv_len;i++)
2671  {
2672  if (((*iv)[i]!=1)&&(iv_len!=1))
2673  {
2674  iv->show(1);
2675  Warn("ignore weight %d for ord %d (%s) at pos %d\n>>%s<<",
2676  (*iv)[i],j_in_R+1,rSimpleOrdStr(R->order[j_in_R]),i+1,my_yylinebuf);
2677  break;
2678  }
2679  }
2680  #endif // break absfact.tst
2681  break;
2682  case ringorder_S:
2683  break;
2684  case ringorder_c:
2685  case ringorder_C:
2686  R->block1[j_in_R]=R->block0[j_in_R]=0;
2687  break;
2688 
2689  case ringorder_s:
2690  R->block1[j_in_R]=R->block0[j_in_R]=(*iv)[0];
2691  rSetSyzComp(R->block0[j_in_R],R);
2692  break;
2693 
2694  case ringorder_IS:
2695  {
2696  R->block1[j_in_R] = R->block0[j_in_R] = 0;
2697  if( iv->length() > 0 )
2698  {
2699  const int s = (*iv)[0];
2700  assume( -2 < s && s < 2 );
2701  R->block1[j_in_R] = R->block0[j_in_R] = s;
2702  }
2703  break;
2704  }
2705  case 0:
2706  case ringorder_unspec:
2707  break;
2708  case ringorder_L: /* cannot happen */
2709  case ringorder_a64: /*not implemented */
2710  WerrorS("ring order not implemented");
2711  return TRUE;
2712  }
2713  delete iv;
2714  }
2715  else
2716  {
2717  PrintS(lString(vv));
2718  WerrorS("ordering name must be a (string,intvec)");
2719  return TRUE;
2720  }
2721  }
2722  // sanity check
2723  j_in_R=n-2;
2724  if ((R->order[j_in_R]==ringorder_c)
2725  || (R->order[j_in_R]==ringorder_C)
2726  || (R->order[j_in_R]==ringorder_unspec)) j_in_R--;
2727  if (R->block1[j_in_R] != R->N)
2728  {
2729  if (((R->order[j_in_R]==ringorder_dp) ||
2730  (R->order[j_in_R]==ringorder_ds) ||
2731  (R->order[j_in_R]==ringorder_Dp) ||
2732  (R->order[j_in_R]==ringorder_Ds) ||
2733  (R->order[j_in_R]==ringorder_rp) ||
2734  (R->order[j_in_R]==ringorder_rs) ||
2735  (R->order[j_in_R]==ringorder_lp) ||
2736  (R->order[j_in_R]==ringorder_ls))
2737  &&
2738  R->block0[j_in_R] <= R->N)
2739  {
2740  R->block1[j_in_R] = R->N;
2741  }
2742  else
2743  {
2744  Werror("ordering incomplete: size (%d) should be %d",R->block1[j_in_R],R->N);
2745  return TRUE;
2746  }
2747  }
2748  if (R->block0[j_in_R]>R->N)
2749  {
2750  Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j_in_R+1);
2751  for(int ii=0;ii<=j_in_R;ii++)
2752  Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2753  return TRUE;
2754  }
2755  if (check_comp)
2756  {
2757  BOOLEAN comp_order=FALSE;
2758  int jj;
2759  for(jj=0;jj<n;jj++)
2760  {
2761  if ((R->order[jj]==ringorder_c) ||
2762  (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2763  }
2764  if (!comp_order)
2765  {
2766  R->order=(rRingOrder_t*)omRealloc0Size(R->order,n*sizeof(rRingOrder_t),(n+1)*sizeof(rRingOrder_t));
2767  R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2768  R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2769  R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2770  R->order[n-1]=ringorder_C;
2771  R->block0[n-1]=0;
2772  R->block1[n-1]=0;
2773  R->wvhdl[n-1]=NULL;
2774  n++;
2775  }
2776  }
2777  }
2778  else
2779  {
2780  WerrorS("ordering must be given as `list`");
2781  return TRUE;
2782  }
2783  if (bitmask!=0) { R->bitmask=bitmask; R->wanted_maxExp=bitmask; }
2784  return FALSE;
2785 }
2786 
2787 ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask,const int isLetterplace)
2788 {
2789  if ((L->nr!=3)
2790 #ifdef HAVE_PLURAL
2791  &&(L->nr!=5)
2792 #endif
2793  )
2794  return NULL;
2795  int is_gf_char=0;
2796  // 0: char/ cf - ring
2797  // 1: list (var)
2798  // 2: list (ord)
2799  // 3: qideal
2800  // possibly:
2801  // 4: C
2802  // 5: D
2803 
2804  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2805 
2806  // ------------------------------------------------------------------
2807  // 0: char:
2808  if (L->m[0].Typ()==CRING_CMD)
2809  {
2810  R->cf=(coeffs)L->m[0].Data();
2811  R->cf->ref++;
2812  }
2813  else if (L->m[0].Typ()==INT_CMD)
2814  {
2815  int ch = (int)(long)L->m[0].Data();
2816  assume( ch >= 0 );
2817 
2818  if (ch == 0) // Q?
2819  R->cf = nInitChar(n_Q, NULL);
2820  else
2821  {
2822  int l = IsPrime(ch); // Zp?
2823  if( l != ch )
2824  {
2825  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2826  ch = l;
2827  }
2828  #ifndef TEST_ZN_AS_ZP
2829  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2830  #else
2831  mpz_t modBase;
2832  mpz_init_set_ui(modBase,(long) ch);
2833  ZnmInfo info;
2834  info.base= modBase;
2835  info.exp= 1;
2836  R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2837  R->cf->is_field=1;
2838  R->cf->is_domain=1;
2839  R->cf->has_simple_Inverse=1;
2840  #endif
2841  }
2842  }
2843  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2844  {
2845  lists LL=(lists)L->m[0].Data();
2846 
2847 #ifdef HAVE_RINGS
2848  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2849  {
2850  rComposeRing(LL, R); // Ring!?
2851  }
2852  else
2853 #endif
2854  if (LL->nr < 3)
2855  rComposeC(LL,R); // R, long_R, long_C
2856  else
2857  {
2858  if (LL->m[0].Typ()==INT_CMD)
2859  {
2860  int ch = (int)(long)LL->m[0].Data();
2861  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2862  if (fftable[is_gf_char]==0) is_gf_char=-1;
2863 
2864  if(is_gf_char!= -1)
2865  {
2866  GFInfo param;
2867 
2868  param.GFChar = ch;
2869  param.GFDegree = 1;
2870  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2871 
2872  // nfInitChar should be able to handle the case when ch is in fftables!
2873  R->cf = nInitChar(n_GF, (void*)&param);
2874  }
2875  }
2876 
2877  if( R->cf == NULL )
2878  {
2879  ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2880 
2881  if (extRing==NULL)
2882  {
2883  WerrorS("could not create the specified coefficient field");
2884  goto rCompose_err;
2885  }
2886 
2887  if( extRing->qideal != NULL ) // Algebraic extension
2888  {
2889  AlgExtInfo extParam;
2890 
2891  extParam.r = extRing;
2892 
2893  R->cf = nInitChar(n_algExt, (void*)&extParam);
2894  }
2895  else // Transcendental extension
2896  {
2897  TransExtInfo extParam;
2898  extParam.r = extRing;
2899  assume( extRing->qideal == NULL );
2900 
2901  R->cf = nInitChar(n_transExt, &extParam);
2902  }
2903  }
2904  }
2905  }
2906  else
2907  {
2908  WerrorS("coefficient field must be described by `int` or `list`");
2909  goto rCompose_err;
2910  }
2911 
2912  if( R->cf == NULL )
2913  {
2914  WerrorS("could not create coefficient field described by the input!");
2915  goto rCompose_err;
2916  }
2917 
2918  // ------------------------- VARS ---------------------------
2919  if (rComposeVar(L,R)) goto rCompose_err;
2920  // ------------------------ ORDER ------------------------------
2921  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2922 
2923  // ------------------------ ??????? --------------------
2924 
2925  if (!isLetterplace) rRenameVars(R);
2926  #ifdef HAVE_SHIFTBBA
2927  else
2928  {
2929  R->isLPring=isLetterplace;
2930  R->ShortOut=FALSE;
2931  R->CanShortOut=FALSE;
2932  }
2933  #endif
2934  if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
2935  rComplete(R);
2936 
2937  // ------------------------ Q-IDEAL ------------------------
2938 
2939  if (L->m[3].Typ()==IDEAL_CMD)
2940  {
2941  ideal q=(ideal)L->m[3].Data();
2942  if (q->m[0]!=NULL)
2943  {
2944  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2945  {
2946  #if 0
2947  WerrorS("coefficient fields must be equal if q-ideal !=0");
2948  goto rCompose_err;
2949  #else
2950  ring orig_ring=currRing;
2951  rChangeCurrRing(R);
2952  int *perm=NULL;
2953  int *par_perm=NULL;
2954  int par_perm_size=0;
2955  nMapFunc nMap;
2956 
2957  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2958  {
2959  if (rEqual(orig_ring,currRing))
2960  {
2961  nMap=n_SetMap(currRing->cf, currRing->cf);
2962  }
2963  else
2964  // Allow imap/fetch to be make an exception only for:
2965  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2969  ||
2970  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2971  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2972  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2973  {
2974  par_perm_size=rPar(orig_ring);
2975 
2976 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2977 // naSetChar(rInternalChar(orig_ring),orig_ring);
2978 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2979 
2980  nSetChar(currRing->cf);
2981  }
2982  else
2983  {
2984  WerrorS("coefficient fields must be equal if q-ideal !=0");
2985  goto rCompose_err;
2986  }
2987  }
2988  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2989  if (par_perm_size!=0)
2990  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2991  int i;
2992  #if 0
2993  // use imap:
2994  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2995  currRing->names,currRing->N,currRing->parameter, currRing->P,
2996  perm,par_perm, currRing->ch);
2997  #else
2998  // use fetch
2999  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
3000  {
3001  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
3002  }
3003  else if (par_perm_size!=0)
3004  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3005  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3006  #endif
3007  ideal dest_id=idInit(IDELEMS(q),1);
3008  for(i=IDELEMS(q)-1; i>=0; i--)
3009  {
3010  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3011  par_perm,par_perm_size);
3012  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3013  pTest(dest_id->m[i]);
3014  }
3015  R->qideal=dest_id;
3016  if (perm!=NULL)
3017  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3018  if (par_perm!=NULL)
3019  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3020  rChangeCurrRing(orig_ring);
3021  #endif
3022  }
3023  else
3024  R->qideal=idrCopyR(q,currRing,R);
3025  }
3026  }
3027  else
3028  {
3029  WerrorS("q-ideal must be given as `ideal`");
3030  goto rCompose_err;
3031  }
3032 
3033 
3034  // ---------------------------------------------------------------
3035  #ifdef HAVE_PLURAL
3036  if (L->nr==5)
3037  {
3038  if (nc_CallPlural((matrix)L->m[4].Data(),
3039  (matrix)L->m[5].Data(),
3040  NULL,NULL,
3041  R,
3042  true, // !!!
3043  true, false,
3044  currRing, FALSE)) goto rCompose_err;
3045  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3046  }
3047  #endif
3048  return R;
3049 
3050 rCompose_err:
3051  if (R->N>0)
3052  {
3053  int i;
3054  if (R->names!=NULL)
3055  {
3056  i=R->N-1;
3057  while (i>=0) { omfree(R->names[i]); i--; }
3058  omFree(R->names);
3059  }
3060  }
3061  omfree(R->order);
3062  omfree(R->block0);
3063  omfree(R->block1);
3064  omfree(R->wvhdl);
3065  omFree(R);
3066  return NULL;
3067 }
3068 
3069 // from matpol.cc
3070 
3071 /*2
3072 * compute the jacobi matrix of an ideal
3073 */
3075 {
3076  int i,j;
3077  matrix result;
3078  ideal id=(ideal)a->Data();
3079 
3080  result =mpNew(IDELEMS(id),rVar(currRing));
3081  for (i=1; i<=IDELEMS(id); i++)
3082  {
3083  for (j=1; j<=rVar(currRing); j++)
3084  {
3085  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3086  }
3087  }
3088  res->data=(char *)result;
3089  return FALSE;
3090 }
3091 
3092 /*2
3093 * returns the Koszul-matrix of degree d of a vectorspace with dimension n
3094 * uses the first n entrees of id, if id <> NULL
3095 */
3097 {
3098  int n=(int)(long)b->Data();
3099  int d=(int)(long)c->Data();
3100  int k,l,sign,row,col;
3101  matrix result;
3102  ideal temp;
3103  BOOLEAN bo;
3104  poly p;
3105 
3106  if ((d>n) || (d<1) || (n<1))
3107  {
3108  res->data=(char *)mpNew(1,1);
3109  return FALSE;
3110  }
3111  int *choise = (int*)omAlloc(d*sizeof(int));
3112  if (id==NULL)
3113  temp=idMaxIdeal(1);
3114  else
3115  temp=(ideal)id->Data();
3116 
3117  k = binom(n,d);
3118  l = k*d;
3119  l /= n-d+1;
3120  result =mpNew(l,k);
3121  col = 1;
3122  idInitChoise(d,1,n,&bo,choise);
3123  while (!bo)
3124  {
3125  sign = 1;
3126  for (l=1;l<=d;l++)
3127  {
3128  if (choise[l-1]<=IDELEMS(temp))
3129  {
3130  p = pCopy(temp->m[choise[l-1]-1]);
3131  if (sign == -1) p = pNeg(p);
3132  sign *= -1;
3133  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3134  MATELEM(result,row,col) = p;
3135  }
3136  }
3137  col++;
3138  idGetNextChoise(d,n,&bo,choise);
3139  }
3140  omFreeSize(choise,d*sizeof(int));
3141  if (id==NULL) idDelete(&temp);
3142 
3143  res->data=(char *)result;
3144  return FALSE;
3145 }
3146 
3147 // from syz1.cc
3148 /*2
3149 * read out the Betti numbers from resolution
3150 * (interpreter interface)
3151 */
3153 {
3154  syStrategy syzstr=(syStrategy)u->Data();
3155 
3156  BOOLEAN minim=(int)(long)w->Data();
3157  int row_shift=0;
3158  int add_row_shift=0;
3159  intvec *weights=NULL;
3160  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3161  if (ww!=NULL)
3162  {
3163  weights=ivCopy(ww);
3164  add_row_shift = ww->min_in();
3165  (*weights) -= add_row_shift;
3166  }
3167 
3168  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3169  //row_shift += add_row_shift;
3170  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3171  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3172 
3173  return FALSE;
3174 }
3176 {
3177  sleftv tmp;
3178  tmp.Init();
3179  tmp.rtyp=INT_CMD;
3180  tmp.data=(void *)1;
3181  return syBetti2(res,u,&tmp);
3182 }
3183 
3184 /*3
3185 * converts a resolution into a list of modules
3186 */
3187 lists syConvRes(syStrategy syzstr,BOOLEAN toDel,int add_row_shift)
3188 {
3189  resolvente fullres = syzstr->fullres;
3190  resolvente minres = syzstr->minres;
3191 
3192  const int length = syzstr->length;
3193 
3194  if ((fullres==NULL) && (minres==NULL))
3195  {
3196  if (syzstr->hilb_coeffs==NULL)
3197  { // La Scala
3198  fullres = syReorder(syzstr->res, length, syzstr);
3199  }
3200  else
3201  { // HRES
3202  minres = syReorder(syzstr->orderedRes, length, syzstr);
3203  syKillEmptyEntres(minres, length);
3204  }
3205  }
3206 
3207  resolvente tr;
3208  int typ0=IDEAL_CMD;
3209 
3210  if (minres!=NULL)
3211  tr = minres;
3212  else
3213  tr = fullres;
3214 
3215  resolvente trueres=NULL;
3216  intvec ** w=NULL;
3217 
3218  if (length>0)
3219  {
3220  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3221  for (int i=length-1;i>=0;i--)
3222  {
3223  if (tr[i]!=NULL)
3224  {
3225  trueres[i] = idCopy(tr[i]);
3226  }
3227  }
3228  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3229  typ0 = MODUL_CMD;
3230  if (syzstr->weights!=NULL)
3231  {
3232  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3233  for (int i=length-1;i>=0;i--)
3234  {
3235  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3236  }
3237  }
3238  }
3239 
3240  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3241  w, add_row_shift);
3242 
3243  if (toDel)
3244  syKillComputation(syzstr);
3245  else
3246  {
3247  if( fullres != NULL && syzstr->fullres == NULL )
3248  syzstr->fullres = fullres;
3249 
3250  if( minres != NULL && syzstr->minres == NULL )
3251  syzstr->minres = minres;
3252  }
3253  return li;
3254 }
3255 
3256 /*3
3257 * converts a list of modules into a resolution
3258 */
3260 {
3261  int typ0;
3263 
3264  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3265  if (fr != NULL)
3266  {
3267 
3268  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3269  for (int i=result->length-1;i>=0;i--)
3270  {
3271  if (fr[i]!=NULL)
3272  result->fullres[i] = idCopy(fr[i]);
3273  }
3274  result->list_length=result->length;
3275  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3276  }
3277  else
3278  {
3279  omFreeSize(result, sizeof(ssyStrategy));
3280  result = NULL;
3281  }
3282  return result;
3283 }
3284 
3285 /*3
3286 * converts a list of modules into a minimal resolution
3287 */
3289 {
3290  int typ0;
3292 
3293  resolvente fr = liFindRes(li,&(result->length),&typ0);
3294  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3295  for (int i=result->length-1;i>=0;i--)
3296  {
3297  if (fr[i]!=NULL)
3298  result->minres[i] = idCopy(fr[i]);
3299  }
3300  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3301  return result;
3302 }
3303 // from weight.cc
3305 {
3306  ideal F=(ideal)id->Data();
3307  intvec * iv = new intvec(rVar(currRing));
3308  polyset s;
3309  int sl, n, i;
3310  int *x;
3311 
3312  res->data=(char *)iv;
3313  s = F->m;
3314  sl = IDELEMS(F) - 1;
3315  n = rVar(currRing);
3316  double wNsqr = (double)2.0 / (double)n;
3318  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3319  wCall(s, sl, x, wNsqr, currRing);
3320  for (i = n; i!=0; i--)
3321  (*iv)[i-1] = x[i + n + 1];
3322  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3323  return FALSE;
3324 }
3325 
3327 {
3328  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3329  if (res->data==NULL)
3330  res->data=(char *)new intvec(rVar(currRing));
3331  return FALSE;
3332 }
3333 /*==============================================================*/
3334 // from clapsing.cc
3335 #if 0
3336 BOOLEAN jjIS_SQR_FREE(leftv res, leftv u)
3337 {
3338  BOOLEAN b=singclap_factorize((poly)(u->CopyD()), &v, 0);
3339  res->data=(void *)b;
3340 }
3341 #endif
3342 
3344 {
3345  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3346  (poly)w->CopyD(), currRing);
3347  return errorreported;
3348 }
3349 
3351 {
3352  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3353  return (res->data==NULL);
3354 }
3355 
3356 // from semic.cc
3357 #ifdef HAVE_SPECTRUM
3358 
3359 // ----------------------------------------------------------------------------
3360 // Initialize a spectrum deep from a singular lists
3361 // ----------------------------------------------------------------------------
3362 
3363 void copy_deep( spectrum& spec, lists l )
3364 {
3365  spec.mu = (int)(long)(l->m[0].Data( ));
3366  spec.pg = (int)(long)(l->m[1].Data( ));
3367  spec.n = (int)(long)(l->m[2].Data( ));
3368 
3369  spec.copy_new( spec.n );
3370 
3371  intvec *num = (intvec*)l->m[3].Data( );
3372  intvec *den = (intvec*)l->m[4].Data( );
3373  intvec *mul = (intvec*)l->m[5].Data( );
3374 
3375  for( int i=0; i<spec.n; i++ )
3376  {
3377  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3378  spec.w[i] = (*mul)[i];
3379  }
3380 }
3381 
3382 // ----------------------------------------------------------------------------
3383 // singular lists constructor for spectrum
3384 // ----------------------------------------------------------------------------
3385 
3386 spectrum /*former spectrum::spectrum ( lists l )*/
3388 {
3389  spectrum result;
3390  copy_deep( result, l );
3391  return result;
3392 }
3393 
3394 // ----------------------------------------------------------------------------
3395 // generate a Singular lists from a spectrum
3396 // ----------------------------------------------------------------------------
3397 
3398 /* former spectrum::thelist ( void )*/
3400 {
3402 
3403  L->Init( 6 );
3404 
3405  intvec *num = new intvec( spec.n );
3406  intvec *den = new intvec( spec.n );
3407  intvec *mult = new intvec( spec.n );
3408 
3409  for( int i=0; i<spec.n; i++ )
3410  {
3411  (*num) [i] = spec.s[i].get_num_si( );
3412  (*den) [i] = spec.s[i].get_den_si( );
3413  (*mult)[i] = spec.w[i];
3414  }
3415 
3416  L->m[0].rtyp = INT_CMD; // milnor number
3417  L->m[1].rtyp = INT_CMD; // geometrical genus
3418  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3419  L->m[3].rtyp = INTVEC_CMD; // numerators
3420  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3421  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3422 
3423  L->m[0].data = (void*)(long)spec.mu;
3424  L->m[1].data = (void*)(long)spec.pg;
3425  L->m[2].data = (void*)(long)spec.n;
3426  L->m[3].data = (void*)num;
3427  L->m[4].data = (void*)den;
3428  L->m[5].data = (void*)mult;
3429 
3430  return L;
3431 }
3432 // from spectrum.cc
3433 // ----------------------------------------------------------------------------
3434 // print out an error message for a spectrum list
3435 // ----------------------------------------------------------------------------
3436 
3437 typedef enum
3438 {
3441 
3444 
3451 
3456 
3462 
3465 
3468 
3470 
3471 void list_error( semicState state )
3472 {
3473  switch( state )
3474  {
3475  case semicListTooShort:
3476  WerrorS( "the list is too short" );
3477  break;
3478  case semicListTooLong:
3479  WerrorS( "the list is too long" );
3480  break;
3481 
3483  WerrorS( "first element of the list should be int" );
3484  break;
3486  WerrorS( "second element of the list should be int" );
3487  break;
3489  WerrorS( "third element of the list should be int" );
3490  break;
3492  WerrorS( "fourth element of the list should be intvec" );
3493  break;
3495  WerrorS( "fifth element of the list should be intvec" );
3496  break;
3498  WerrorS( "sixth element of the list should be intvec" );
3499  break;
3500 
3501  case semicListNNegative:
3502  WerrorS( "first element of the list should be positive" );
3503  break;
3505  WerrorS( "wrong number of numerators" );
3506  break;
3508  WerrorS( "wrong number of denominators" );
3509  break;
3511  WerrorS( "wrong number of multiplicities" );
3512  break;
3513 
3514  case semicListMuNegative:
3515  WerrorS( "the Milnor number should be positive" );
3516  break;
3517  case semicListPgNegative:
3518  WerrorS( "the geometrical genus should be nonnegative" );
3519  break;
3520  case semicListNumNegative:
3521  WerrorS( "all numerators should be positive" );
3522  break;
3523  case semicListDenNegative:
3524  WerrorS( "all denominators should be positive" );
3525  break;
3526  case semicListMulNegative:
3527  WerrorS( "all multiplicities should be positive" );
3528  break;
3529 
3530  case semicListNotSymmetric:
3531  WerrorS( "it is not symmetric" );
3532  break;
3534  WerrorS( "it is not monotonous" );
3535  break;
3536 
3537  case semicListMilnorWrong:
3538  WerrorS( "the Milnor number is wrong" );
3539  break;
3540  case semicListPGWrong:
3541  WerrorS( "the geometrical genus is wrong" );
3542  break;
3543 
3544  default:
3545  WerrorS( "unspecific error" );
3546  break;
3547  }
3548 }
3549 // ----------------------------------------------------------------------------
3550 // this is the main spectrum computation function
3551 // ----------------------------------------------------------------------------
3552 
3554 {
3564 };
3565 
3566 // from splist.cc
3567 // ----------------------------------------------------------------------------
3568 // Compute the spectrum of a spectrumPolyList
3569 // ----------------------------------------------------------------------------
3570 
3571 /* former spectrumPolyList::spectrum ( lists*, int) */
3573 {
3574  spectrumPolyNode **node = &speclist.root;
3576 
3577  poly f,tmp;
3578  int found,cmp;
3579 
3580  Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3581  ( fast==2 ? 2 : 1 ) );
3582 
3583  Rational weight_prev( 0,1 );
3584 
3585  int mu = 0; // the milnor number
3586  int pg = 0; // the geometrical genus
3587  int n = 0; // number of different spectral numbers
3588  int z = 0; // number of spectral number equal to smax
3589 
3590  while( (*node)!=(spectrumPolyNode*)NULL &&
3591  ( fast==0 || (*node)->weight<=smax ) )
3592  {
3593  // ---------------------------------------
3594  // determine the first normal form which
3595  // contains the monomial node->mon
3596  // ---------------------------------------
3597 
3598  found = FALSE;
3599  search = *node;
3600 
3601  while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3602  {
3603  if( search->nf!=(poly)NULL )
3604  {
3605  f = search->nf;
3606 
3607  do
3608  {
3609  // --------------------------------
3610  // look for (*node)->mon in f
3611  // --------------------------------
3612 
3613  cmp = pCmp( (*node)->mon,f );
3614 
3615  if( cmp<0 )
3616  {
3617  f = pNext( f );
3618  }
3619  else if( cmp==0 )
3620  {
3621  // -----------------------------
3622  // we have found a normal form
3623  // -----------------------------
3624 
3625  found = TRUE;
3626 
3627  // normalize coefficient
3628 
3629  number inv = nInvers( pGetCoeff( f ) );
3630  search->nf=__p_Mult_nn( search->nf,inv,currRing );
3631  nDelete( &inv );
3632 
3633  // exchange normal forms
3634 
3635  tmp = (*node)->nf;
3636  (*node)->nf = search->nf;
3637  search->nf = tmp;
3638  }
3639  }
3640  while( cmp<0 && f!=(poly)NULL );
3641  }
3642  search = search->next;
3643  }
3644 
3645  if( found==FALSE )
3646  {
3647  // ------------------------------------------------
3648  // the weight of node->mon is a spectrum number
3649  // ------------------------------------------------
3650 
3651  mu++;
3652 
3653  if( (*node)->weight<=(Rational)1 ) pg++;
3654  if( (*node)->weight==smax ) z++;
3655  if( (*node)->weight>weight_prev ) n++;
3656 
3657  weight_prev = (*node)->weight;
3658  node = &((*node)->next);
3659  }
3660  else
3661  {
3662  // -----------------------------------------------
3663  // determine all other normal form which contain
3664  // the monomial node->mon
3665  // replace for node->mon its normal form
3666  // -----------------------------------------------
3667 
3668  while( search!=(spectrumPolyNode*)NULL )
3669  {
3670  if( search->nf!=(poly)NULL )
3671  {
3672  f = search->nf;
3673 
3674  do
3675  {
3676  // --------------------------------
3677  // look for (*node)->mon in f
3678  // --------------------------------
3679 
3680  cmp = pCmp( (*node)->mon,f );
3681 
3682  if( cmp<0 )
3683  {
3684  f = pNext( f );
3685  }
3686  else if( cmp==0 )
3687  {
3688  search->nf = pSub( search->nf,
3689  __pp_Mult_nn( (*node)->nf,pGetCoeff( f ),currRing ) );
3690  pNorm( search->nf );
3691  }
3692  }
3693  while( cmp<0 && f!=(poly)NULL );
3694  }
3695  search = search->next;
3696  }
3697  speclist.delete_node( node );
3698  }
3699 
3700  }
3701 
3702  // --------------------------------------------------------
3703  // fast computation exploits the symmetry of the spectrum
3704  // --------------------------------------------------------
3705 
3706  if( fast==2 )
3707  {
3708  mu = 2*mu - z;
3709  n = ( z > 0 ? 2*n - 1 : 2*n );
3710  }
3711 
3712  // --------------------------------------------------------
3713  // compute the spectrum numbers with their multiplicities
3714  // --------------------------------------------------------
3715 
3716  intvec *nom = new intvec( n );
3717  intvec *den = new intvec( n );
3718  intvec *mult = new intvec( n );
3719 
3720  int count = 0;
3721  int multiplicity = 1;
3722 
3723  for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3724  ( fast==0 || search->weight<=smax );
3725  search=search->next )
3726  {
3727  if( search->next==(spectrumPolyNode*)NULL ||
3728  search->weight<search->next->weight )
3729  {
3730  (*nom) [count] = search->weight.get_num_si( );
3731  (*den) [count] = search->weight.get_den_si( );
3732  (*mult)[count] = multiplicity;
3733 
3734  multiplicity=1;
3735  count++;
3736  }
3737  else
3738  {
3739  multiplicity++;
3740  }
3741  }
3742 
3743  // --------------------------------------------------------
3744  // fast computation exploits the symmetry of the spectrum
3745  // --------------------------------------------------------
3746 
3747  if( fast==2 )
3748  {
3749  int n1,n2;
3750  for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3751  {
3752  (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3753  (*den) [n2] = (*den)[n1];
3754  (*mult)[n2] = (*mult)[n1];
3755  }
3756  }
3757 
3758  // -----------------------------------
3759  // test if the spectrum is symmetric
3760  // -----------------------------------
3761 
3762  if( fast==0 || fast==1 )
3763  {
3764  int symmetric=TRUE;
3765 
3766  for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3767  {
3768  if( (*mult)[n1]!=(*mult)[n2] ||
3769  (*den) [n1]!= (*den)[n2] ||
3770  (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3771  {
3772  symmetric = FALSE;
3773  }
3774  }
3775 
3776  if( symmetric==FALSE )
3777  {
3778  // ---------------------------------------------
3779  // the spectrum is not symmetric => degenerate
3780  // principal part
3781  // ---------------------------------------------
3782 
3783  *L = (lists)omAllocBin( slists_bin);
3784  (*L)->Init( 1 );
3785  (*L)->m[0].rtyp = INT_CMD; // milnor number
3786  (*L)->m[0].data = (void*)(long)mu;
3787 
3788  return spectrumDegenerate;
3789  }
3790  }
3791 
3792  *L = (lists)omAllocBin( slists_bin);
3793 
3794  (*L)->Init( 6 );
3795 
3796  (*L)->m[0].rtyp = INT_CMD; // milnor number
3797  (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3798  (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3799  (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3800  (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3801  (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3802 
3803  (*L)->m[0].data = (void*)(long)mu;
3804  (*L)->m[1].data = (void*)(long)pg;
3805  (*L)->m[2].data = (void*)(long)n;
3806  (*L)->m[3].data = (void*)nom;
3807  (*L)->m[4].data = (void*)den;
3808  (*L)->m[5].data = (void*)mult;
3809 
3810  return spectrumOK;
3811 }
3812 
3814 {
3815  int i;
3816 
3817  #ifdef SPECTRUM_DEBUG
3818  #ifdef SPECTRUM_PRINT
3819  #ifdef SPECTRUM_IOSTREAM
3820  cout << "spectrumCompute\n";
3821  if( fast==0 ) cout << " no optimization" << endl;
3822  if( fast==1 ) cout << " weight optimization" << endl;
3823  if( fast==2 ) cout << " symmetry optimization" << endl;
3824  #else
3825  fputs( "spectrumCompute\n",stdout );
3826  if( fast==0 ) fputs( " no optimization\n", stdout );
3827  if( fast==1 ) fputs( " weight optimization\n", stdout );
3828  if( fast==2 ) fputs( " symmetry optimization\n", stdout );
3829  #endif
3830  #endif
3831  #endif
3832 
3833  // ----------------------
3834  // check if h is zero
3835  // ----------------------
3836 
3837  if( h==(poly)NULL )
3838  {
3839  return spectrumZero;
3840  }
3841 
3842  // ----------------------------------
3843  // check if h has a constant term
3844  // ----------------------------------
3845 
3846  if( hasConstTerm( h, currRing ) )
3847  {
3848  return spectrumBadPoly;
3849  }
3850 
3851  // --------------------------------
3852  // check if h has a linear term
3853  // --------------------------------
3854 
3855  if( hasLinearTerm( h, currRing ) )
3856  {
3857  *L = (lists)omAllocBin( slists_bin);
3858  (*L)->Init( 1 );
3859  (*L)->m[0].rtyp = INT_CMD; // milnor number
3860  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3861 
3862  return spectrumNoSingularity;
3863  }
3864 
3865  // ----------------------------------
3866  // compute the jacobi ideal of (h)
3867  // ----------------------------------
3868 
3869  ideal J = NULL;
3870  J = idInit( rVar(currRing),1 );
3871 
3872  #ifdef SPECTRUM_DEBUG
3873  #ifdef SPECTRUM_PRINT
3874  #ifdef SPECTRUM_IOSTREAM
3875  cout << "\n computing the Jacobi ideal...\n";
3876  #else
3877  fputs( "\n computing the Jacobi ideal...\n",stdout );
3878  #endif
3879  #endif
3880  #endif
3881 
3882  for( i=0; i<rVar(currRing); i++ )
3883  {
3884  J->m[i] = pDiff( h,i+1); //j );
3885 
3886  #ifdef SPECTRUM_DEBUG
3887  #ifdef SPECTRUM_PRINT
3888  #ifdef SPECTRUM_IOSTREAM
3889  cout << " ";
3890  #else
3891  fputs(" ", stdout );
3892  #endif
3893  pWrite( J->m[i] );
3894  #endif
3895  #endif
3896  }
3897 
3898  // --------------------------------------------
3899  // compute a standard basis stdJ of jac(h)
3900  // --------------------------------------------
3901 
3902  #ifdef SPECTRUM_DEBUG
3903  #ifdef SPECTRUM_PRINT
3904  #ifdef SPECTRUM_IOSTREAM
3905  cout << endl;
3906  cout << " computing a standard basis..." << endl;
3907  #else
3908  fputs( "\n", stdout );
3909  fputs( " computing a standard basis...\n", stdout );
3910  #endif
3911  #endif
3912  #endif
3913 
3914  ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3915  idSkipZeroes( stdJ );
3916 
3917  #ifdef SPECTRUM_DEBUG
3918  #ifdef SPECTRUM_PRINT
3919  for( i=0; i<IDELEMS(stdJ); i++ )
3920  {
3921  #ifdef SPECTRUM_IOSTREAM
3922  cout << " ";
3923  #else
3924  fputs( " ",stdout );
3925  #endif
3926 
3927  pWrite( stdJ->m[i] );
3928  }
3929  #endif
3930  #endif
3931 
3932  idDelete( &J );
3933 
3934  // ------------------------------------------
3935  // check if the h has a singularity
3936  // ------------------------------------------
3937 
3938  if( hasOne( stdJ, currRing ) )
3939  {
3940  // -------------------------------
3941  // h is smooth in the origin
3942  // return only the Milnor number
3943  // -------------------------------
3944 
3945  *L = (lists)omAllocBin( slists_bin);
3946  (*L)->Init( 1 );
3947  (*L)->m[0].rtyp = INT_CMD; // milnor number
3948  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3949 
3950  return spectrumNoSingularity;
3951  }
3952 
3953  // ------------------------------------------
3954  // check if the singularity h is isolated
3955  // ------------------------------------------
3956 
3957  for( i=rVar(currRing); i>0; i-- )
3958  {
3959  if( hasAxis( stdJ,i, currRing )==FALSE )
3960  {
3961  return spectrumNotIsolated;
3962  }
3963  }
3964 
3965  // ------------------------------------------
3966  // compute the highest corner hc of stdJ
3967  // ------------------------------------------
3968 
3969  #ifdef SPECTRUM_DEBUG
3970  #ifdef SPECTRUM_PRINT
3971  #ifdef SPECTRUM_IOSTREAM
3972  cout << "\n computing the highest corner...\n";
3973  #else
3974  fputs( "\n computing the highest corner...\n", stdout );
3975  #endif
3976  #endif
3977  #endif
3978 
3979  poly hc = (poly)NULL;
3980 
3981  scComputeHC( stdJ,currRing->qideal, 0,hc );
3982 
3983  if( hc!=(poly)NULL )
3984  {
3985  pGetCoeff(hc) = nInit(1);
3986 
3987  for( i=rVar(currRing); i>0; i-- )
3988  {
3989  if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3990  }
3991  pSetm( hc );
3992  }
3993  else
3994  {
3995  return spectrumNoHC;
3996  }
3997 
3998  #ifdef SPECTRUM_DEBUG
3999  #ifdef SPECTRUM_PRINT
4000  #ifdef SPECTRUM_IOSTREAM
4001  cout << " ";
4002  #else
4003  fputs( " ", stdout );
4004  #endif
4005  pWrite( hc );
4006  #endif
4007  #endif
4008 
4009  // ----------------------------------------
4010  // compute the Newton polygon nph of h
4011  // ----------------------------------------
4012 
4013  #ifdef SPECTRUM_DEBUG
4014  #ifdef SPECTRUM_PRINT
4015  #ifdef SPECTRUM_IOSTREAM
4016  cout << "\n computing the newton polygon...\n";
4017  #else
4018  fputs( "\n computing the newton polygon...\n", stdout );
4019  #endif
4020  #endif
4021  #endif
4022 
4023  newtonPolygon nph( h, currRing );
4024 
4025  #ifdef SPECTRUM_DEBUG
4026  #ifdef SPECTRUM_PRINT
4027  cout << nph;
4028  #endif
4029  #endif
4030 
4031  // -----------------------------------------------
4032  // compute the weight corner wc of (stdj,nph)
4033  // -----------------------------------------------
4034 
4035  #ifdef SPECTRUM_DEBUG
4036  #ifdef SPECTRUM_PRINT
4037  #ifdef SPECTRUM_IOSTREAM
4038  cout << "\n computing the weight corner...\n";
4039  #else
4040  fputs( "\n computing the weight corner...\n", stdout );
4041  #endif
4042  #endif
4043  #endif
4044 
4045  poly wc = ( fast==0 ? pCopy( hc ) :
4046  ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
4047  /* fast==2 */computeWC( nph,
4048  ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
4049 
4050  #ifdef SPECTRUM_DEBUG
4051  #ifdef SPECTRUM_PRINT
4052  #ifdef SPECTRUM_IOSTREAM
4053  cout << " ";
4054  #else
4055  fputs( " ", stdout );
4056  #endif
4057  pWrite( wc );
4058  #endif
4059  #endif
4060 
4061  // -------------
4062  // compute NF
4063  // -------------
4064 
4065  #ifdef SPECTRUM_DEBUG
4066  #ifdef SPECTRUM_PRINT
4067  #ifdef SPECTRUM_IOSTREAM
4068  cout << "\n computing NF...\n" << endl;
4069  #else
4070  fputs( "\n computing NF...\n", stdout );
4071  #endif
4072  #endif
4073  #endif
4074 
4075  spectrumPolyList NF( &nph );
4076 
4077  computeNF( stdJ,hc,wc,&NF, currRing );
4078 
4079  #ifdef SPECTRUM_DEBUG
4080  #ifdef SPECTRUM_PRINT
4081  cout << NF;
4082  #ifdef SPECTRUM_IOSTREAM
4083  cout << endl;
4084  #else
4085  fputs( "\n", stdout );
4086  #endif
4087  #endif
4088  #endif
4089 
4090  // ----------------------------
4091  // compute the spectrum of h
4092  // ----------------------------
4093 // spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
4094 
4095  return spectrumStateFromList(NF, L, fast );
4096 }
4097 
4098 // ----------------------------------------------------------------------------
4099 // this procedure is called from the interpreter
4100 // ----------------------------------------------------------------------------
4101 // first = polynomial
4102 // result = list of spectrum numbers
4103 // ----------------------------------------------------------------------------
4104 
4106 {
4107  switch( state )
4108  {
4109  case spectrumZero:
4110  WerrorS( "polynomial is zero" );
4111  break;
4112  case spectrumBadPoly:
4113  WerrorS( "polynomial has constant term" );
4114  break;
4115  case spectrumNoSingularity:
4116  WerrorS( "not a singularity" );
4117  break;
4118  case spectrumNotIsolated:
4119  WerrorS( "the singularity is not isolated" );
4120  break;
4121  case spectrumNoHC:
4122  WerrorS( "highest corner cannot be computed" );
4123  break;
4124  case spectrumDegenerate:
4125  WerrorS( "principal part is degenerate" );
4126  break;
4127  case spectrumOK:
4128  break;
4129 
4130  default:
4131  WerrorS( "unknown error occurred" );
4132  break;
4133  }
4134 }
4135 
4137 {
4138  spectrumState state = spectrumOK;
4139 
4140  // -------------------
4141  // check consistency
4142  // -------------------
4143 
4144  // check for a local ring
4145 
4146  if( !ringIsLocal(currRing ) )
4147  {
4148  WerrorS( "only works for local orderings" );
4149  state = spectrumWrongRing;
4150  }
4151 
4152  // no quotient rings are allowed
4153 
4154  else if( currRing->qideal != NULL )
4155  {
4156  WerrorS( "does not work in quotient rings" );
4157  state = spectrumWrongRing;
4158  }
4159  else
4160  {
4161  lists L = (lists)NULL;
4162  int flag = 1; // weight corner optimization is safe
4163 
4164  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4165 
4166  if( state==spectrumOK )
4167  {
4168  result->rtyp = LIST_CMD;
4169  result->data = (char*)L;
4170  }
4171  else
4172  {
4173  spectrumPrintError(state);
4174  }
4175  }
4176 
4177  return (state!=spectrumOK);
4178 }
4179 
4180 // ----------------------------------------------------------------------------
4181 // this procedure is called from the interpreter
4182 // ----------------------------------------------------------------------------
4183 // first = polynomial
4184 // result = list of spectrum numbers
4185 // ----------------------------------------------------------------------------
4186 
4188 {
4189  spectrumState state = spectrumOK;
4190 
4191  // -------------------
4192  // check consistency
4193  // -------------------
4194 
4195  // check for a local polynomial ring
4196 
4197  if( currRing->OrdSgn != -1 )
4198  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4199  // or should we use:
4200  //if( !ringIsLocal( ) )
4201  {
4202  WerrorS( "only works for local orderings" );
4203  state = spectrumWrongRing;
4204  }
4205  else if( currRing->qideal != NULL )
4206  {
4207  WerrorS( "does not work in quotient rings" );
4208  state = spectrumWrongRing;
4209  }
4210  else
4211  {
4212  lists L = (lists)NULL;
4213  int flag = 2; // symmetric optimization
4214 
4215  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4216 
4217  if( state==spectrumOK )
4218  {
4219  result->rtyp = LIST_CMD;
4220  result->data = (char*)L;
4221  }
4222  else
4223  {
4224  spectrumPrintError(state);
4225  }
4226  }
4227 
4228  return (state!=spectrumOK);
4229 }
4230 
4231 // ----------------------------------------------------------------------------
4232 // check if a list is a spectrum
4233 // check for:
4234 // list has 6 elements
4235 // 1st element is int (mu=Milnor number)
4236 // 2nd element is int (pg=geometrical genus)
4237 // 3rd element is int (n =number of different spectrum numbers)
4238 // 4th element is intvec (num=numerators)
4239 // 5th element is intvec (den=denomiantors)
4240 // 6th element is intvec (mul=multiplicities)
4241 // exactly n numerators
4242 // exactly n denominators
4243 // exactly n multiplicities
4244 // mu>0
4245 // pg>=0
4246 // n>0
4247 // num>0
4248 // den>0
4249 // mul>0
4250 // symmetriy with respect to numberofvariables/2
4251 // monotony
4252 // mu = sum of all multiplicities
4253 // pg = sum of all multiplicities where num/den<=1
4254 // ----------------------------------------------------------------------------
4255 
4257 {
4258  // -------------------
4259  // check list length
4260  // -------------------
4261 
4262  if( l->nr < 5 )
4263  {
4264  return semicListTooShort;
4265  }
4266  else if( l->nr > 5 )
4267  {
4268  return semicListTooLong;
4269  }
4270 
4271  // -------------
4272  // check types
4273  // -------------
4274 
4275  if( l->m[0].rtyp != INT_CMD )
4276  {
4278  }
4279  else if( l->m[1].rtyp != INT_CMD )
4280  {
4282  }
4283  else if( l->m[2].rtyp != INT_CMD )
4284  {
4286  }
4287  else if( l->m[3].rtyp != INTVEC_CMD )
4288  {
4290  }
4291  else if( l->m[4].rtyp != INTVEC_CMD )
4292  {
4294  }
4295  else if( l->m[5].rtyp != INTVEC_CMD )
4296  {
4298  }
4299 
4300  // -------------------------
4301  // check number of entries
4302  // -------------------------
4303 
4304  int mu = (int)(long)(l->m[0].Data( ));
4305  int pg = (int)(long)(l->m[1].Data( ));
4306  int n = (int)(long)(l->m[2].Data( ));
4307 
4308  if( n <= 0 )
4309  {
4310  return semicListNNegative;
4311  }
4312 
4313  intvec *num = (intvec*)l->m[3].Data( );
4314  intvec *den = (intvec*)l->m[4].Data( );
4315  intvec *mul = (intvec*)l->m[5].Data( );
4316 
4317  if( n != num->length( ) )
4318  {
4320  }
4321  else if( n != den->length( ) )
4322  {
4324  }
4325  else if( n != mul->length( ) )
4326  {
4328  }
4329 
4330  // --------
4331  // values
4332  // --------
4333 
4334  if( mu <= 0 )
4335  {
4336  return semicListMuNegative;
4337  }
4338  if( pg < 0 )
4339  {
4340  return semicListPgNegative;
4341  }
4342 
4343  int i;
4344 
4345  for( i=0; i<n; i++ )
4346  {
4347  if( (*num)[i] <= 0 )
4348  {
4349  return semicListNumNegative;
4350  }
4351  if( (*den)[i] <= 0 )
4352  {
4353  return semicListDenNegative;
4354  }
4355  if( (*mul)[i] <= 0 )
4356  {
4357  return semicListMulNegative;
4358  }
4359  }
4360 
4361  // ----------------
4362  // check symmetry
4363  // ----------------
4364 
4365  int j;
4366 
4367  for( i=0, j=n-1; i<=j; i++,j-- )
4368  {
4369  if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4370  (*den)[i] != (*den)[j] ||
4371  (*mul)[i] != (*mul)[j] )
4372  {
4373  return semicListNotSymmetric;
4374  }
4375  }
4376 
4377  // ----------------
4378  // check monotony
4379  // ----------------
4380 
4381  for( i=0, j=1; i<n/2; i++,j++ )
4382  {
4383  if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4384  {
4385  return semicListNotMonotonous;
4386  }
4387  }
4388 
4389  // ---------------------
4390  // check Milnor number
4391  // ---------------------
4392 
4393  for( mu=0, i=0; i<n; i++ )
4394  {
4395  mu += (*mul)[i];
4396  }
4397 
4398  if( mu != (int)(long)(l->m[0].Data( )) )
4399  {
4400  return semicListMilnorWrong;
4401  }
4402 
4403  // -------------------------
4404  // check geometrical genus
4405  // -------------------------
4406 
4407  for( pg=0, i=0; i<n; i++ )
4408  {
4409  if( (*num)[i]<=(*den)[i] )
4410  {
4411  pg += (*mul)[i];
4412  }
4413  }
4414 
4415  if( pg != (int)(long)(l->m[1].Data( )) )
4416  {
4417  return semicListPGWrong;
4418  }
4419 
4420  return semicOK;
4421 }
4422 
4423 // ----------------------------------------------------------------------------
4424 // this procedure is called from the interpreter
4425 // ----------------------------------------------------------------------------
4426 // first = list of spectrum numbers
4427 // second = list of spectrum numbers
4428 // result = sum of the two lists
4429 // ----------------------------------------------------------------------------
4430 
4432 {
4433  semicState state;
4434 
4435  // -----------------
4436  // check arguments
4437  // -----------------
4438 
4439  lists l1 = (lists)first->Data( );
4440  lists l2 = (lists)second->Data( );
4441 
4442  if( (state=list_is_spectrum( l1 )) != semicOK )
4443  {
4444  WerrorS( "first argument is not a spectrum:" );
4445  list_error( state );
4446  }
4447  else if( (state=list_is_spectrum( l2 )) != semicOK )
4448  {
4449  WerrorS( "second argument is not a spectrum:" );
4450  list_error( state );
4451  }
4452  else
4453  {
4454  spectrum s1= spectrumFromList ( l1 );
4455  spectrum s2= spectrumFromList ( l2 );
4456  spectrum sum( s1+s2 );
4457 
4458  result->rtyp = LIST_CMD;
4459  result->data = (char*)(getList(sum));
4460  }
4461 
4462  return (state!=semicOK);
4463 }
4464 
4465 // ----------------------------------------------------------------------------
4466 // this procedure is called from the interpreter
4467 // ----------------------------------------------------------------------------
4468 // first = list of spectrum numbers
4469 // second = integer
4470 // result = the multiple of the first list by the second factor
4471 // ----------------------------------------------------------------------------
4472 
4474 {
4475  semicState state;
4476 
4477  // -----------------
4478  // check arguments
4479  // -----------------
4480 
4481  lists l = (lists)first->Data( );
4482  int k = (int)(long)second->Data( );
4483 
4484  if( (state=list_is_spectrum( l ))!=semicOK )
4485  {
4486  WerrorS( "first argument is not a spectrum" );
4487  list_error( state );
4488  }
4489  else if( k < 0 )
4490  {
4491  WerrorS( "second argument should be positive" );
4492  state = semicMulNegative;
4493  }
4494  else
4495  {
4497  spectrum product( k*s );
4498 
4499  result->rtyp = LIST_CMD;
4500  result->data = (char*)getList(product);
4501  }
4502 
4503  return (state!=semicOK);
4504 }
4505 
4506 // ----------------------------------------------------------------------------
4507 // this procedure is called from the interpreter
4508 // ----------------------------------------------------------------------------
4509 // first = list of spectrum numbers
4510 // second = list of spectrum numbers
4511 // result = semicontinuity index
4512 // ----------------------------------------------------------------------------
4513 
4515 {
4516  semicState state;
4517  BOOLEAN qh=(((int)(long)w->Data())==1);
4518 
4519  // -----------------
4520  // check arguments
4521  // -----------------
4522 
4523  lists l1 = (lists)u->Data( );
4524  lists l2 = (lists)v->Data( );
4525 
4526  if( (state=list_is_spectrum( l1 ))!=semicOK )
4527  {
4528  WerrorS( "first argument is not a spectrum" );
4529  list_error( state );
4530  }
4531  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4532  {
4533  WerrorS( "second argument is not a spectrum" );
4534  list_error( state );
4535  }
4536  else
4537  {
4538  spectrum s1= spectrumFromList( l1 );
4539  spectrum s2= spectrumFromList( l2 );
4540 
4541  res->rtyp = INT_CMD;
4542  if (qh)
4543  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4544  else
4545  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4546  }
4547 
4548  // -----------------
4549  // check status
4550  // -----------------
4551 
4552  return (state!=semicOK);
4553 }
4555 {
4556  sleftv tmp;
4557  tmp.Init();
4558  tmp.rtyp=INT_CMD;
4559  /* tmp.data = (void *)0; -- done by Init */
4560 
4561  return semicProc3(res,u,v,&tmp);
4562 }
4563 
4564 #endif
4565 
4567 {
4568  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4569  return FALSE;
4570 }
4571 
4573 {
4574  if ( !(rField_is_long_R(currRing)) )
4575  {
4576  WerrorS("Ground field not implemented!");
4577  return TRUE;
4578  }
4579 
4580  simplex * LP;
4581  matrix m;
4582 
4583  leftv v= args;
4584  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4585  return TRUE;
4586  else
4587  m= (matrix)(v->CopyD());
4588 
4589  LP = new simplex(MATROWS(m),MATCOLS(m));
4590  LP->mapFromMatrix(m);
4591 
4592  v= v->next;
4593  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4594  return TRUE;
4595  else
4596  LP->m= (int)(long)(v->Data());
4597 
4598  v= v->next;
4599  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4600  return TRUE;
4601  else
4602  LP->n= (int)(long)(v->Data());
4603 
4604  v= v->next;
4605  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4606  return TRUE;
4607  else
4608  LP->m1= (int)(long)(v->Data());
4609 
4610  v= v->next;
4611  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4612  return TRUE;
4613  else
4614  LP->m2= (int)(long)(v->Data());
4615 
4616  v= v->next;
4617  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4618  return TRUE;
4619  else
4620  LP->m3= (int)(long)(v->Data());
4621 
4622 #ifdef mprDEBUG_PROT
4623  Print("m (constraints) %d\n",LP->m);
4624  Print("n (columns) %d\n",LP->n);
4625  Print("m1 (<=) %d\n",LP->m1);
4626  Print("m2 (>=) %d\n",LP->m2);
4627  Print("m3 (==) %d\n",LP->m3);
4628 #endif
4629 
4630  LP->compute();
4631 
4632  lists lres= (lists)omAlloc( sizeof(slists) );
4633  lres->Init( 6 );
4634 
4635  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4636  lres->m[0].data=(void*)LP->mapToMatrix(m);
4637 
4638  lres->m[1].rtyp= INT_CMD; // found a solution?
4639  lres->m[1].data=(void*)(long)LP->icase;
4640 
4641  lres->m[2].rtyp= INTVEC_CMD;
4642  lres->m[2].data=(void*)LP->posvToIV();
4643 
4644  lres->m[3].rtyp= INTVEC_CMD;
4645  lres->m[3].data=(void*)LP->zrovToIV();
4646 
4647  lres->m[4].rtyp= INT_CMD;
4648  lres->m[4].data=(void*)(long)LP->m;
4649 
4650  lres->m[5].rtyp= INT_CMD;
4651  lres->m[5].data=(void*)(long)LP->n;
4652 
4653  res->data= (void*)lres;
4654 
4655  return FALSE;
4656 }
4657 
4659 {
4660  ideal gls = (ideal)(arg1->Data());
4661  int imtype= (int)(long)arg2->Data();
4662 
4663  uResultant::resMatType mtype= determineMType( imtype );
4664 
4665  // check input ideal ( = polynomial system )
4666  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4667  {
4668  return TRUE;
4669  }
4670 
4671  uResultant *resMat= new uResultant( gls, mtype, false );
4672  if (resMat!=NULL)
4673  {
4674  res->rtyp = MODUL_CMD;
4675  res->data= (void*)resMat->accessResMat()->getMatrix();
4676  if (!errorreported) delete resMat;
4677  }
4678  return errorreported;
4679 }
4680 
4682 {
4683  poly gls;
4684  gls= (poly)(arg1->Data());
4685  int howclean= (int)(long)arg3->Data();
4686 
4687  if ( gls == NULL || pIsConstant( gls ) )
4688  {
4689  WerrorS("Input polynomial is constant!");
4690  return TRUE;
4691  }
4692 
4693  if (rField_is_Zp(currRing))
4694  {
4695  int* r=Zp_roots(gls, currRing);
4696  lists rlist;
4697  rlist= (lists)omAlloc( sizeof(slists) );
4698  rlist->Init( r[0] );
4699  for(int i=r[0];i>0;i--)
4700  {
4701  rlist->m[i-1].data=n_Init(r[i],currRing->cf);
4702  rlist->m[i-1].rtyp=NUMBER_CMD;
4703  }
4704  omFree(r);
4705  res->data=rlist;
4706  res->rtyp= LIST_CMD;
4707  return FALSE;
4708  }
4709  if ( !(rField_is_R(currRing) ||
4710  rField_is_Q(currRing) ||
4713  {
4714  WerrorS("Ground field not implemented!");
4715  return TRUE;
4716  }
4717 
4720  {
4721  unsigned long int ii = (unsigned long int)arg2->Data();
4722  setGMPFloatDigits( ii, ii );
4723  }
4724 
4725  int ldummy;
4726  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4727  int i,vpos=0;
4728  poly piter;
4729  lists elist;
4730 
4731  elist= (lists)omAlloc( sizeof(slists) );
4732  elist->Init( 0 );
4733 
4734  if ( rVar(currRing) > 1 )
4735  {
4736  piter= gls;
4737  for ( i= 1; i <= rVar(currRing); i++ )
4738  if ( pGetExp( piter, i ) )
4739  {
4740  vpos= i;
4741  break;
4742  }
4743  while ( piter )
4744  {
4745  for ( i= 1; i <= rVar(currRing); i++ )
4746  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4747  {
4748  WerrorS("The input polynomial must be univariate!");
4749  return TRUE;
4750  }
4751  pIter( piter );
4752  }
4753  }
4754 
4755  rootContainer * roots= new rootContainer();
4756  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4757  piter= gls;
4758  for ( i= deg; i >= 0; i-- )
4759  {
4760  if ( piter && pTotaldegree(piter) == i )
4761  {
4762  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4763  //nPrint( pcoeffs[i] );PrintS(" ");
4764  pIter( piter );
4765  }
4766  else
4767  {
4768  pcoeffs[i]= nInit(0);
4769  }
4770  }
4771 
4772 #ifdef mprDEBUG_PROT
4773  for (i=deg; i >= 0; i--)
4774  {
4775  nPrint( pcoeffs[i] );PrintS(" ");
4776  }
4777  PrintLn();
4778 #endif
4779 
4780  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4781  roots->solver( howclean );
4782 
4783  int elem= roots->getAnzRoots();
4784  char *dummy;
4785  int j;
4786 
4787  lists rlist;
4788  rlist= (lists)omAlloc( sizeof(slists) );
4789  rlist->Init( elem );
4790 
4792  {
4793  for ( j= 0; j < elem; j++ )
4794  {
4795  rlist->m[j].rtyp=NUMBER_CMD;
4796  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4797  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4798  }
4799  }
4800  else
4801  {
4802  for ( j= 0; j < elem; j++ )
4803  {
4804  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4805  rlist->m[j].rtyp=STRING_CMD;
4806  rlist->m[j].data=(void *)dummy;
4807  }
4808  }
4809 
4810  elist->Clean();
4811  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4812 
4813  // this is (via fillContainer) the same data as in root
4814  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4815  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4816 
4817  delete roots;
4818 
4819  res->data= (void*)rlist;
4820 
4821  return FALSE;
4822 }
4823 
4825 {
4826  int i;
4827  ideal p,w;
4828  p= (ideal)arg1->Data();
4829  w= (ideal)arg2->Data();
4830 
4831  // w[0] = f(p^0)
4832  // w[1] = f(p^1)
4833  // ...
4834  // p can be a vector of numbers (multivariate polynom)
4835  // or one number (univariate polynom)
4836  // tdg = deg(f)
4837 
4838  int n= IDELEMS( p );
4839  int m= IDELEMS( w );
4840  int tdg= (int)(long)arg3->Data();
4841 
4842  res->data= (void*)NULL;
4843 
4844  // check the input
4845  if ( tdg < 1 )
4846  {
4847  WerrorS("Last input parameter must be > 0!");
4848  return TRUE;
4849  }
4850  if ( n != rVar(currRing) )
4851  {
4852  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4853  return TRUE;
4854  }
4855  if ( m != (int)pow((double)tdg+1,(double)n) )
4856  {
4857  Werror("Size of second input ideal must be equal to %d!",
4858  (int)pow((double)tdg+1,(double)n));
4859  return TRUE;
4860  }
4861  if ( !(rField_is_Q(currRing) /* ||
4862  rField_is_R() || rField_is_long_R() ||
4863  rField_is_long_C()*/ ) )
4864  {
4865  WerrorS("Ground field not implemented!");
4866  return TRUE;
4867  }
4868 
4869  number tmp;
4870  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4871  for ( i= 0; i < n; i++ )
4872  {
4873  pevpoint[i]=nInit(0);
4874  if ( (p->m)[i] )
4875  {
4876  tmp = pGetCoeff( (p->m)[i] );
4877  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4878  {
4879  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4880  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4881  return TRUE;
4882  }
4883  } else tmp= NULL;
4884  if ( !nIsZero(tmp) )
4885  {
4886  if ( !pIsConstant((p->m)[i]))
4887  {
4888  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4889  WerrorS("Elements of first input ideal must be numbers!");
4890  return TRUE;
4891  }
4892  pevpoint[i]= nCopy( tmp );
4893  }
4894  }
4895 
4896  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4897  for ( i= 0; i < m; i++ )
4898  {
4899  wresults[i]= nInit(0);
4900  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4901  {
4902  if ( !pIsConstant((w->m)[i]))
4903  {
4904  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4905  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4906  WerrorS("Elements of second input ideal must be numbers!");
4907  return TRUE;
4908  }
4909  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4910  }
4911  }
4912 
4913  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4914  number *ncpoly= vm.interpolateDense( wresults );
4915  // do not free ncpoly[]!!
4916  poly rpoly= vm.numvec2poly( ncpoly );
4917 
4918  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4919  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4920 
4921  res->data= (void*)rpoly;
4922  return FALSE;
4923 }
4924 
4926 {
4927  leftv v= args;
4928 
4929  ideal gls;
4930  int imtype;
4931  int howclean;
4932 
4933  // get ideal
4934  if ( v->Typ() != IDEAL_CMD )
4935  return TRUE;
4936  else gls= (ideal)(v->Data());
4937  v= v->next;
4938 
4939  // get resultant matrix type to use (0,1)
4940  if ( v->Typ() != INT_CMD )
4941  return TRUE;
4942  else imtype= (int)(long)v->Data();
4943  v= v->next;
4944 
4945  if (imtype==0)
4946  {
4947  ideal test_id=idInit(1,1);
4948  int j;
4949  for(j=IDELEMS(gls)-1;j>=0;j--)
4950  {
4951  if (gls->m[j]!=NULL)
4952  {
4953  test_id->m[0]=gls->m[j];
4954  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4955  if (dummy_w!=NULL)
4956  {
4957  WerrorS("Newton polytope not of expected dimension");
4958  delete dummy_w;
4959  return TRUE;
4960  }
4961  }
4962  }
4963  }
4964 
4965  // get and set precision in digits ( > 0 )
4966  if ( v->Typ() != INT_CMD )
4967  return TRUE;
4968  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4970  {
4971  unsigned long int ii=(unsigned long int)v->Data();
4972  setGMPFloatDigits( ii, ii );
4973  }
4974  v= v->next;
4975 
4976  // get interpolation steps (0,1,2)
4977  if ( v->Typ() != INT_CMD )
4978  return TRUE;
4979  else howclean= (int)(long)v->Data();
4980 
4981  uResultant::resMatType mtype= determineMType( imtype );
4982  int i,count;
4983  lists listofroots= NULL;
4984  number smv= NULL;
4985  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4986 
4987  //emptylist= (lists)omAlloc( sizeof(slists) );
4988  //emptylist->Init( 0 );
4989 
4990  //res->rtyp = LIST_CMD;
4991  //res->data= (void *)emptylist;
4992 
4993  // check input ideal ( = polynomial system )
4994  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4995  {
4996  return TRUE;
4997  }
4998 
4999  uResultant * ures;
5000  rootContainer ** iproots;
5001  rootContainer ** muiproots;
5002  rootArranger * arranger;
5003 
5004  // main task 1: setup of resultant matrix
5005  ures= new uResultant( gls, mtype );
5006  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
5007  {
5008  WerrorS("Error occurred during matrix setup!");
5009  return TRUE;
5010  }
5011 
5012  // if dense resultant, check if minor nonsingular
5013  if ( mtype == uResultant::denseResMat )
5014  {
5015  smv= ures->accessResMat()->getSubDet();
5016 #ifdef mprDEBUG_PROT
5017  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
5018 #endif
5019  if ( nIsZero(smv) )
5020  {
5021  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
5022  return TRUE;
5023  }
5024  }
5025 
5026  // main task 2: Interpolate specialized resultant polynomials
5027  if ( interpolate_det )
5028  iproots= ures->interpolateDenseSP( false, smv );
5029  else
5030  iproots= ures->specializeInU( false, smv );
5031 
5032  // main task 3: Interpolate specialized resultant polynomials
5033  if ( interpolate_det )
5034  muiproots= ures->interpolateDenseSP( true, smv );
5035  else
5036  muiproots= ures->specializeInU( true, smv );
5037 
5038 #ifdef mprDEBUG_PROT
5039  int c= iproots[0]->getAnzElems();
5040  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
5041  c= muiproots[0]->getAnzElems();
5042  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
5043 #endif
5044 
5045  // main task 4: Compute roots of specialized polys and match them up
5046  arranger= new rootArranger( iproots, muiproots, howclean );
5047  arranger->solve_all();
5048 
5049  // get list of roots
5050  if ( arranger->success() )
5051  {
5052  arranger->arrange();
5053  listofroots= listOfRoots(arranger, gmp_output_digits );
5054  }
5055  else
5056  {
5057  WerrorS("Solver was unable to find any roots!");
5058  return TRUE;
5059  }
5060 
5061  // free everything
5062  count= iproots[0]->getAnzElems();
5063  for (i=0; i < count; i++) delete iproots[i];
5064  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
5065  count= muiproots[0]->getAnzElems();
5066  for (i=0; i < count; i++) delete muiproots[i];
5067  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
5068 
5069  delete ures;
5070  delete arranger;
5071  if (smv!=NULL) nDelete( &smv );
5072 
5073  res->data= (void *)listofroots;
5074 
5075  //emptylist->Clean();
5076  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
5077 
5078  return FALSE;
5079 }
5080 
5081 // from mpr_numeric.cc
5082 lists listOfRoots( rootArranger* self, const unsigned int oprec )
5083 {
5084  int i,j;
5085  int count= self->roots[0]->getAnzRoots(); // number of roots
5086  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
5087 
5088  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
5089 
5090  if ( self->found_roots )
5091  {
5092  listofroots->Init( count );
5093 
5094  for (i=0; i < count; i++)
5095  {
5096  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
5097  onepoint->Init(elem);
5098  for ( j= 0; j < elem; j++ )
5099  {
5100  if ( !rField_is_long_C(currRing) )
5101  {
5102  onepoint->m[j].rtyp=STRING_CMD;
5103  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5104  }
5105  else
5106  {
5107  onepoint->m[j].rtyp=NUMBER_CMD;
5108  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5109  }
5110  onepoint->m[j].next= NULL;
5111  onepoint->m[j].name= NULL;
5112  }
5113  listofroots->m[i].rtyp=LIST_CMD;
5114  listofroots->m[i].data=(void *)onepoint;
5115  listofroots->m[j].next= NULL;
5116  listofroots->m[j].name= NULL;
5117  }
5118 
5119  }
5120  else
5121  {
5122  listofroots->Init( 0 );
5123  }
5124 
5125  return listofroots;
5126 }
5127 
5128 // from ring.cc
5130 {
5131  ring rg = NULL;
5132  if (h!=NULL)
5133  {
5134 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5135  rg = IDRING(h);
5136  if (rg==NULL) return; //id <>NULL, ring==NULL
5137  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5138  if (IDID(h)) // OB: ????
5140  rTest(rg);
5141  }
5142  else return;
5143 
5144  // clean up history
5145  if (currRing!=NULL)
5146  {
5148  {
5150  }
5151 
5152  if (rg!=currRing)/*&&(currRing!=NULL)*/
5153  {
5154  if (rg->cf!=currRing->cf)
5155  {
5157  if (DENOMINATOR_LIST!=NULL)
5158  {
5159  if (TEST_V_ALLWARN)
5160  Warn("deleting denom_list for ring change to %s",IDID(h));
5161  do
5162  {
5163  n_Delete(&(dd->n),currRing->cf);
5164  dd=dd->next;
5166  DENOMINATOR_LIST=dd;
5167  } while(DENOMINATOR_LIST!=NULL);
5168  }
5169  }
5170  }
5171  }
5172 
5173  // test for valid "currRing":
5174  if ((rg!=NULL) && (rg->idroot==NULL))
5175  {
5176  ring old=rg;
5177  rg=rAssure_HasComp(rg);
5178  if (old!=rg)
5179  {
5180  rKill(old);
5181  IDRING(h)=rg;
5182  }
5183  }
5184  /*------------ change the global ring -----------------------*/
5185  rChangeCurrRing(rg);
5186  currRingHdl = h;
5187 }
5188 
5190 {
5191  // change some bad orderings/combination into better ones
5192  leftv h=ord;
5193  while(h!=NULL)
5194  {
5195  BOOLEAN change=FALSE;
5196  intvec *iv = (intvec *)(h->data);
5197  // ws(-i) -> wp(i)
5198  if ((*iv)[1]==ringorder_ws)
5199  {
5200  BOOLEAN neg=TRUE;
5201  for(int i=2;i<iv->length();i++)
5202  if((*iv)[i]>=0) { neg=FALSE; break; }
5203  if (neg)
5204  {
5205  (*iv)[1]=ringorder_wp;
5206  for(int i=2;i<iv->length();i++)
5207  (*iv)[i]= - (*iv)[i];
5208  change=TRUE;
5209  }
5210  }
5211  // Ws(-i) -> Wp(i)
5212  if ((*iv)[1]==ringorder_Ws)
5213  {
5214  BOOLEAN neg=TRUE;
5215  for(int i=2;i<iv->length();i++)
5216  if((*iv)[i]>=0) { neg=FALSE; break; }
5217  if (neg)
5218  {
5219  (*iv)[1]=ringorder_Wp;
5220  for(int i=2;i<iv->length();i++)
5221  (*iv)[i]= -(*iv)[i];
5222  change=TRUE;
5223  }
5224  }
5225  // wp(1) -> dp
5226  if ((*iv)[1]==ringorder_wp)
5227  {
5228  BOOLEAN all_one=TRUE;
5229  for(int i=2;i<iv->length();i++)
5230  if((*iv)[i]!=1) { all_one=FALSE; break; }
5231  if (all_one)
5232  {
5233  intvec *iv2=new intvec(3);
5234  (*iv2)[0]=1;
5235  (*iv2)[1]=ringorder_dp;
5236  (*iv2)[2]=iv->length()-2;
5237  delete iv;
5238  iv=iv2;
5239  h->data=iv2;
5240  change=TRUE;
5241  }
5242  }
5243  // Wp(1) -> Dp
5244  if ((*iv)[1]==ringorder_Wp)
5245  {
5246  BOOLEAN all_one=TRUE;
5247  for(int i=2;i<iv->length();i++)
5248  if((*iv)[i]!=1) { all_one=FALSE; break; }
5249  if (all_one)
5250  {
5251  intvec *iv2=new intvec(3);
5252  (*iv2)[0]=1;
5253  (*iv2)[1]=ringorder_Dp;
5254  (*iv2)[2]=iv->length()-2;
5255  delete iv;
5256  iv=iv2;
5257  h->data=iv2;
5258  change=TRUE;
5259  }
5260  }
5261  // dp(1)/Dp(1)/rp(1) -> lp(1)
5262  if (((*iv)[1]==ringorder_dp)
5263  || ((*iv)[1]==ringorder_Dp)
5264  || ((*iv)[1]==ringorder_rp))
5265  {
5266  if (iv->length()==3)
5267  {
5268  if ((*iv)[2]==1)
5269  {
5270  if(h->next!=NULL)
5271  {
5272  intvec *iv2 = (intvec *)(h->next->data);
5273  if ((*iv2)[1]==ringorder_lp)
5274  {
5275  (*iv)[1]=ringorder_lp;
5276  change=TRUE;
5277  }
5278  }
5279  }
5280  }
5281  }
5282  // lp(i),lp(j) -> lp(i+j)
5283  if(((*iv)[1]==ringorder_lp)
5284  && (h->next!=NULL))
5285  {
5286  intvec *iv2 = (intvec *)(h->next->data);
5287  if ((*iv2)[1]==ringorder_lp)
5288  {
5289  leftv hh=h->next;
5290  h->next=hh->next;
5291  hh->next=NULL;
5292  if ((*iv2)[0]==1)
5293  (*iv)[2] += 1; // last block unspecified, at least 1
5294  else
5295  (*iv)[2] += (*iv2)[2];
5296  hh->CleanUp();
5297  omFree(hh);
5298  change=TRUE;
5299  }
5300  }
5301  // -------------------
5302  if (!change) h=h->next;
5303  }
5304  return ord;
5305 }
5306 
5307 
5309 {
5310  int last = 0, o=0, n = 1, i=0, typ = 1, j;
5311  ord=rOptimizeOrdAsSleftv(ord);
5312  sleftv *sl = ord;
5313 
5314  // determine nBlocks
5315  while (sl!=NULL)
5316  {
5317  intvec *iv = (intvec *)(sl->data);
5318  if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5319  i++;
5320  else if ((*iv)[1]==ringorder_L)
5321  {
5322  R->wanted_maxExp=(*iv)[2]*2+1;
5323  n--;
5324  }
5325  else if (((*iv)[1]!=ringorder_a)
5326  && ((*iv)[1]!=ringorder_a64)
5327  && ((*iv)[1]!=ringorder_am))
5328  o++;
5329  n++;
5330  sl=sl->next;
5331  }
5332  // check whether at least one real ordering
5333  if (o==0)
5334  {
5335  WerrorS("invalid combination of orderings");
5336  return TRUE;
5337  }
5338  // if no c/C ordering is given, increment n
5339  if (i==0) n++;
5340  else if (i != 1)
5341  {
5342  // throw error if more than one is given
5343  WerrorS("more than one ordering c/C specified");
5344  return TRUE;
5345  }
5346 
5347  // initialize fields of R
5348  R->order=(rRingOrder_t *)omAlloc0(n*sizeof(rRingOrder_t));
5349  R->block0=(int *)omAlloc0(n*sizeof(int));
5350  R->block1=(int *)omAlloc0(n*sizeof(int));
5351  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5352 
5353  int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5354 
5355  // init order, so that rBlocks works correctly
5356  for (j=0; j < n-1; j++)
5357  R->order[j] = ringorder_unspec;
5358  // set last _C order, if no c/C order was given
5359  if (i == 0) R->order[n-2] = ringorder_C;
5360 
5361  /* init orders */
5362  sl=ord;
5363  n=-1;
5364  while (sl!=NULL)
5365  {
5366  intvec *iv;
5367  iv = (intvec *)(sl->data);
5368  if ((*iv)[1]!=ringorder_L)
5369  {
5370  n++;
5371 
5372  /* the format of an ordering:
5373  * iv[0]: factor
5374  * iv[1]: ordering
5375  * iv[2..end]: weights
5376  */
5377  R->order[n] = (rRingOrder_t)((*iv)[1]);
5378  typ=1;
5379  switch ((*iv)[1])
5380  {
5381  case ringorder_ws:
5382  case ringorder_Ws:
5383  typ=-1; // and continue
5384  case ringorder_wp:
5385  case ringorder_Wp:
5386  R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5387  R->block0[n] = last+1;
5388  for (i=2; i<iv->length(); i++)
5389  {
5390  R->wvhdl[n][i-2] = (*iv)[i];
5391  last++;
5392  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5393  }
5394  R->block1[n] = si_min(last,R->N);
5395  break;
5396  case ringorder_ls:
5397  case ringorder_ds:
5398  case ringorder_Ds:
5399  case ringorder_rs:
5400  typ=-1; // and continue
5401  case ringorder_lp:
5402  case ringorder_dp:
5403  case ringorder_Dp:
5404  case ringorder_rp:
5405  R->block0[n] = last+1;
5406  if (iv->length() == 3) last+=(*iv)[2];
5407  else last += (*iv)[0];
5408  R->block1[n] = si_min(last,R->N);
5409  if (rCheckIV(iv)) return TRUE;
5410  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5411  {
5412  if (weights[i]==0) weights[i]=typ;
5413  }
5414  break;
5415 
5416  case ringorder_s: // no 'rank' params!
5417  {
5418 
5419  if(iv->length() > 3)
5420  return TRUE;
5421 
5422  if(iv->length() == 3)
5423  {
5424  const int s = (*iv)[2];
5425  R->block0[n] = s;
5426  R->block1[n] = s;
5427  }
5428  break;
5429  }
5430  case ringorder_IS:
5431  {
5432  if(iv->length() != 3) return TRUE;
5433 
5434  const int s = (*iv)[2];
5435 
5436  if( 1 < s || s < -1 ) return TRUE;
5437 
5438  R->block0[n] = s;
5439  R->block1[n] = s;
5440  break;
5441  }
5442  case ringorder_S:
5443  case ringorder_c:
5444  case ringorder_C:
5445  {
5446  if (rCheckIV(iv)) return TRUE;
5447  break;
5448  }
5449  case ringorder_aa:
5450  case ringorder_a:
5451  {
5452  R->block0[n] = last+1;
5453  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5454  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5455  for (i=2; i<iv->length(); i++)
5456  {
5457  R->wvhdl[n][i-2]=(*iv)[i];
5458  last++;
5459  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5460  }
5461  last=R->block0[n]-1;
5462  break;
5463  }
5464  case ringorder_am:
5465  {
5466  R->block0[n] = last+1;
5467  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5468  R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5469  if (R->block1[n]- R->block0[n]+2>=iv->length())
5470  WarnS("missing module weights");
5471  for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5472  {
5473  R->wvhdl[n][i-2]=(*iv)[i];
5474  last++;
5475  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5476  }
5477  R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5478  for (; i<iv->length(); i++)
5479  {
5480  R->wvhdl[n][i-1]=(*iv)[i];
5481  }
5482  last=R->block0[n]-1;
5483  break;
5484  }
5485  case ringorder_a64:
5486  {
5487  R->block0[n] = last+1;
5488  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5489  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5490  int64 *w=(int64 *)R->wvhdl[n];
5491  for (i=2; i<iv->length(); i++)
5492  {
5493  w[i-2]=(*iv)[i];
5494  last++;
5495  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5496  }
5497  last=R->block0[n]-1;
5498  break;
5499  }
5500  case ringorder_M:
5501  {
5502  int Mtyp=rTypeOfMatrixOrder(iv);
5503  if (Mtyp==0) return TRUE;
5504  if (Mtyp==-1) typ = -1;
5505 
5506  R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5507  for (i=2; i<iv->length();i++)
5508  R->wvhdl[n][i-2]=(*iv)[i];
5509 
5510  R->block0[n] = last+1;
5511  last += (int)sqrt((double)(iv->length()-2));
5512  R->block1[n] = si_min(last,R->N);
5513  for(i=R->block1[n];i>=R->block0[n];i--)
5514  {
5515  if (weights[i]==0) weights[i]=typ;
5516  }
5517  break;
5518  }
5519 
5520  case ringorder_no:
5521  R->order[n] = ringorder_unspec;
5522  return TRUE;
5523 
5524  default:
5525  Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5526  R->order[n] = ringorder_unspec;
5527  return TRUE;
5528  }
5529  }
5530  if (last>R->N)
5531  {
5532  Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5533  R->N,last);
5534  return TRUE;
5535  }
5536  sl=sl->next;
5537  }
5538  // find OrdSgn:
5539  R->OrdSgn = 1;
5540  for(i=1;i<=R->N;i++)
5541  { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5542  omFree(weights);
5543 
5544  // check for complete coverage
5545  while ( n >= 0 && (
5546  (R->order[n]==ringorder_c)
5547  || (R->order[n]==ringorder_C)
5548  || (R->order[n]==ringorder_s)
5549  || (R->order[n]==ringorder_S)
5550  || (R->order[n]==ringorder_IS)
5551  )) n--;
5552 
5553  assume( n >= 0 );
5554 
5555  if (R->block1[n] != R->N)
5556  {
5557  if (((R->order[n]==ringorder_dp) ||
5558  (R->order[n]==ringorder_ds) ||
5559  (R->order[n]==ringorder_Dp) ||
5560  (R->order[n]==ringorder_Ds) ||
5561  (R->order[n]==ringorder_rp) ||
5562  (R->order[n]==ringorder_rs) ||
5563  (R->order[n]==ringorder_lp) ||
5564  (R->order[n]==ringorder_ls))
5565  &&
5566  R->block0[n] <= R->N)
5567  {
5568  R->block1[n] = R->N;
5569  }
5570  else
5571  {
5572  Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5573  R->N,R->block1[n]);
5574  return TRUE;
5575  }
5576  }
5577  return FALSE;
5578 }
5579 
5581 {
5582 
5583  while(sl!=NULL)
5584  {
5585  if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5586  {
5587  *p = omStrDup(sl->Name());
5588  }
5589  else if (sl->name!=NULL)
5590  {
5591  *p = (char*)sl->name;
5592  sl->name=NULL;
5593  }
5594  else if (sl->rtyp==POLY_CMD)
5595  {
5596  sleftv s_sl;
5597  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5598  if (s_sl.name != NULL)
5599  {
5600  *p = (char*)s_sl.name; s_sl.name=NULL;
5601  }
5602  else
5603  *p = NULL;
5604  sl->next = s_sl.next;
5605  s_sl.next = NULL;
5606  s_sl.CleanUp();
5607  if (*p == NULL) return TRUE;
5608  }
5609  else return TRUE;
5610  p++;
5611  sl=sl->next;
5612  }
5613  return FALSE;
5614 }
5615 
5616 const short MAX_SHORT = 32767; // (1 << (sizeof(short)*8)) - 1;
5617 
5618 ////////////////////
5619 //
5620 // rInit itself:
5621 //
5622 // INPUT: pn: ch & parameter (names), rv: variable (names)
5623 // ord: ordering (all !=NULL)
5624 // RETURN: currRingHdl on success
5625 // NULL on error
5626 // NOTE: * makes new ring to current ring, on success
5627 // * considers input sleftv's as read-only
5628 ring rInit(leftv pn, leftv rv, leftv ord)
5629 {
5630  int float_len=0;
5631  int float_len2=0;
5632  ring R = NULL;
5633  //BOOLEAN ffChar=FALSE;
5634 
5635  /* ch -------------------------------------------------------*/
5636  // get ch of ground field
5637 
5638  // allocated ring
5639  R = (ring) omAlloc0Bin(sip_sring_bin);
5640 
5641  coeffs cf = NULL;
5642 
5643  assume( pn != NULL );
5644  const int P = pn->listLength();
5645 
5646  if (pn->Typ()==CRING_CMD)
5647  {
5648  cf=(coeffs)pn->CopyD();
5649  leftv pnn=pn;
5650  if(P>1) /*parameter*/
5651  {
5652  pnn = pnn->next;
5653  const int pars = pnn->listLength();
5654  assume( pars > 0 );
5655  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5656 
5657  if (rSleftvList2StringArray(pnn, names))
5658  {
5659  WerrorS("parameter expected");
5660  goto rInitError;
5661  }
5662 
5663  TransExtInfo extParam;
5664 
5665  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5666  for(int i=pars-1; i>=0;i--)
5667  {
5668  omFree(names[i]);
5669  }
5670  omFree(names);
5671 
5672  cf = nInitChar(n_transExt, &extParam);
5673  }
5674  assume( cf != NULL );
5675  }
5676  else if (pn->Typ()==INT_CMD)
5677  {
5678  int ch = (int)(long)pn->Data();
5679  leftv pnn=pn;
5680 
5681  /* parameter? -------------------------------------------------------*/
5682  pnn = pnn->next;
5683 
5684  if (pnn == NULL) // no params!?
5685  {
5686  if (ch!=0)
5687  {
5688  int ch2=IsPrime(ch);
5689  if ((ch<2)||(ch!=ch2))
5690  {
5691  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5692  ch=32003;
5693  }
5694  #ifndef TEST_ZN_AS_ZP
5695  cf = nInitChar(n_Zp, (void*)(long)ch);
5696  #else
5697  mpz_t modBase;
5698  mpz_init_set_ui(modBase, (long)ch);
5699  ZnmInfo info;
5700  info.base= modBase;
5701  info.exp= 1;
5702  cf=nInitChar(n_Zn,(void*) &info);
5703  cf->is_field=1;
5704  cf->is_domain=1;
5705  cf->has_simple_Inverse=1;
5706  #endif
5707  }
5708  else
5709  cf = nInitChar(n_Q, (void*)(long)ch);
5710  }
5711  else
5712  {
5713  const int pars = pnn->listLength();
5714 
5715  assume( pars > 0 );
5716 
5717  // predefined finite field: (p^k, a)
5718  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5719  {
5720  GFInfo param;
5721 
5722  param.GFChar = ch;
5723  param.GFDegree = 1;
5724  param.GFPar_name = pnn->name;
5725 
5726  cf = nInitChar(n_GF, &param);
5727  }
5728  else // (0/p, a, b, ..., z)
5729  {
5730  if ((ch!=0) && (ch!=IsPrime(ch)))
5731  {
5732  WerrorS("too many parameters");
5733  goto rInitError;
5734  }
5735 
5736  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5737 
5738  if (rSleftvList2StringArray(pnn, names))
5739  {
5740  WerrorS("parameter expected");
5741  goto rInitError;
5742  }
5743 
5744  TransExtInfo extParam;
5745 
5746  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5747  for(int i=pars-1; i>=0;i--)
5748  {
5749  omFree(names[i]);
5750  }
5751  omFree(names);
5752 
5753  cf = nInitChar(n_transExt, &extParam);
5754  }
5755  }
5756 
5757  //if (cf==NULL) ->Error: Invalid ground field specification
5758  }
5759  else if ((pn->name != NULL)
5760  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5761  {
5762  leftv pnn=pn->next;
5763  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5764  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5765  {
5766  float_len=(int)(long)pnn->Data();
5767  float_len2=float_len;
5768  pnn=pnn->next;
5769  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5770  {
5771  float_len2=(int)(long)pnn->Data();
5772  pnn=pnn->next;
5773  }
5774  }
5775 
5776  if (!complex_flag)
5777  complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5778  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5779  cf=nInitChar(n_R, NULL);
5780  else // longR or longC?
5781  {
5782  LongComplexInfo param;
5783 
5784  param.float_len = si_min (float_len, 32767);
5785  param.float_len2 = si_min (float_len2, 32767);
5786 
5787  // set the parameter name
5788  if (complex_flag)
5789  {
5790  if (param.float_len < SHORT_REAL_LENGTH)
5791  {
5794  }
5795  if ((pnn == NULL) || (pnn->name == NULL))
5796  param.par_name=(const char*)"i"; //default to i
5797  else
5798  param.par_name = (const char*)pnn->name;
5799  }
5800 
5801  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5802  }
5803  assume( cf != NULL );
5804  }
5805 #ifdef HAVE_RINGS
5806  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5807  {
5808  // TODO: change to use coeffs_BIGINT!?
5809  mpz_t modBase;
5810  unsigned int modExponent = 1;
5811  mpz_init_set_si(modBase, 0);
5812  if (pn->next!=NULL)
5813  {
5814  leftv pnn=pn;
5815  if (pnn->next->Typ()==INT_CMD)
5816  {
5817  pnn=pnn->next;
5818  mpz_set_ui(modBase, (long) pnn->Data());
5819  if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5820  {
5821  pnn=pnn->next;
5822  modExponent = (long) pnn->Data();
5823  }
5824  while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5825  {
5826  pnn=pnn->next;
5827  mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5828  }
5829  }
5830  else if (pnn->next->Typ()==BIGINT_CMD)
5831  {
5832  number p=(number)pnn->next->CopyD();
5833  n_MPZ(modBase,p,coeffs_BIGINT);
5835  }
5836  }
5837  else
5838  cf=nInitChar(n_Z,NULL);
5839 
5840  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
5841  {
5842  WerrorS("Wrong ground ring specification (module is 1)");
5843  goto rInitError;
5844  }
5845  if (modExponent < 1)
5846  {
5847  WerrorS("Wrong ground ring specification (exponent smaller than 1");
5848  goto rInitError;
5849  }
5850  // module is 0 ---> integers ringtype = 4;
5851  // we have an exponent
5852  if (modExponent > 1 && cf == NULL)
5853  {
5854  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5855  {
5856  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5857  depending on the size of a long on the respective platform */
5858  //ringtype = 1; // Use Z/2^ch
5859  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5860  }
5861  else
5862  {
5863  if (mpz_sgn1(modBase)==0)
5864  {
5865  WerrorS("modulus must not be 0 or parameter not allowed");
5866  goto rInitError;
5867  }
5868  //ringtype = 3;
5869  ZnmInfo info;
5870  info.base= modBase;
5871  info.exp= modExponent;
5872  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5873  }
5874  }
5875  // just a module m > 1
5876  else if (cf == NULL)
5877  {
5878  if (mpz_sgn1(modBase)==0)
5879  {
5880  WerrorS("modulus must not be 0 or parameter not allowed");
5881  goto rInitError;
5882  }
5883  //ringtype = 2;
5884  ZnmInfo info;
5885  info.base= modBase;
5886  info.exp= modExponent;
5887  cf=nInitChar(n_Zn,(void*) &info);
5888  }
5889  assume( cf != NULL );
5890  mpz_clear(modBase);
5891  }
5892 #endif
5893  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5894  else if ((pn->Typ()==RING_CMD) && (P == 1))
5895  {
5896  TransExtInfo extParam;
5897  extParam.r = (ring)pn->Data();
5898  extParam.r->ref++;
5899  cf = nInitChar(n_transExt, &extParam);
5900  }
5901  //else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5902  //{
5903  // AlgExtInfo extParam;
5904  // extParam.r = (ring)pn->Data();
5905 
5906  // cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5907  //}
5908  else
5909  {
5910  WerrorS("Wrong or unknown ground field specification");
5911 #if 0
5912 // debug stuff for unknown cf descriptions:
5913  sleftv* p = pn;
5914  while (p != NULL)
5915  {
5916  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5917  PrintLn();
5918  p = p->next;
5919  }
5920 #endif
5921  goto rInitError;
5922  }
5923 
5924  /*every entry in the new ring is initialized to 0*/
5925 
5926  /* characteristic -----------------------------------------------*/
5927  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5928  * 0 1 : Q(a,...) *names FALSE
5929  * 0 -1 : R NULL FALSE 0
5930  * 0 -1 : R NULL FALSE prec. >6
5931  * 0 -1 : C *names FALSE prec. 0..?
5932  * p p : Fp NULL FALSE
5933  * p -p : Fp(a) *names FALSE
5934  * q q : GF(q=p^n) *names TRUE
5935  */
5936  if (cf==NULL)
5937  {
5938  WerrorS("Invalid ground field specification");
5939  goto rInitError;
5940 // const int ch=32003;
5941 // cf=nInitChar(n_Zp, (void*)(long)ch);
5942  }
5943 
5944  assume( R != NULL );
5945 
5946  R->cf = cf;
5947 
5948  /* names and number of variables-------------------------------------*/
5949  {
5950  int l=rv->listLength();
5951 
5952  if (l>MAX_SHORT)
5953  {
5954  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5955  goto rInitError;
5956  }
5957  R->N = l; /*rv->listLength();*/
5958  }
5959  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5960  if (rSleftvList2StringArray(rv, R->names))
5961  {
5962  WerrorS("name of ring variable expected");
5963  goto rInitError;
5964  }
5965 
5966  /* check names and parameters for conflicts ------------------------- */
5967  rRenameVars(R); // conflicting variables will be renamed
5968  /* ordering -------------------------------------------------------------*/
5969  if (rSleftvOrdering2Ordering(ord, R))
5970  goto rInitError;
5971 
5972  // Complete the initialization
5973  if (rComplete(R,1))
5974  goto rInitError;
5975 
5976 /*#ifdef HAVE_RINGS
5977 // currently, coefficients which are ring elements require a global ordering:
5978  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5979  {
5980  WerrorS("global ordering required for these coefficients");
5981  goto rInitError;
5982  }
5983 #endif*/
5984 
5985  rTest(R);
5986 
5987  // try to enter the ring into the name list
5988  // need to clean up sleftv here, before this ring can be set to
5989  // new currRing or currRing can be killed beacuse new ring has
5990  // same name
5991  pn->CleanUp();
5992  rv->CleanUp();
5993  ord->CleanUp();
5994  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5995  // goto rInitError;
5996 
5997  //memcpy(IDRING(tmp),R,sizeof(*R));
5998  // set current ring
5999  //omFreeBin(R, ip_sring_bin);
6000  //return tmp;
6001  return R;
6002 
6003  // error case:
6004  rInitError:
6005  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
6006  pn->CleanUp();
6007  rv->CleanUp();
6008  ord->CleanUp();
6009  return NULL;
6010 }
6011 
6012 ring rSubring(ring org_ring, sleftv* rv)
6013 {
6014  ring R = rCopy0(org_ring);
6015  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
6016  int n = rBlocks(org_ring), i=0, j;
6017 
6018  /* names and number of variables-------------------------------------*/
6019  {
6020  int l=rv->listLength();
6021  if (l>MAX_SHORT)
6022  {
6023  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
6024  goto rInitError;
6025  }
6026  R->N = l; /*rv->listLength();*/
6027  }
6028  omFree(R->names);
6029  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
6030  if (rSleftvList2StringArray(rv, R->names))
6031  {
6032  WerrorS("name of ring variable expected");
6033  goto rInitError;
6034  }
6035 
6036  /* check names for subring in org_ring ------------------------- */
6037  {
6038  i=0;
6039 
6040  for(j=0;j<R->N;j++)
6041  {
6042  for(;i<org_ring->N;i++)
6043  {
6044  if (strcmp(org_ring->names[i],R->names[j])==0)
6045  {
6046  perm[i+1]=j+1;
6047  break;
6048  }
6049  }
6050  if (i>org_ring->N)
6051  {
6052  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
6053  break;
6054  }
6055  }
6056  }
6057  //Print("perm=");
6058  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
6059  /* ordering -------------------------------------------------------------*/
6060 
6061  for(i=0;i<n;i++)
6062  {
6063  int min_var=-1;
6064  int max_var=-1;
6065  for(j=R->block0[i];j<=R->block1[i];j++)
6066  {
6067  if (perm[j]>0)
6068  {
6069  if (min_var==-1) min_var=perm[j];
6070  max_var=perm[j];
6071  }
6072  }
6073  if (min_var!=-1)
6074  {
6075  //Print("block %d: old %d..%d, now:%d..%d\n",
6076  // i,R->block0[i],R->block1[i],min_var,max_var);
6077  R->block0[i]=min_var;
6078  R->block1[i]=max_var;
6079  if (R->wvhdl[i]!=NULL)
6080  {
6081  omFree(R->wvhdl[i]);
6082  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
6083  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
6084  {
6085  if (perm[j]>0)
6086  {
6087  R->wvhdl[i][perm[j]-R->block0[i]]=
6088  org_ring->wvhdl[i][j-org_ring->block0[i]];
6089  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
6090  }
6091  }
6092  }
6093  }
6094  else
6095  {
6096  if(R->block0[i]>0)
6097  {
6098  //Print("skip block %d\n",i);
6099  R->order[i]=ringorder_unspec;
6100  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
6101  R->wvhdl[i]=NULL;
6102  }
6103  //else Print("keep block %d\n",i);
6104  }
6105  }
6106  i=n-1;
6107  while(i>0)
6108  {
6109  // removed unneded blocks
6110  if(R->order[i-1]==ringorder_unspec)
6111  {
6112  for(j=i;j<=n;j++)
6113  {
6114  R->order[j-1]=R->order[j];
6115  R->block0[j-1]=R->block0[j];
6116  R->block1[j-1]=R->block1[j];
6117  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
6118  R->wvhdl[j-1]=R->wvhdl[j];
6119  }
6120  R->order[n]=ringorder_unspec;
6121  n--;
6122  }
6123  i--;
6124  }
6125  n=rBlocks(org_ring)-1;
6126  while (R->order[n]==0) n--;
6127  while (R->order[n]==ringorder_unspec) n--;
6128  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
6129  if (R->block1[n] != R->N)
6130  {
6131  if (((R->order[n]==ringorder_dp) ||
6132  (R->order[n]==ringorder_ds) ||
6133  (R->order[n]==ringorder_Dp) ||
6134  (R->order[n]==ringorder_Ds) ||
6135  (R->order[n]==ringorder_rp) ||
6136  (R->order[n]==ringorder_rs) ||
6137  (R->order[n]==ringorder_lp) ||
6138  (R->order[n]==ringorder_ls))
6139  &&
6140  R->block0[n] <= R->N)
6141  {
6142  R->block1[n] = R->N;
6143  }
6144  else
6145  {
6146  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
6147  R->N,R->block1[n],n);
6148  return NULL;
6149  }
6150  }
6151  omFree(perm);
6152  // find OrdSgn:
6153  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6154  //for(i=1;i<=R->N;i++)
6155  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6156  //omFree(weights);
6157  // Complete the initialization
6158  if (rComplete(R,1))
6159  goto rInitError;
6160 
6161  rTest(R);
6162 
6163  if (rv != NULL) rv->CleanUp();
6164 
6165  return R;
6166 
6167  // error case:
6168  rInitError:
6169  if (R != NULL) rDelete(R);
6170  if (rv != NULL) rv->CleanUp();
6171  return NULL;
6172 }
6173 
6174 void rKill(ring r)
6175 {
6176  if ((r->ref<=0)&&(r->order!=NULL))
6177  {
6178 #ifdef RDEBUG
6179  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6180 #endif
6181  int j;
6182  for (j=0;j<myynest;j++)
6183  {
6184  if (iiLocalRing[j]==r)
6185  {
6186  if (j==0) WarnS("killing the basering for level 0");
6187  iiLocalRing[j]=NULL;
6188  }
6189  }
6190 // any variables depending on r ?
6191  while (r->idroot!=NULL)
6192  {
6193  r->idroot->lev=myynest; // avoid warning about kill global objects
6194  killhdl2(r->idroot,&(r->idroot),r);
6195  }
6196  if (r==currRing)
6197  {
6198  // all dependend stuff is done, clean global vars:
6199  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6201  {
6203  }
6204  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6205  //{
6206  // WerrorS("return value depends on local ring variable (export missing ?)");
6207  // iiRETURNEXPR.CleanUp();
6208  //}
6209  currRing=NULL;
6210  currRingHdl=NULL;
6211  }
6212 
6213  /* nKillChar(r); will be called from inside of rDelete */
6214  rDelete(r);
6215  return;
6216  }
6217  rDecRefCnt(r);
6218 }
6219 
6221 {
6222  ring r = IDRING(h);
6223  int ref=0;
6224  if (r!=NULL)
6225  {
6226  // avoid, that sLastPrinted is the last reference to the base ring:
6227  // clean up before killing the last "named" refrence:
6228  if ((sLastPrinted.rtyp==RING_CMD)
6229  && (sLastPrinted.data==(void*)r))
6230  {
6231  sLastPrinted.CleanUp(r);
6232  }
6233  ref=r->ref;
6234  if ((ref<=0)&&(r==currRing))
6235  {
6236  // cleanup DENOMINATOR_LIST
6237  if (DENOMINATOR_LIST!=NULL)
6238  {
6240  if (TEST_V_ALLWARN)
6241  Warn("deleting denom_list for ring change from %s",IDID(h));
6242  do
6243  {
6244  n_Delete(&(dd->n),currRing->cf);
6245  dd=dd->next;
6247  DENOMINATOR_LIST=dd;
6248  } while(DENOMINATOR_LIST!=NULL);
6249  }
6250  }
6251  rKill(r);
6252  }
6253  if (h==currRingHdl)
6254  {
6255  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6256  else
6257  {
6259  }
6260  }
6261 }
6262 
6263 static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
6264 {
6265  idhdl h=root;
6266  while (h!=NULL)
6267  {
6268  if ((IDTYP(h)==RING_CMD)
6269  && (h!=n)
6270  && (IDRING(h)==r)
6271  )
6272  {
6273  return h;
6274  }
6275  h=IDNEXT(h);
6276  }
6277  return NULL;
6278 }
6279 
6280 extern BOOLEAN jjPROC(leftv res, leftv u, leftv v);
6281 
6282 static void jjINT_S_TO_ID(int n,int *e, leftv res)
6283 {
6284  if (n==0) n=1;
6285  ideal l=idInit(n,1);
6286  int i;
6287  poly p;
6288  for(i=rVar(currRing);i>0;i--)
6289  {
6290  if (e[i]>0)
6291  {
6292  n--;
6293  p=pOne();
6294  pSetExp(p,i,1);
6295  pSetm(p);
6296  l->m[n]=p;
6297  if (n==0) break;
6298  }
6299  }
6300  res->data=(char*)l;
6301  setFlag(res,FLAG_STD);
6302  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6303 }
6305 {
6306  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6307  int n=pGetVariables((poly)u->Data(),e);
6308  jjINT_S_TO_ID(n,e,res);
6309  return FALSE;
6310 }
6311 
6313 {
6314  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6315  ideal I=(ideal)u->Data();
6316  int i;
6317  int n=0;
6318  for(i=I->nrows*I->ncols-1;i>=0;i--)
6319  {
6320  int n0=pGetVariables(I->m[i],e);
6321  if (n0>n) n=n0;
6322  }
6323  jjINT_S_TO_ID(n,e,res);
6324  return FALSE;
6325 }
6326 
6327 void paPrint(const char *n,package p)
6328 {
6329  Print(" %s (",n);
6330  switch (p->language)
6331  {
6332  case LANG_SINGULAR: PrintS("S"); break;
6333  case LANG_C: PrintS("C"); break;
6334  case LANG_TOP: PrintS("T"); break;
6335  case LANG_MAX: PrintS("M"); break;
6336  case LANG_NONE: PrintS("N"); break;
6337  default: PrintS("U");
6338  }
6339  if(p->libname!=NULL)
6340  Print(",%s", p->libname);
6341  PrintS(")");
6342 }
6343 
6345 {
6346  intvec *aa=(intvec*)a->Data();
6347  sleftv tmp_out;
6348  sleftv tmp_in;
6349  leftv curr=res;
6350  BOOLEAN bo=FALSE;
6351  for(int i=0;i<aa->length(); i++)
6352  {
6353  tmp_in.Init();
6354  tmp_in.rtyp=INT_CMD;
6355  tmp_in.data=(void*)(long)(*aa)[i];
6356  if (proc==NULL)
6357  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6358  else
6359  bo=jjPROC(&tmp_out,proc,&tmp_in);
6360  if (bo)
6361  {
6362  res->CleanUp(currRing);
6363  Werror("apply fails at index %d",i+1);
6364  return TRUE;
6365  }
6366  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6367  else
6368  {
6369  curr->next=(leftv)omAllocBin(sleftv_bin);
6370  curr=curr->next;
6371  memcpy(curr,&tmp_out,sizeof(tmp_out));
6372  }
6373  }
6374  return FALSE;
6375 }
6377 {
6378  WerrorS("not implemented");
6379  return TRUE;
6380 }
6382 {
6383  WerrorS("not implemented");
6384  return TRUE;
6385 }
6387 {
6388  lists aa=(lists)a->Data();
6389  if (aa->nr==-1) /* empty list*/
6390  {
6392  l->Init();
6393  res->data=(void *)l;
6394  return FALSE;
6395  }
6396  sleftv tmp_out;
6397  sleftv tmp_in;
6398  leftv curr=res;
6399  BOOLEAN bo=FALSE;
6400  for(int i=0;i<=aa->nr; i++)
6401  {
6402  tmp_in.Init();
6403  tmp_in.Copy(&(aa->m[i]));
6404  if (proc==NULL)
6405  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6406  else
6407  bo=jjPROC(&tmp_out,proc,&tmp_in);
6408  tmp_in.CleanUp();
6409  if (bo)
6410  {
6411  res->CleanUp(currRing);
6412  Werror("apply fails at index %d",i+1);
6413  return TRUE;
6414  }
6415  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6416  else
6417  {
6418  curr->next=(leftv)omAllocBin(sleftv_bin);
6419  curr=curr->next;
6420  memcpy(curr,&tmp_out,sizeof(tmp_out));
6421  }
6422  }
6423  return FALSE;
6424 }
6426 {
6427  res->Init();
6428  res->rtyp=a->Typ();
6429  switch (res->rtyp /*a->Typ()*/)
6430  {
6431  case INTVEC_CMD:
6432  case INTMAT_CMD:
6433  return iiApplyINTVEC(res,a,op,proc);
6434  case BIGINTMAT_CMD:
6435  return iiApplyBIGINTMAT(res,a,op,proc);
6436  case IDEAL_CMD:
6437  case MODUL_CMD:
6438  case MATRIX_CMD:
6439  return iiApplyIDEAL(res,a,op,proc);
6440  case LIST_CMD:
6441  return iiApplyLIST(res,a,op,proc);
6442  }
6443  WerrorS("first argument to `apply` must allow an index");
6444  return TRUE;
6445 }
6446 
6448 {
6449  // assume a: level
6450  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6451  {
6452  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6453  char assume_yylinebuf[80];
6454  strncpy(assume_yylinebuf,my_yylinebuf,79);
6455  int lev=(long)a->Data();
6456  int startlev=0;
6457  idhdl h=ggetid("assumeLevel");
6458  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6459  if(lev <=startlev)
6460  {
6461  BOOLEAN bo=b->Eval();
6462  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6463  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6464  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6465  }
6466  }
6467  b->CleanUp();
6468  a->CleanUp();
6469  return FALSE;
6470 }
6471 
6472 #include "libparse.h"
6473 
6474 BOOLEAN iiARROW(leftv r, char* a, char *s)
6475 {
6476  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6477  // find end of s:
6478  int end_s=strlen(s);
6479  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6480  s[end_s+1]='\0';
6481  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6482  sprintf(name,"%s->%s",a,s);
6483  // find start of last expression
6484  int start_s=end_s-1;
6485  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6486  if (start_s<0) // ';' not found
6487  {
6488  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6489  }
6490  else // s[start_s] is ';'
6491  {
6492  s[start_s]='\0';
6493  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6494  }
6495  r->Init();
6496  // now produce procinfo for PROC_CMD:
6497  r->data = (void *)omAlloc0Bin(procinfo_bin);
6498  ((procinfo *)(r->data))->language=LANG_NONE;
6499  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6500  ((procinfo *)r->data)->data.s.body=ss;
6501  omFree(name);
6502  r->rtyp=PROC_CMD;
6503  //r->rtyp=STRING_CMD;
6504  //r->data=ss;
6505  return FALSE;
6506 }
6507 
6509 {
6510  char* ring_name=omStrDup((char*)r->Name());
6511  int t=arg->Typ();
6512  if (t==RING_CMD)
6513  {
6514  sleftv tmp;
6515  tmp.Init();
6516  tmp.rtyp=IDHDL;
6517  idhdl h=rDefault(ring_name);
6518  tmp.data=(char*)h;
6519  if (h!=NULL)
6520  {
6521  tmp.name=h->id;
6522  BOOLEAN b=iiAssign(&tmp,arg);
6523  if (b) return TRUE;
6524  rSetHdl(ggetid(ring_name));
6525  omFree(ring_name);
6526  return FALSE;
6527  }
6528  else
6529  return TRUE;
6530  }
6531  else if (t==CRING_CMD)
6532  {
6533  sleftv tmp;
6534  sleftv n;
6535  n.Init();
6536  n.name=ring_name;
6537  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6538  if (iiAssign(&tmp,arg)) return TRUE;
6539  //Print("create %s\n",r->Name());
6540  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6541  return FALSE;
6542  }
6543  //Print("create %s\n",r->Name());
6544  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6545  return TRUE;// not handled -> error for now
6546 }
6547 
6548 static void iiReportTypes(int nr,int t,const short *T)
6549 {
6550  char buf[250];
6551  buf[0]='\0';
6552  if (nr==0)
6553  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6554  else
6555  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6556  for(int i=1;i<=T[0];i++)
6557  {
6558  strcat(buf,"`");
6559  strcat(buf,Tok2Cmdname(T[i]));
6560  strcat(buf,"`");
6561  if (i<T[0]) strcat(buf,",");
6562  }
6563  WerrorS(buf);
6564 }
6565 
6566 BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
6567 {
6568  int l=0;
6569  if (args==NULL)
6570  {
6571  if (type_list[0]==0) return TRUE;
6572  }
6573  else l=args->listLength();
6574  if (l!=(int)type_list[0])
6575  {
6576  if (report) iiReportTypes(0,l,type_list);
6577  return FALSE;
6578  }
6579  for(int i=1;i<=l;i++,args=args->next)
6580  {
6581  short t=type_list[i];
6582  if (t!=ANY_TYPE)
6583  {
6584  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6585  || (t!=args->Typ()))
6586  {
6587  if (report) iiReportTypes(i,args->Typ(),type_list);
6588  return FALSE;
6589  }
6590  }
6591  }
6592  return TRUE;
6593 }
6594 
6595 void iiSetReturn(const leftv source)
6596 {
6597  if ((source->next==NULL)&&(source->e==NULL))
6598  {
6599  if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6600  {
6601  memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6602  source->Init();
6603  return;
6604  }
6605  if (source->rtyp==IDHDL)
6606  {
6607  if ((IDLEV((idhdl)source->data)==myynest)
6608  &&(IDTYP((idhdl)source->data)!=RING_CMD))
6609  {
6610  iiRETURNEXPR.Init();
6611  iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
6612  iiRETURNEXPR.data=IDDATA((idhdl)source->data);
6613  iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
6615  IDATTR((idhdl)source->data)=NULL;
6616  IDDATA((idhdl)source->data)=NULL;
6617  source->name=NULL;
6618  source->attribute=NULL;
6619  return;
6620  }
6621  }
6622  }
6623  iiRETURNEXPR.Copy(source);
6624 }
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:411
ring r
Definition: algext.h:37
struct for passing initialization parameters to naInitChar
Definition: algext.h:37
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:132
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:153
long int64
Definition: auxiliary.h:68
static int si_max(const int a, const int b)
Definition: auxiliary.h:124
int BOOLEAN
Definition: auxiliary.h:87
#define TRUE
Definition: auxiliary.h:100
#define FALSE
Definition: auxiliary.h:96
void * ADDRESS
Definition: auxiliary.h:119
static int si_min(const int a, const int b)
Definition: auxiliary.h:125
CanonicalForm num(const CanonicalForm &f)
CanonicalForm den(const CanonicalForm &f)
CanonicalForm Lc(const CanonicalForm &f)
int l
Definition: cfEzgcd.cc:100
int m
Definition: cfEzgcd.cc:128
for(int i=0;i<=n;i++) degsf[i]
Definition: cfEzgcd.cc:72
int i
Definition: cfEzgcd.cc:132
int k
Definition: cfEzgcd.cc:99
Variable x
Definition: cfModGcd.cc:4082
int p
Definition: cfModGcd.cc:4078
CanonicalForm cf
Definition: cfModGcd.cc:4083
CanonicalForm b
Definition: cfModGcd.cc:4103
void mu(int **points, int sizePoints)
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto
Definition: cf_map_ext.cc:504
FILE * f
Definition: checklibs.c:9
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:322
ideal singclap_factorize(poly f, intvec **v, int with_exps, const ring r)
Definition: clapsing.cc:925
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1548
int * Zp_roots(poly p, const ring r)
Definition: clapsing.cc:2059
int get_num_si()
Definition: GMPrat.cc:138
int get_den_si()
Definition: GMPrat.cc:152
char name() const
Definition: variable.cc:122
Variable next() const
Definition: factory.h:146
char * buffer
Definition: fevoices.h:69
char * filename
Definition: fevoices.h:63
long fptr
Definition: fevoices.h:70
Matrices of numbers.
Definition: bigintmat.h:51
Definition: idrec.h:35
idhdl get(const char *s, int lev)
Definition: ipid.cc:72
int typ
Definition: idrec.h:43
idhdl next
Definition: idrec.h:38
attr attribute
Definition: idrec.h:41
Definition: intvec.h:23
void makeVector()
Definition: intvec.h:102
void show(int mat=0, int spaces=0) const
Definition: intvec.cc:149
int min_in()
Definition: intvec.h:121
int length() const
Definition: intvec.h:94
int rows() const
Definition: intvec.h:96
int & rows()
Definition: matpol.h:23
int & cols()
Definition: matpol.h:24
Definition: ipid.h:56
virtual number getSubDet()
Definition: mpr_base.h:37
virtual ideal getMatrix()
Definition: mpr_base.h:31
virtual IStateType initState() const
Definition: mpr_base.h:41
void solve_all()
Definition: mpr_numeric.cc:858
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:883
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:66
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:300
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
int getAnzRoots()
Definition: mpr_numeric.h:97
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:437
int getAnzElems()
Definition: mpr_numeric.h:95
Definition: attrib.h:21
attr get(const char *s)
Definition: attrib.cc:93
void * CopyA()
Definition: subexpr.cc:2100
int atyp
Definition: attrib.h:27
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:195
intvec * zrovToIV()
BOOLEAN mapFromMatrix(matrix m)
int icase
Definition: mpr_numeric.h:201
void compute()
matrix mapToMatrix(matrix m)
intvec * posvToIV()
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
void * CopyD(int t)
Definition: subexpr.cc:710
int Typ()
Definition: subexpr.cc:1011
const char * name
Definition: subexpr.h:87
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1154
void Init()
Definition: subexpr.h:107
BOOLEAN RingDependend()
Definition: subexpr.cc:418
leftv next
Definition: subexpr.h:86
int listLength()
Definition: subexpr.cc:51
void Copy(leftv e)
Definition: subexpr.cc:685
void * data
Definition: subexpr.h:88
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
attr * Attribute()
Definition: subexpr.cc:1454
BITSET flag
Definition: subexpr.h:90
Subexpr e
Definition: subexpr.h:105
const char * Name()
Definition: subexpr.h:120
attr attribute
Definition: subexpr.h:89
Definition: lists.h:24
sleftv * m
Definition: lists.h:46
void Clean(ring r=currRing)
Definition: lists.h:26
INLINE_THIS void Init(int l=0)
int nr
Definition: lists.h:44
spectrumPolyNode * root
Definition: splist.h:60
void delete_node(spectrumPolyNode **)
Definition: splist.cc:256
Definition: semic.h:64
int mu
Definition: semic.h:67
void copy_new(int)
Definition: semic.cc:54
Rational * s
Definition: semic.h:70
int mult_spectrum(spectrum &)
Definition: semic.cc:396
int n
Definition: semic.h:69
int pg
Definition: semic.h:68
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
int * w
Definition: semic.h:71
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:63
rootContainer ** specializeInU(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:3059
rootContainer ** interpolateDenseSP(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:2921
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
@ denseResMat
Definition: mpr_base.h:65
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:29
poly numvec2poly(const number *q)
Definition: mpr_numeric.cc:93
number * interpolateDense(const number *q)
Solves the Vandermode linear system \sum_{i=1}^{n} x_i^k-1 w_i = q_k, k=1,..,n.
Definition: mpr_numeric.cc:146
Coefficient rings, fields and other domains suitable for Singular polynomials.
static FORCE_INLINE long n_Int(number &n, const coeffs r)
conversion of n to an int; 0 if not possible in Z/pZ: the representing int lying in (-p/2 ....
Definition: coeffs.h:547
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition: coeffs.h:451
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:839
static FORCE_INLINE BOOLEAN nCoeff_is_Z(const coeffs r)
Definition: coeffs.h:816
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition: coeffs.h:963
int GFDegree
Definition: coeffs.h:95
@ n_R
single prescision (6,6) real numbers
Definition: coeffs.h:31
@ n_GF
\GF{p^n < 2^16}
Definition: coeffs.h:32
@ n_Q
rational (GMP) numbers
Definition: coeffs.h:30
@ n_Znm
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
@ n_algExt
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic
Definition: coeffs.h:35
@ n_Zn
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
@ n_long_R
real floating point (GMP) numbers
Definition: coeffs.h:33
@ n_Z2m
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
@ n_Zp
\F{p < 2^31}
Definition: coeffs.h:29
@ n_transExt
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
@ n_Z
only used if HAVE_RINGS is defined
Definition: coeffs.h:43
@ n_long_C
complex floating point (GMP) numbers
Definition: coeffs.h:41
short float_len2
additional char-flags, rInit
Definition: coeffs.h:102
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:832
static FORCE_INLINE void n_MPZ(mpz_t result, number &n, const coeffs r)
conversion of n to a GMP integer; 0 if not possible
Definition: coeffs.h:551
static FORCE_INLINE nMapFunc n_SetMap(const coeffs src, const coeffs dst)
set the mapping function pointers for translating numbers from src to dst
Definition: coeffs.h:700
const char * par_name
parameter name
Definition: coeffs.h:103
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:354
const unsigned short fftable[]
Definition: ffields.cc:31
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:436
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:778
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:730
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:455
static FORCE_INLINE number n_InitMPZ(mpz_t n, const coeffs r)
conversion of a GMP integer to number
Definition: coeffs.h:542
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h:538
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:910
short float_len
additional char-flags, rInit
Definition: coeffs.h:101
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
const char * GFPar_name
Definition: coeffs.h:96
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition: coeffs.h:894
int GFChar
Definition: coeffs.h:94
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:918
Creation data needed for finite fields.
Definition: coeffs.h:93
#define Print
Definition: emacs.cc:80
#define Warn
Definition: emacs.cc:77
#define WarnS
Definition: emacs.cc:78
return result
Definition: facAbsBiFact.cc:75
const CanonicalForm int s
Definition: facAbsFact.cc:51
CanonicalForm res
Definition: facAbsFact.cc:60
const CanonicalForm & w
Definition: facAbsFact.cc:51
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:39
bool found
Definition: facFactorize.cc:55
CanonicalForm buf2
Definition: facFqBivar.cc:73
CFList tmp2
Definition: facFqBivar.cc:72
const ExtensionInfo & info
< [in] sqrfree poly
int j
Definition: facHensel.cc:110
int search(const CFArray &A, const CanonicalForm &F, int i, int j)
search for F in A between index i and j
char name(const Variable &v)
Definition: factory.h:189
VAR short errorreported
Definition: feFopen.cc:23
void WerrorS(const char *s)
Definition: feFopen.cc:24
VAR int yylineno
Definition: febase.cc:40
VAR char my_yylinebuf[80]
Definition: febase.cc:44
VAR int myynest
Definition: febase.cc:41
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:30
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:164
VAR Voice * currentVoice
Definition: fevoices.cc:47
const char * VoiceName()
Definition: fevoices.cc:56
const char sNoName_fe[]
Definition: fevoices.cc:55
void VoiceBackTrack()
Definition: fevoices.cc:75
@ BT_execute
Definition: fevoices.h:23
@ BT_proc
Definition: fevoices.h:20
ideal maMapIdeal(const ideal map_id, const ring preimage_r, const ideal image_id, const ring image_r, const nMapFunc nMap)
polynomial map for ideals/module/matrix map_id: the ideal to map map_r: the base ring for map_id imag...
Definition: gen_maps.cc:87
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:301
#define STATIC_VAR
Definition: globaldefs.h:7
#define VAR
Definition: globaldefs.h:5
@ PLUSPLUS
Definition: grammar.cc:274
@ MINUSMINUS
Definition: grammar.cc:271
@ IDEAL_CMD
Definition: grammar.cc:284
@ MATRIX_CMD
Definition: grammar.cc:286
@ BIGINTMAT_CMD
Definition: grammar.cc:278
@ GE
Definition: grammar.cc:269
@ EQUAL_EQUAL
Definition: grammar.cc:268
@ MAP_CMD
Definition: grammar.cc:285
@ PROC_CMD
Definition: grammar.cc:280
@ LE
Definition: grammar.cc:270
@ INTMAT_CMD
Definition: grammar.cc:279
@ MODUL_CMD
Definition: grammar.cc:287
@ SMATRIX_CMD
Definition: grammar.cc:291
@ VECTOR_CMD
Definition: grammar.cc:292
@ NOTEQUAL
Definition: grammar.cc:273
@ DOTDOT
Definition: grammar.cc:267
@ COLONCOLON
Definition: grammar.cc:275
@ NUMBER_CMD
Definition: grammar.cc:288
@ POLY_CMD
Definition: grammar.cc:289
@ RING_CMD
Definition: grammar.cc:281
const char * currid
Definition: grammar.cc:171
int yyparse(void)
Definition: grammar.cc:2111
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:386
STATIC_VAR poly last
Definition: hdegree.cc:1151
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1079
VAR int hMu
Definition: hdegree.cc:27
VAR omBin indlist_bin
Definition: hdegree.cc:28
VAR int hMu2
Definition: hdegree.cc:27
VAR int hCo
Definition: hdegree.cc:27
VAR indset ISet
Definition: hdegree.cc:352
VAR indset JSet
Definition: hdegree.cc:352
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:34
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:569
monf hCreate(int Nvar)
Definition: hutil.cc:999
scfmon hInit(ideal S, ideal Q, int *Nexist, ring tailRing)
Definition: hutil.cc:31
VAR varset hvar
Definition: hutil.cc:18
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1013
VAR int hNexist
Definition: hutil.cc:19
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:143
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:624
VAR scfmon hwork
Definition: hutil.cc:16
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:177
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:568
VAR scmon hpure
Definition: hutil.cc:17
VAR scfmon hrad
Definition: hutil.cc:16
VAR int hisModule
Definition: hutil.cc:20
VAR monf radmem
Definition: hutil.cc:21
VAR int hNpure
Definition: hutil.cc:19
VAR int hNrad
Definition: hutil.cc:19
VAR scfmon hexist
Definition: hutil.cc:16
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:414
VAR int hNvar
Definition: hutil.cc:19
scmon * scfmon
Definition: hutil.h:15
indlist * indset
Definition: hutil.h:28
int * varset
Definition: hutil.h:16
int * scmon
Definition: hutil.h:14
int binom(int n, int r)
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:176
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
ideal idCopy(ideal A)
Definition: ideals.h:60
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:33
ideal * resolvente
Definition: ideals.h:18
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
STATIC_VAR int * multiplicity
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:257
#define IMATELEM(M, I, J)
Definition: intvec.h:85
intvec * ivCopy(const intvec *o)
Definition: intvec.h:135
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:9469
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:9059
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1963
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:435
idhdl ggetid(const char *n)
Definition: ipid.cc:572
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:438
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:279
VAR package basePack
Definition: ipid.cc:58
void ipListFlag(idhdl h)
Definition: ipid.cc:610
VAR proclevel * procstack
Definition: ipid.cc:52
VAR idhdl currRingHdl
Definition: ipid.cc:59
VAR package currPack
Definition: ipid.cc:57
VAR idhdl currPackHdl
Definition: ipid.cc:55
idhdl packFindHdl(package r)
Definition: ipid.cc:822
VAR coeffs coeffs_BIGINT
Definition: ipid.cc:50
#define IDMAP(a)
Definition: ipid.h:135
#define IDMATRIX(a)
Definition: ipid.h:134
#define IDSTRING(a)
Definition: ipid.h:136
#define IDNEXT(a)
Definition: ipid.h:118
EXTERN_VAR omBin sleftv_bin
Definition: ipid.h:145
#define IDDATA(a)
Definition: ipid.h:126
#define IDPROC(a)
Definition: ipid.h:140
#define setFlag(A, F)
Definition: ipid.h:113
#define IDINTVEC(a)
Definition: ipid.h:128
#define IDIDEAL(a)
Definition: ipid.h:133
#define IDFLAG(a)
Definition: ipid.h:120
#define IDPOLY(a)
Definition: ipid.h:130
#define IDID(a)
Definition: ipid.h:122
#define IDROOT
Definition: ipid.h:19
#define IDINT(a)
Definition: ipid.h:125
#define FLAG_QRING_DEF
Definition: ipid.h:109
#define IDPACKAGE(a)
Definition: ipid.h:139
#define IDLEV(a)
Definition: ipid.h:121
#define IDRING(a)
Definition: ipid.h:127
#define IDTYP(a)
Definition: ipid.h:119
#define FLAG_STD
Definition: ipid.h:106
#define IDLIST(a)
Definition: ipid.h:137
#define IDATTR(a)
Definition: ipid.h:123
VAR int iiRETURNEXPR_len
Definition: iplib.cc:475
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:1049
INST_VAR sleftv iiRETURNEXPR
Definition: iplib.cc:474
VAR ring * iiLocalRing
Definition: iplib.cc:473
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:197
lists rDecompose(const ring r)
Definition: ipshell.cc:2165
semicState
Definition: ipshell.cc:3438
@ semicListWrongNumberOfNumerators
Definition: ipshell.cc:3453
@ semicListPGWrong
Definition: ipshell.cc:3467
@ semicListFirstElementWrongType
Definition: ipshell.cc:3445
@ semicListPgNegative
Definition: ipshell.cc:3458
@ semicListSecondElementWrongType
Definition: ipshell.cc:3446
@ semicListMilnorWrong
Definition: ipshell.cc:3466
@ semicListMulNegative
Definition: ipshell.cc:3461
@ semicListFourthElementWrongType
Definition: ipshell.cc:3448
@ semicListWrongNumberOfDenominators
Definition: ipshell.cc:3454
@ semicListNotMonotonous
Definition: ipshell.cc:3464
@ semicListNotSymmetric
Definition: ipshell.cc:3463
@ semicListNNegative
Definition: ipshell.cc:3452
@ semicListDenNegative
Definition: ipshell.cc:3460
@ semicListTooShort
Definition: ipshell.cc:3442
@ semicListTooLong
Definition: ipshell.cc:3443
@ semicListThirdElementWrongType
Definition: ipshell.cc:3447
@ semicListMuNegative
Definition: ipshell.cc:3457
@ semicListNumNegative
Definition: ipshell.cc:3459
@ semicMulNegative
Definition: ipshell.cc:3440
@ semicListWrongNumberOfMultiplicities
Definition: ipshell.cc:3455
@ semicOK
Definition: ipshell.cc:3439
@ semicListFifthElementWrongType
Definition: ipshell.cc:3449
@ semicListSixthElementWrongType
Definition: ipshell.cc:3450
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6344
BOOLEAN jjVARIABLES_P(leftv res, leftv u)
Definition: ipshell.cc:6304
lists rDecompose_list_cf(const ring r)
Definition: ipshell.cc:2126
int iiOpsTwoChar(const char *s)
Definition: ipshell.cc:121
BOOLEAN spaddProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4431
VAR idhdl iiCurrProc
Definition: ipshell.cc:81
BOOLEAN jjMINRES(leftv res, leftv v)
Definition: ipshell.cc:946
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:366
BOOLEAN iiParameter(leftv p)
Definition: ipshell.cc:1380
STATIC_VAR BOOLEAN iiNoKeepRing
Definition: ipshell.cc:84
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1202
static void rRenameVars(ring R)
Definition: ipshell.cc:2409
void iiCheckPack(package &p)
Definition: ipshell.cc:1634
void rKill(ring r)
Definition: ipshell.cc:6174
BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
check a list of arguemys against a given field of types return TRUE if the types match return FALSE (...
Definition: ipshell.cc:6566
BOOLEAN iiApply(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6425
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:425
VAR BOOLEAN iiDebugMarker
Definition: ipshell.cc:1063
ring rInit(leftv pn, leftv rv, leftv ord)
Definition: ipshell.cc:5628
leftv iiMap(map theMap, const char *what)
Definition: ipshell.cc:615
int iiRegularity(lists L)
Definition: ipshell.cc:1037
BOOLEAN nuLagSolve(leftv res, leftv arg1, leftv arg2, leftv arg3)
find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial us...
Definition: ipshell.cc:4681
BOOLEAN rDecompose_CF(leftv res, const coeffs C)
Definition: ipshell.cc:1953
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1823
void iiMakeResolv(resolvente r, int length, int rlen, char *name, int typ0, intvec **weights)
Definition: ipshell.cc:847
BOOLEAN iiARROW(leftv r, char *a, char *s)
Definition: ipshell.cc:6474
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4514
BOOLEAN syBetti1(leftv res, leftv u)
Definition: ipshell.cc:3175
void killlocals(int v)
Definition: ipshell.cc:386
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6386
idhdl rDefault(const char *s)
Definition: ipshell.cc:1648
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1857
int exprlist_length(leftv v)
Definition: ipshell.cc:552
BOOLEAN mpKoszul(leftv res, leftv c, leftv b, leftv id)
Definition: ipshell.cc:3096
poly iiHighCorner(ideal I, int ak)
Definition: ipshell.cc:1610
BOOLEAN spectrumfProc(leftv result, leftv first)
Definition: ipshell.cc:4187
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:5082
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6282
lists scIndIndset(ideal S, BOOLEAN all, ideal Q)
Definition: ipshell.cc:1103
VAR leftv iiCurrArgs
Definition: ipshell.cc:80
BOOLEAN nuVanderSys(leftv res, leftv arg1, leftv arg2, leftv arg3)
COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consi...
Definition: ipshell.cc:4824
BOOLEAN jjCHARSERIES(leftv res, leftv u)
Definition: ipshell.cc:3350
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1733
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6381
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:149
void list_error(semicState state)
Definition: ipshell.cc:3471
BOOLEAN mpJacobi(leftv res, leftv a)
Definition: ipshell.cc:3074
BOOLEAN iiBranchTo(leftv, leftv args)
Definition: ipshell.cc:1277
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:980
spectrumState
Definition: ipshell.cc:3554
@ spectrumWrongRing
Definition: ipshell.cc:3561
@ spectrumOK
Definition: ipshell.cc:3555
@ spectrumDegenerate
Definition: ipshell.cc:3560
@ spectrumUnspecErr
Definition: ipshell.cc:3563
@ spectrumNotIsolated
Definition: ipshell.cc:3559
@ spectrumBadPoly
Definition: ipshell.cc:3557
@ spectrumNoSingularity
Definition: ipshell.cc:3558
@ spectrumZero
Definition: ipshell.cc:3556
@ spectrumNoHC
Definition: ipshell.cc:3562
BOOLEAN iiTestAssume(leftv a, leftv b)
Definition: ipshell.cc:6447
void iiSetReturn(const leftv source)
Definition: ipshell.cc:6595
BOOLEAN iiAssignCR(leftv r, leftv arg)
Definition: ipshell.cc:6508
BOOLEAN spmulProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4473
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3813
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1705
void iiDebug()
Definition: ipshell.cc:1065
syStrategy syConvList(lists li)
Definition: ipshell.cc:3259
BOOLEAN spectrumProc(leftv result, leftv first)
Definition: ipshell.cc:4136
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1264
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2264
BOOLEAN iiCheckRing(int i)
Definition: ipshell.cc:1590
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:1064
spectrumState spectrumStateFromList(spectrumPolyList &speclist, lists *L, int fast)
Definition: ipshell.cc:3572
const short MAX_SHORT
Definition: ipshell.cc:5616
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3152
ring rSubring(ring org_ring, sleftv *rv)
Definition: ipshell.cc:6012
BOOLEAN kWeight(leftv res, leftv id)
Definition: ipshell.cc:3304
static leftv rOptimizeOrdAsSleftv(leftv ord)
Definition: ipshell.cc:5189
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5308
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2495
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3387
static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
Definition: ipshell.cc:6263
void test_cmd(int i)
Definition: ipshell.cc:514
syStrategy syForceMin(lists li)
Definition: ipshell.cc:3288
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6548
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1921
BOOLEAN jjRESULTANT(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:3343
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1416
static void rDecompose_23456(const ring r, lists L)
Definition: ipshell.cc:2025
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3363
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:330
BOOLEAN nuMPResMat(leftv res, leftv arg1, leftv arg2)
returns module representing the multipolynomial resultant matrix Arguments 2: ideal i,...
Definition: ipshell.cc:4658
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4256
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:295
BOOLEAN semicProc(leftv res, leftv u, leftv v)
Definition: ipshell.cc:4554
BOOLEAN loSimplex(leftv res, leftv args)
Implementation of the Simplex Algorithm.
Definition: ipshell.cc:4572
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1618
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2787
BOOLEAN loNewtonP(leftv res, leftv arg1)
compute Newton Polytopes of input polynomials
Definition: ipshell.cc:4566
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6376
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:1001
const char * lastreserved
Definition: ipshell.cc:82
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5580
lists syConvRes(syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
Definition: ipshell.cc:3187
void type_cmd(leftv v)
Definition: ipshell.cc:254
BOOLEAN iiWRITE(leftv, leftv v)
Definition: ipshell.cc:588
void paPrint(const char *n, package p)
Definition: ipshell.cc:6327
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:936
void rSetHdl(idhdl h)
Definition: ipshell.cc:5129
const char * iiTwoOps(int t)
Definition: ipshell.cc:88
BOOLEAN kQHWeight(leftv res, leftv v)
Definition: ipshell.cc:3326
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2316
BOOLEAN iiExport(leftv v, int toLev)
Definition: ipshell.cc:1515
BOOLEAN jjBETTI(leftv res, leftv u)
Definition: ipshell.cc:967
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4105
lists getList(spectrum &spec)
Definition: ipshell.cc:3399
BOOLEAN nuUResSolve(leftv res, leftv args)
solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing-...
Definition: ipshell.cc:4925
BOOLEAN jjVARIABLES_ID(leftv res, leftv u)
Definition: ipshell.cc:6312
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1893
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2450
STATIC_VAR jList * T
Definition: janet.cc:30
STATIC_VAR Poly * h
Definition: janet.cc:971
STATIC_VAR jList * Q
Definition: janet.cc:30
VAR BITSET validOpts
Definition: kstd1.cc:60
VAR BITSET kOptions
Definition: kstd1.cc:45
ideal kStd(ideal F, ideal Q, tHomog h, intvec **w, intvec *hilb, int syzComp, int newIdeal, intvec *vw, s_poly_proc_t sp)
Definition: kstd1.cc:2433
VAR denominator_list DENOMINATOR_LIST
Definition: kutil.cc:84
denominator_list next
Definition: kutil.h:65
#define pi
Definition: libparse.cc:1145
if(yy_init)
Definition: libparse.cc:1420
BOOLEAN nc_CallPlural(matrix cc, matrix dd, poly cn, poly dn, ring r, bool bSetupQuotient, bool bCopyInput, bool bBeQuiet, ring curr, bool dummy_ring=false)
returns TRUE if there were errors analyze inputs, check them for consistency detects nc_type,...
Definition: old.gring.cc:2682
VAR omBin slists_bin
Definition: lists.cc:23
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
char * lString(lists l, BOOLEAN typed, int dim)
Definition: lists.cc:380
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
void maFindPerm(char const *const *const preim_names, int preim_n, char const *const *const preim_par, int preim_p, char const *const *const names, int n, char const *const *const par, int nop, int *perm, int *par_perm, n_coeffType ch)
Definition: maps.cc:163
BOOLEAN maApplyFetch(int what, map theMap, leftv res, leftv w, ring preimage_r, int *perm, int *par_perm, int P, nMapFunc nMap)
Definition: maps_ip.cc:45
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:64
#define MATELEM(mat, i, j)
1-based access to matrix
Definition: matpol.h:29
ip_smatrix * matrix
Definition: matpol.h:43
#define MATROWS(i)
Definition: matpol.h:26
#define MATCOLS(i)
Definition: matpol.h:27
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:647
#define assume(x)
Definition: mod2.h:387
#define pIter(p)
Definition: monomials.h:37
#define pNext(p)
Definition: monomials.h:36
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition: monomials.h:44
#define pSetCoeff0(p, n)
Definition: monomials.h:59
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190
@ mprOk
Definition: mpr_base.h:98
EXTERN_VAR size_t gmp_output_digits
Definition: mpr_base.h:115
uResultant::resMatType determineMType(int imtype)
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:327
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:704
void setGMPFloatDigits(size_t digits, size_t rest)
Set size of mantissa digits - the number of output digits (basis 10) the size of mantissa consists of...
Definition: mpr_complex.cc:60
slists * lists
Definition: mpr_numeric.h:146
void report(const char *fmt, const char *name)
Definition: shared.cc:666
The main handler for Singular numbers which are suitable for Singular polynomials.
#define nDelete(n)
Definition: numbers.h:16
#define nIsZero(n)
Definition: numbers.h:19
#define nSetMap(R)
Definition: numbers.h:43
#define nIsMOne(n)
Definition: numbers.h:26
#define nCopy(n)
Definition: numbers.h:15
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
#define nInvers(a)
Definition: numbers.h:33
#define SHORT_REAL_LENGTH
Definition: numbers.h:57
#define nIsOne(n)
Definition: numbers.h:25
#define nInit(i)
Definition: numbers.h:24
#define omStrDup(s)
Definition: omAllocDecl.h:263
#define omfree(addr)
Definition: omAllocDecl.h:237
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define omFree(addr)
Definition: omAllocDecl.h:261
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
#define omRealloc0Size(addr, o_size, size)
Definition: omAllocDecl.h:221
#define NULL
Definition: omList.c:12
VAR unsigned si_opt_2
Definition: options.c:6
VAR unsigned si_opt_1
Definition: options.c:5
#define V_DEF_RES
Definition: options.h:49
#define BVERBOSE(a)
Definition: options.h:34
#define TEST_V_ALLWARN
Definition: options.h:143
#define Sy_bit(x)
Definition: options.h:31
#define V_REDEFINE
Definition: options.h:44
poly p_PermPoly(poly p, const int *perm, const ring oldRing, const ring dst, nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
Definition: p_polys.cc:4163
poly p_One(const ring r)
Definition: p_polys.cc:1309
#define __pp_Mult_nn(p, n, r)
Definition: p_polys.h:974
static unsigned long p_SetExp(poly p, const unsigned long e, const unsigned long iBitmask, const int VarOffset)
set a single variable exponent @Note: VarOffset encodes the position in p->exp
Definition: p_polys.h:488
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:233
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:873
static unsigned pLength(poly a)
Definition: p_polys.h:191
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1292
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition: p_polys.h:818
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1479
#define __p_Mult_nn(p, n, r)
Definition: p_polys.h:943
void rChangeCurrRing(ring r)
Definition: polys.cc:15
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
Compatiblity layer for legacy polynomial operations (over currRing)
static long pTotaldegree(poly p)
Definition: polys.h:282
#define pTest(p)
Definition: polys.h:415
#define pDelete(p_ptr)
Definition: polys.h:186
#define pSetm(p)
Definition: polys.h:271
#define pIsConstant(p)
like above, except that Comp must be 0
Definition: polys.h:238
#define pNeg(p)
Definition: polys.h:198
#define pDiff(a, b)
Definition: polys.h:296
void pNorm(poly p)
Definition: polys.h:363
#define pSub(a, b)
Definition: polys.h:287
#define pCmp(p1, p2)
pCmp: args may be NULL returns: (p2==NULL ? 1 : (p1 == NULL ? -1 : p_LmCmp(p1, p2)))
Definition: polys.h:115
#define pGetVariables(p, e)
Definition: polys.h:251
#define pSetComp(p, v)
Definition: polys.h:38
void wrp(poly p)
Definition: polys.h:310
void pWrite(poly p)
Definition: polys.h:308
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pIsPurePower(p)
Definition: polys.h:248
#define pSetExp(p, i, v)
Definition: polys.h:42
#define pCopy(p)
return a copy of the poly
Definition: polys.h:185
#define pOne()
Definition: polys.h:315
poly * polyset
Definition: polys.h:259
#define pDecrExp(p, i)
Definition: polys.h:44
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:191
int IsPrime(int p)
Definition: prime.cc:61
void PrintS(const char *s)
Definition: reporter.cc:284
void PrintLn()
Definition: reporter.cc:310
void Werror(const char *fmt,...)
Definition: reporter.cc:189
EXTERN_VAR int traceit
Definition: reporter.h:24
#define TRACE_SHOW_RINGS
Definition: reporter.h:36
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:77
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition: ring.cc:3395
int rTypeOfMatrixOrder(const intvec *order)
Definition: ring.cc:185
VAR omBin sip_sring_bin
Definition: ring.cc:43
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4594
ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
Definition: ring.cc:1363
BOOLEAN rCheckIV(const intvec *iv)
Definition: ring.cc:175
rRingOrder_t rOrderName(char *ordername)
Definition: ring.cc:506
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:449
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise,...
Definition: ring.cc:1660
void rSetSyzComp(int k, const ring r)
Definition: ring.cc:5027
static int sign(int x)
Definition: ring.cc:3372
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:519
static int rBlocks(ring r)
Definition: ring.h:569
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:530
static BOOLEAN rField_is_Z(const ring r)
Definition: ring.h:510
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:501
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:400
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:546
static ring rIncRefCnt(ring r)
Definition: ring.h:843
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:626
static BOOLEAN rField_is_Zn(const ring r)
Definition: ring.h:513
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:600
static int rInternalChar(const ring r)
Definition: ring.h:690
static BOOLEAN rIsLPRing(const ring r)
Definition: ring.h:411
rRingOrder_t
order stuff
Definition: ring.h:68
@ ringorder_lp
Definition: ring.h:77
@ ringorder_a
Definition: ring.h:70
@ ringorder_am
Definition: ring.h:88
@ ringorder_a64
for int64 weights
Definition: ring.h:71
@ ringorder_rs
opposite of ls
Definition: ring.h:92
@ ringorder_C
Definition: ring.h:73
@ ringorder_S
S?
Definition: ring.h:75
@ ringorder_ds
Definition: ring.h:84
@ ringorder_Dp
Definition: ring.h:80
@ ringorder_unspec
Definition: ring.h:94
@ ringorder_L
Definition: ring.h:89
@ ringorder_Ds
Definition: ring.h:85
@ ringorder_dp
Definition: ring.h:78
@ ringorder_c
Definition: ring.h:72
@ ringorder_rp
Definition: ring.h:79
@ ringorder_aa
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:91
@ ringorder_no
Definition: ring.h:69
@ ringorder_Wp
Definition: ring.h:82
@ ringorder_ws
Definition: ring.h:86
@ ringorder_Ws
Definition: ring.h:87
@ ringorder_IS
Induced (Schreyer) ordering.
Definition: ring.h:93
@ ringorder_ls
Definition: ring.h:83
@ ringorder_s
s?
Definition: ring.h:76
@ ringorder_wp
Definition: ring.h:81
@ ringorder_M
Definition: ring.h:74
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:540
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:507
static void rDecRefCnt(ring r)
Definition: ring.h:844
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:543
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:516
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:522
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:593
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:761
#define rTest(r)
Definition: ring.h:786
#define rField_is_Ring(R)
Definition: ring.h:486
idrec * idhdl
Definition: ring.h:21
void myychangebuffer()
Definition: scanner.cc:2331
VAR int sdb_flags
Definition: sdb.cc:31
#define mpz_sgn1(A)
Definition: si_gmp.h:18
int status int void size_t count
Definition: si_signals.h:59
int status int void * buf
Definition: si_signals.h:59
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
intvec * id_QHomWeight(ideal id, const ring r)
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
void idSkipZeroes(ideal ide)
gives an ideal/module the minimal possible size
#define IDELEMS(i)
Definition: simpleideals.h:23
#define R
Definition: sirandom.c:27
BOOLEAN hasAxis(ideal J, int k, const ring r)
Definition: spectrum.cc:81
int hasOne(ideal J, const ring r)
Definition: spectrum.cc:96
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461
poly computeWC(const newtonPolygon &np, Rational max_weight, const ring r)
Definition: spectrum.cc:142
void computeNF(ideal stdJ, poly hc, poly wc, spectrumPolyList *NF, const ring r)
Definition: spectrum.cc:309
BOOLEAN hasLinearTerm(poly h, const ring r)
Definition: spectrum.h:30
BOOLEAN hasConstTerm(poly h, const ring r)
Definition: spectrum.h:28
ip_package * package
Definition: structs.h:43
sleftv * leftv
Definition: structs.h:57
char * char_ptr
Definition: structs.h:53
@ isNotHomog
Definition: structs.h:36
#define BITSET
Definition: structs.h:16
#define loop
Definition: structs.h:75
int * int_ptr
Definition: structs.h:54
VAR omBin procinfo_bin
Definition: subexpr.cc:42
INST_VAR sleftv sLastPrinted
Definition: subexpr.cc:46
VAR BOOLEAN siq
Definition: subexpr.cc:48
@ LANG_MAX
Definition: subexpr.h:22
@ LANG_SINGULAR
Definition: subexpr.h:22
@ LANG_NONE
Definition: subexpr.h:22
@ LANG_C
Definition: subexpr.h:22
@ LANG_TOP
Definition: subexpr.h:22
BOOLEAN RingDependend(int t)
Definition: subexpr.h:142
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:770
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:355
intvec ** hilb_coeffs
Definition: syz.h:46
resolvente minres
Definition: syz.h:58
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1495
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1641
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1755
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2199
short list_length
Definition: syz.h:62
resolvente res
Definition: syz.h:47
resolvente fullres
Definition: syz.h:57
intvec ** weights
Definition: syz.h:45
ssyStrategy * syStrategy
Definition: syz.h:35
resolvente orderedRes
Definition: syz.h:48
int length
Definition: syz.h:60
#define IDHDL
Definition: tok.h:31
@ ALIAS_CMD
Definition: tok.h:34
@ BIGINT_CMD
Definition: tok.h:38
@ CRING_CMD
Definition: tok.h:56
@ LIST_CMD
Definition: tok.h:118
@ INTVEC_CMD
Definition: tok.h:101
@ PACKAGE_CMD
Definition: tok.h:149
@ CMATRIX_CMD
Definition: tok.h:46
@ DEF_CMD
Definition: tok.h:58
@ CNUMBER_CMD
Definition: tok.h:47
@ LINK_CMD
Definition: tok.h:117
@ QRING_CMD
Definition: tok.h:158
@ STRING_CMD
Definition: tok.h:185
@ INT_CMD
Definition: tok.h:96
#define ANY_TYPE
Definition: tok.h:30
struct for passing initialization parameters to naInitChar
Definition: transext.h:88
THREAD_VAR double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:20
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:108
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.cc:78