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